BPCStndLib1

From RiskWiki
Jump to: navigation, search

Language Tokenising and Parsing, tree, date and file support library

Language: Delphi 7 - 2007

  • String Tokenising functions
  • BPC FLang1 Language parsing routines
  • DATE to String functions
  • GENERAL FILE Import/Export Functions - COMMA TEXT


Use the bpcSMScript equivalents in preference to these routines where available.


interface
uses windows, classes, Sysutils, db, DBTables;

const
  bpslSkipSpace = 1;
  bpslDropDelimeters = 2;
  bpslPushBack = 4;
  bpslMatchSE = 8;
  bpslToEOL = 16;
  bpslDelimOveridesNum = 32;
  bpslCmprsSpace = 64;

type
  TbpTreeNodeType = ( tttnCell, tttnOp, tttnVal );
{
  TbpTreeNode = class( Tobject )
  private
  public
    NodeType : TbpTreeNodeType;
    Token : string;
    Done : boolean;
    Value : double;
    LeftPtr : TbpTreeNode;
    RightPtr : TbpTreeNode;
    constructor Create( myToken : string);
    destructor Destroy ;
    function Eval : boolean;
    function FindInTree( Target : string ) : TbpTreeNode;
    function BuildTree( SourceString : string ) : TbpTreeNode;
  end;
}

  tbpReservedWord = ( tbpRwNIL, tbpRwILLEGAL, tbpRwVAR, tbpRwIGNORE, tbpRwPOST, tbpRwHOLD, tbpRwIF, tbpRwDO, tbpRwEQ, tbpRwNEQ, tbpRwLT, tbpRwGT ,
                    tbpRwLTE, tbpRwGTE ,tbpRwASSIGN, tbpRwPLUS, tbpRwMINUS, tbpRwTIMES,
                    tbpRwDIVIDE, tbpRwPERIOD, tbpRwSEMIC, tbpRwCOLON, tbpRwCOMMA, tbpRwLEFTBRACKET, tbpRwRIGHTBRACKET,
                    tbpRwNOT, tbpRwTRUE, tbpRwFALSE, tbpRwAND, tbpRwOR );

  TbpTokenType = (ttComma, ttMapArg, ttReserved  );
  TbpMapArgType = (ftxNil, ftxInt, ftxDateYearLead, ftxDateLongMonLead, ftxDateDayLeadTime, ftxDateDayLead, ftxDateYearLeadTime, ftxDateYearLeadWithDiv, ftxChar, ftxMoney, ftxFloat, ftxLogical, ftxBlob, ftxQChar, ftxQNil);
  TbpTrimType = (ttTrimLeft, ttTrimRight, ttTrimBoth  );
  TbpTokenListType = (tltRelation, tltMap);

  TbpToken = class(TObject)
  private
  public
    TokenType : TbpTokenType;
    TokenString : string;
  end;

  TbpMapDividerToken = class(TbpToken)
  private
  public
    DividerWord : string;
    constructor Create(myDivider : string);
  end;

  TbpMapReservedWordToken = class(TbpToken)
  private
  public
    ReservedWord : string;
    constructor Create(myReservedWord : string);
  end;

  TbpMapArgToken = class(TbpToken)
  private
  public
    MapToName : string;
    MapSrcType : TbpMapArgType;
    Size : integer;
    constructor Create(myMapToName : string; myMapSrcType : TbpMapArgType; mySize : integer );
    function MapTo( MyDataSet : TDataSet ; var Erra : string ) : boolean;
  end;

  TbpTokenList = class(TStringlist)
  private
    { Private declarations }
  public
    ListType : TbpTokenListType ;
    procedure AddToken( TokenName : string; MyToken : TbpToken );
    procedure DelToken( TokenName : string );
    function GetTokenStrIfComma( i : integer) : string;
    function GetToken( i : integer)  : TbpToken;
  end;

  TbpMapTokenList = class(TbpTokenList)
  private
    { Private declarations }
  public
    { Public declarations }
     Rows : string;
     Criteria : string;
     MergeWith : string;
     Action : string;
     Prep : string;
     SrcLine : string;
     SrcMask : string;
     ParseError : string;
     SrcIgnored : string;
     SrcParseError : tstringlist;
     constructor Create;
     destructor Destroy; override;
     function IsCriteriaMatch( sourceline : string ) : boolean;
     function ReLoadSrc( TargetDataSet : TDataSet)  : boolean;
     function LoadMask : boolean;
     function LoadSrc ( TargetDataSet : TDataSet; NoPost : boolean = false ) : boolean;
  end;

  TbpListTokenList = class(TStringlist)
  private
    { Private declarations }
  public
    { Public declarations }
     SrcLines : TStringList;
     SrcMasks : TStringList;
     ParseErrors : TStringList;
     SrcIgnoreds : TStringList;

     constructor Create;
     destructor Destroy; override;
     function MatchSourceToMaskCriteria(  SourceLine : String )  : integer;
     procedure ClearMasks ;
     function LoadMasks : boolean;
     function LoadSrcs(debugflg : boolean; Imid, Imbid : integer;  TargetDataSet : TDataSet; SourceLines : TStringList)  : boolean;
  end;

/////////////////////////////////
//// String Tokenising functions
/////////////////////////////////

// Return a copy of the string bounded by start and end
function bpStrWhatsBetween(strTokenStart, strSource, strTokenEnd : string ): string;
// Returns the index of the closing delimeter matching the nesting level of the
// current start delimeters, (or the outermost match if direction is not forward).
// Source string unaffected
function bpNextMatchDelim(bGoForwards : boolean; strTokenStart, strTokenEnd, strSource: string; startpos : integer ): integer;
// Returns the index of the next delimeter from startpos or the last occurence
// in string if direction is not forward).  Forward Search starts from startpos.
// Source string unaffected
function bpNextDelimiter(bGoForwards : boolean; strTokenDelim, strSource : string; startpos : integer ): integer;
// Returns a string without the removechars. Doesn't Change Source
function bpStripCh(removechars : string; targetstr : string ) : string;
// Returns a string token optionally delimetered by start and pos, according to a variety of rules in Flags. Changes Source
function bpStrStripToken(Num : integer; Flags:integer; strTokenStart, strPunct, strTokenEnd : string; var strSource : string; var bTokenComplete : boolean; NumChar : integer = 0 ) : string;
// Returns the Map type given a string type name
function bpstrtoMapArgToken( strArgType : string ) : TbpMapArgType;
// Trim leading and trailing trimchars
function bpChTrim( LTrimByString, RTrimByString: string; TokenString: string): string;
// Move the sign char at the back to the front
function bpSignToLeft( chSign : string; TokenString: string): string;
// Returns the value part of a Name/Value pair in the string of the form:
// Name="MyValue" or Name.MyValue
function RetrieveValue(strSource,strName,strAssign,strTokenStart,strTokenEnd : string) : string;
// Returns a simple token : "word" | Punctuation
function RetrieveToken(strSource : string; var curpos : integer ) : string;
// Retrieves the entire first line after index <startfrom> in the tstring <strSource>
// that matches the pattern 'CALC.<strinstance> <strsubname>="<strsubinstance>" '
// Returns the entire line string including all attributes - use RetrieveValue to extract the
// component attributes or filter further
// the CALC pattern where " symbol is replaced by <strTokenStart>, <strTokenEnd>
// EG: StartingOffset := 0;
//     RetrievSPattern( FormuliStringList,  StartingOffset, 'BASXL', 'PeriodGroup', 'Monthly' );
// If <strsubname> is '' then the match is to the CALC.strinstance tag alone and
//    <strsubinstance> is ignored.
// ##JB : Assumes CALC name and subName pair are unique, or queued
function RetrieveSPattern( strSource : TStrings; var StartFrom : integer; strName, strInstance, strSubName, strSubInstance : string) : string;
// Uses RetrieveSPattern to return CALC formula (the value attribute of the tag) or ''
// EG: RetrievePeriodCalc( FormuliStringList, 'BASXL', 'Monthly', '"', '"');
function RetrievePeriodCalcValue( strSource : TStrings; strInstance, strSubInstance, strTokenStart,strTokenEnd : string) : string;

//////////////////////////////////////////////////////////////////////////////////////////
/// Language parsing routines
{
  In all cases the source is not damaged and (except for RetrieveValue,
  the structure of the calling pascal function is:
  <func>(<source string>, Var <curpos> ; Var <return args> ) : <parsed ok>;
  where <func> is function name
        <source string> is the source string
        <curpos> next char position immediately after expression or 1 if at start of line
                 or -1 if EOLN
        <return args> the arguments returned
        <parsed ok> a boolean verifying correct syntax
  These routines assume a language of expressions containing (examples):
  value="POST" or value="POST;"
  value="if( NE(a,b), POST, HOLD)"
  value="if( NE(a,b), if( NE(a,c), POST, do( =(a,d), POST), HOLD));"

  LANGUAGE GRAMMAR:

  <statementlist> = [<statement>]...;
  <statement> = <postfunc> | <holdfunc> | <iffunc> | <dofunc> | <assignfunc> | <mathfunc>
  <arglist> = ( <statement> [,<statement>]... )
  <postfunc> = POST // return true
  <holdfunc> = HOLD // return true
  <dofunc> = DO ( <statement> [, <statement>]... )  // return last statement executed
  <iffunc> = IF ( <conditionpart>, <truepart>, <falsepart> )  // return whichever part is executed
  <conditionpart> = <logicfunc> ( <logicarg>, <logicarg>) | <logicliteral>
  <logicfunc> = EQ | NE | LT | GT | LTE | GTE  | OR | AND
  <logicliteral> = TRUE  | FALSE
  <logicarg> = <literal> | <var> | <logicliteral>
  <mathfunc> = [+ | - | * | / ]( <statement> [, <statement>]... )
  <assignfunc> = =( <lvalue>, <rvalue> )
  <lvalue> = <var>
  <rvalue> = <logicfunc> | <var> | <literal> | <iffunc>
  <literal> = <logicliteral> | <value>

  END GRAMMAR.

  An example of the use is:
  curpos := 1;
  myValStr := RetrieveValue( 'Relation.R1 value="if( NE(a,b), if( NE(a,c), POST, do( =( a,b), HOLD ), HOLD)"', 'value', '=', '"', '"');
  if EvalStatementList( myValStr, curpos, strStatementList) then
     Parse Complete;

EvalLiteral
  RetrieveToken( strSource, curpos );


EvalStatementList
  while curpos > 0 do
  begin
    parseok := EvalStatement(myValStr, curpos, strstatement );
    if curpos >= length(myValStr) then curpos := -1;
  end;

EvalStatement

}

//////////////////////////////////////////////////////////////////////////////////////////
// Returns the statement list of a string of the form (terminates on EOL):
// "statement;statement;"
function RetrieveStatementList( strSource: string; var curpos : integer; var strStatementList : string ) : boolean;
// Returns the statement part of a string of the form (terminates statement part on ; or EOL):
// "function < optionally some other stuff>;"
function RetrieveStatement( strSource: string; var curpos : integer; var strStatement : string) : boolean;
// Returns the Function part of a string of the form (terminates function part on space, ; or EOL:
// "function < optionally some other stuff>;"
function RetrieveFunction( strSource : string; var curpos : integer; var strFunc, strArglist : string ) : boolean;
// Returns true if parsed OK and Decomposes an ifexpression into its component parts of the form:
// "(condition action )? true action : false action"
// "if ( a<>b )? POST : HOLD;"
function RetrieveIfExpr(strSource: string; var strCondition: string; strIfTrue, strIfFalse : string ) : boolean;

// Returns the Function part of a string of the form (terminates function part on space, ; or EOL:
// "function < optionally some other stuff>;"
{function RetrieveFunction( strSource; var  ) : string;
var
begin
end;
}

// True if ch at curpos is numeric else false
function bpChIsNum( strSource : string; curpos : integer ) : boolean;
// True if ch at curpos is A..z
function bpChIsAlpha( strSource : string; curpos : integer ) : boolean;
// Returns the index of the strSource after chars (spaces) skipped
function bpSkip( strDelims, strSource : string; var curpos : integer ) : integer;

// Returns the reserved word corresponding (or VAR flag or illegal flag ) to the token
function bpWhichReservedWord( strSource : string ) : tbpReservedWord;

///////////////////////////////
//// DATE to String functions
///////////////////////////////

// Return the Number of Days in a month (1..12) - use IsLeapYear [Borland VCL]
// for isleapy test.
function DaysInMonth( monthint : integer; isleapy : boolean ) : integer;
// convert a month num (1..12) to a month string
function MonthToStr( monthint : integer ) : string;
// convert a month string to the closest possible month num (1..12)
function StrToMonth( month : string  ) : integer;

//////////////////////////////////////////////////////
//////////////////////////////////////////////////////
/// GENERAL FILE Import/Export Functions - COMMA TEXT
//////////////////////////////////////////////////////

// General Table Import Routine
function ImportATable( TargetTableName: string; TargetTable : TDataSet; FileName : string; DoMemFields : boolean = False ) : boolean;
// General Table Export Routine
function ExportATable(  FileName : string ; TargetTable : TDataSet; DoMemFields : boolean = False ) : boolean;

BackLinks