123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266 |
- {
- This file is part of the Free Component Library
- Copyright (c) 2010-2014 by the Free Pascal development team
- SQL source syntax parser
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit fpsqlparser;
- { $define debugparser}
- { $define debugexpr}
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, SysUtils, fpsqlscanner, fpsqltree;
- Type
- TParseTypeFlag = (ptfAllowDomainName,ptfAlterDomain,ptfAllowConstraint,
- ptProcedureParam,ptfTableFieldDef,ptfCast,ptfExternalFunction,
- ptfExternalFunctionResult);
- TParseTypeFlags = Set of TParseTypeFlag;
- TExpressionOption = (eoCheckConstraint,eoTableConstraint,eoComputedBy,eoOnlyNull,
- eoFieldValue,eoSelectvalue,eoParamValue,eoWhereClause,eoJoin,
- eoHaving,eoListValue, eoIF);
- TExpressionOptions = set of TExpressionOption;
- TSelectFlag = (sfSingleTon,sfUnion,sfInto);
- TSelectFlags = Set of TSelectFlag;
- TParserOption = (poPartial,poAllowSetTerm);
- TParserOptions = set of TParserOption;
- { TSQLParser }
- TSQLParser = Class(TObject)
- Private
- FOptions : TParserOptions;
- FInput : TStream;
- FScanner : TSQLScanner;
- FCurrent : TSQLToken;
- FCurrentString : String;
- FCurrentTokenLine : Integer;
- FCurrentTokenPos : Integer;
- FPrevious : TSQLToken;
- FFreeScanner : Boolean;
- FPeekToken: TSQLToken;
- FPeekTokenString: String;
- FPeekTokenLine : Integer;
- FPeekTokenPos : Integer;
- Procedure CheckEOF;
- protected
- procedure UnexpectedToken; overload;
- procedure UnexpectedToken(AExpected : TSQLTokens); overload;
- // All elements must be created with this factory function
- function CreateElement(AElementClass : TSQLElementClass; APArent : TSQLElement) : TSQLElement; virtual;
- function CreateLiteral(AParent: TSQLElement): TSQLLiteral;
- function CreateIdentifier(AParent : TSQLElement; Const AName : TSQLStringType) : TSQLIdentifierName;
- // Verify that current token is the expected token; raise error if not
- procedure Expect(aToken: TSQLToken);
- // Verify that current token is one of the expected tokens; raise error if not
- procedure Expect(aTokens: TSQLTokens);
- // Expects aToken as current token and eats it by calling GetNextToken
- procedure Consume(aToken: TSQLToken);
- // Expects aTokens tokens and eats the token by calling GetNextToken
- procedure Consume(aTokens: TSQLTokens);
- procedure Error(Msg : String);
- procedure Error(Fmt : String; Args : Array of const);
- // Expression support
- function ParseExprLevel1(AParent: TSQLElement; EO : TExpressionOptions): TSQLExpression;
- function ParseExprLevel2(AParent: TSQLElement; EO : TExpressionOptions): TSQLExpression;
- function ParseExprLevel3(AParent: TSQLElement; EO : TExpressionOptions): TSQLExpression;
- function ParseExprLevel4(AParent: TSQLElement; EO : TExpressionOptions): TSQLExpression;
- function ParseExprLevel5(AParent: TSQLElement; EO : TExpressionOptions): TSQLExpression;
- function ParseExprLevel6(AParent: TSQLElement; EO : TExpressionOptions): TSQLExpression;
- function ParseExprPrimitive(AParent: TSQLElement; EO : TExpressionOptions): TSQLExpression;
- function ParseCaseExpression(AParent: TSQLElement): TSQLCaseExpression;
- function ParseInoperand(AParent: TSQLElement): TSQLExpression;
- // Lists, primitives
- function ParseIdentifierList(AParent: TSQLElement; AList: TSQLelementList): integer;
- function ParseValueList(AParent: TSQLElement; EO : TExpressionOptions): TSQLElementList;
- function ParseSQLValue(AParent: TSQLElement): TSQLExpression;
- function ParseCheckConstraint(AParent: TSQLElement; TableConstraint : Boolean = False): TSQLExpression;
- // Create/Alter statements
- function ParseAddTableElement(AParent: TSQLElement): TSQLAlterTableAddElementOperation;
- function ParseAlterTableElement(AParent: TSQLElement): TSQLAlterTableOperation;
- function ParseDropTableElement(AParent: TSQLElement): TSQLDropTableElementOperation;
- function ParseFieldConstraint(AParent: TSQLElement): TSQLFieldConstraint;
- function ParseForeignKeyDefinition(AParent: TSQLElement): TSQLForeignKeyDefinition;
- Procedure ParseCharTypeDefinition(Out DT: TSQLDataType; Out Len: Integer; Out ACharset : TSQLStringType);
- procedure ParseBlobDefinition(var ASegmentSize, ABlobType: Integer; Var ACharset : TSQLStringType);
- function ParseTypeDefinition(AParent: TSQLElement; Flags: TParseTypeFlags): TSQLTypeDefinition;
- function ParseTableFieldDef(AParent: TSQLElement): TSQLTableFieldDef;
- function ParseTableConstraint(AParent: TSQLElement): TSQLTableConstraintDef;
- function ParseCreateDomainStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
- function ParseCreateExceptionStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
- function ParseCreateGeneratorStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
- function ParseCreateRoleStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
- function ParseCreateIndexStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
- function ParseCreateProcedureStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
- function ParseCreateTableStatement(AParent: TSQLElement): TSQLCreateOrAlterStatement;
- function ParseAlterTableStatement(AParent: TSQLElement): TSQLAlterTableStatement;
- function ParseCreateViewStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
- function ParseCreateTriggerStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
- function ParseSetTermStatement(AParent: TSQLElement): TSQLSetTermStatement;
- function ParseSetGeneratorStatement(AParent: TSQLElement) : TSQLSetGeneratorStatement;
- function ParseCreateDatabaseStatement(AParent: TSQLElement; IsAlter: Boolean ): TSQLCreateDatabaseStatement;
- function ParseCreateShadowStatement(AParent: TSQLElement; IsAlter: Boolean ): TSQLCreateShadowStatement;
- function ParseAlterDatabaseStatement(AParent: TSQLElement; IsAlter: Boolean ): TSQLAlterDatabaseStatement;
- function ParseSecondaryFile(AParent: TSQLElement): TSQLDatabaseFileInfo;
- function ParseDeclareFunctionStatement(AParent: TSQLElement): TSQLDeclareExternalFunctionStatement;
- function ParseDeclareStatement(AParent: TSQLElement): TSQLStatement;
- // GRANT parsing
- procedure ParseGranteeList(AParent: TSQLElement; List: TSQLElementList; AllowObject, AllowGroup,AllowPublic : Boolean; IsRevoke: Boolean = False);
- function ParseGrantExecuteStatement(AParent: TSQLElement): TSQLProcedureGrantStatement;
- function ParseGrantRoleStatement(AParent: TSQLElement): TSQLRoleGrantStatement;
- function ParseGrantTableStatement(AParent: TSQLElement): TSQLTableGrantStatement;
- // REVOKE parsing
- function ParseRevokeExecuteStatement(AParent: TSQLElement): TSQLProcedureRevokeStatement;
- function ParseRevokeRoleStatement(AParent: TSQLElement): TSQLRoleRevokeStatement;
- function ParseRevokeTableStatement(AParent: TSQLElement): TSQLTableRevokeStatement;
- // SELECT parsing
- function ParseExprAggregate(AParent: TSQLElement; EO: TExpressionOptions): TSQLAggregateFunctionExpression;
- procedure ParseFromClause(AParent: TSQLSelectStatement; AList: TSQLElementList);
- procedure ParseGroupBy(AParent: TSQLSelectStatement; AList: TSQLElementList);
- procedure ParseOrderBy(AParent: TSQLSelectStatement; AList: TSQLElementList);
- procedure ParseLimit(AParent: TSQLSelectStatement; ALimit: TSQLSelectLimit);
- procedure ParseSelectFieldList(AParent: TSQLSelectStatement; AList: TSQLElementList; Singleton : Boolean);
- function ParseForUpdate(AParent: TSQLSelectStatement): TSQLElementList;
- function ParseSelectPlan(AParent: TSQLElement): TSQLSelectPlan;
- function ParseTableRef(AParent: TSQLSelectStatement): TSQLTableReference;
- procedure ParseIntoList(AParent: TSQLElement; List: TSQLElementList);
- // EXECUTE parsing
- function ParseExecuteProcedureStatement(AParent: TSQLElement): TSQLExecuteProcedureStatement;
- // Stored procedure parsing
- function ParseAssignStatement(AParent: TSQLElement): TSQLAssignStatement;
- function ParseExceptionStatement(AParent: TSQLElement): TSQLExceptionStatement;
- function ParseForStatement(AParent: TSQLElement): TSQLForStatement;
- function ParseIfStatement(AParent: TSQLElement): TSQLIFStatement;
- function ParsePostEventStatement(AParent: TSQLElement): TSQLPostEventStatement;
- procedure ParseProcedureParamList(AParent: TSQLElement; AList: TSQLElementList);
- procedure ParseCreateProcedureVariableList(AParent: TSQLElement; AList: TSQLElementList);
- function ParseProcedureStatement(AParent: TSQLElement): TSQLStatement;
- procedure ParseStatementBlock(AParent: TSQLElement; Statements: TSQLElementList);
- function ParseWhenStatement(AParent: TSQLElement): TSQLWhenStatement;
- function ParseWhileStatement(AParent: TSQLElement): TSQLWhileStatement;
- Public
- Constructor Create(AInput: TStream);
- Constructor Create(AScanner : TSQLScanner);
- Destructor Destroy; override;
- Function ParseSelectStatement(AParent : TSQLElement; Flags : TSelectFlags = []) : TSQLSelectStatement;
- Function ParseUpdateStatement(AParent : TSQLElement) : TSQLUpdateStatement;
- Function ParseInsertStatement(AParent : TSQLElement) : TSQLInsertStatement;
- Function ParseDeleteStatement(AParent : TSQLElement) : TSQLDeleteStatement;
- // Parses both create and alter statements
- Function ParseCreateStatement(AParent : TSQLElement; IsAlter : Boolean = False) : TSQLCreateOrAlterStatement;
- Function ParseDropStatement(AParent : TSQLElement) : TSQLDropStatement;
- Function ParseRollbackStatement(AParent : TSQLElement) : TSQLRollbackStatement;
- Function ParseCommitStatement(AParent : TSQLElement) : TSQLCommitStatement;
- Function ParseSetStatement(AParent : TSQLElement) : TSQLStatement;
- Function ParseConnectStatement(AParent : TSQLElement) : TSQLConnectStatement;
- Function ParseGrantStatement(AParent: TSQLElement): TSQLGrantStatement;
- Function ParseRevokeStatement(AParent: TSQLElement): TSQLGrantStatement;
- // Parse single element
- Function Parse : TSQLElement; overload;
- Function Parse(aOptions : TParserOptions) : TSQLElement; overload;
- // Parse script containing 1 or more elements
- Function ParseScript(AllowPartial : Boolean) : TSQLElementList; deprecated 'use options';
- Function ParseScript(aOptions : TParserOptions = []) : TSQLElementList;
- // Auxiliary stuff
- Property CurrentToken : TSQLToken read FCurrent;
- Property CurrentTokenString : String read FCurrentString;
- Property CurrentTokenLine : Integer read FCurrentTokenLine;
- Property CurrentTokenPos : Integer read FCurrentTokenPos;
- // Gets next token; also updates current token
- Function GetNextToken : TSQLToken;
- // Looks at next token without changing current token
- Function PeekNextToken : TSQLToken;
- Function PreviousToken : TSQLToken;
- Function IsEndOfLine : Boolean;
- function CurSource: String;
- Function CurLine : Integer;
- Function CurPos : Integer;
- Property Options : TParserOptions Read FOptions;
- Property Scanner : TSQLScanner Read FScanner;
- end;
- { ESQLParser }
- ESQLParser = Class(Exception)
- private
- FCol: Integer;
- FFileName: String;
- FLine: Integer;
- Public
- Property Line : Integer Read FLine Write FLine;
- Property Col : Integer Read FCol Write FCol;
- Property FileName : String Read FFileName Write FFileName;
- end;
- Function StringToSQLExtractElement(Const S : TSQLStringType; Out Res : TSQLExtractElement) : Boolean;
- implementation
- uses typinfo;
- Resourcestring
- SerrUnmatchedBrace = 'Expected ).';
- // SErrCommaOrBraceExpected = 'Expected , or ).';
- SErrUnexpectedToken = 'Unexpected token: %s';
- SErrUnexpectedTokenOf = 'Unexpected token: %s, expected one of %s';
- SErrTokenMismatch = 'Unexpected token: ''%s'', expected: ''%s''';
- SErrExpectedDBObject = 'Expected database object type. Got: ''%s''';
- SErrDomainNotAllowed = 'Domain name not allowed in type definition.';
- //SErrExpectedChar = 'Expected CHAR or CHARACTER, got "%s"';
- SErrVaryingNotAllowed = 'VARYING not allowed at this point.';
- SErrUnknownBooleanOp = 'Unknown boolean operation';
- SErrUnknownComparison = 'unknown Comparison operation';
- SErrIntegerExpected = 'Integer expression expected';
- SErrInvalidUseOfCollate = 'Invalid use of COLLATE';
- //SErrCannotAlterGenerator = 'Alter generator statement unknown';
- SErrInvalidLiteral = 'Invalid literal: "%s"';
- SErrNoAggregateAllowed = 'Aggregate function not allowed.';
- SErrAsteriskOnlyInCount = '* allowed only in COUNT aggregate';
- SErrUpperOneArgument = 'Only one argument for UPPER allowed';
- SErrHavingWithoutGroupBy = 'HAVING without GROUP BY clause not allowed';
- SErrNoAsteriskInSingleTon = '* not allowed in singleton select';
- SErrUnionFieldCountMatch = 'Field count mismatch in select union : %d <> %d';
- SErrInvalidExtract = 'Invalid element for extract: %s';
- SErrOuterWithout = 'OUTER without preceding LEFT, RIGHT or FULL';
- // SErrRestartWithAlter = 'RESTART only with ALTER SEQUENCE';
- SErrCommaOrSquareArray = 'Expected , or ] in array dimension';
- Function StringToSQLExtractElement(Const S : TSQLStringType; Out Res : TSQLExtractElement) : Boolean;
- Var
- I : TSQLExtractElement;
- SU : TSQLStringTYpe;
- begin
- Result:=False;
- SU:=Uppercase(S);
- For I:=Low(TSQLExtractElement) to High(TSQLExtractElement) do
- If ExtractElementNames[i]=SU then
- begin
- Res:=I;
- Exit(True);
- end;
- end;
- { TSQLParser }
- procedure TSQLParser.Expect(aToken: TSQLToken);
- begin
- {$ifdef debugparser} Writeln('Expecting : ',GetEnumName(TypeInfo(TSQLToken),Ord(AToken)), ' As string: ',TokenInfos[AToken]);{$endif debugparser}
- If (CurrentToken<>aToken) then
- Error(SerrTokenMismatch,[CurrenttokenString,TokenInfos[aToken]]);
- end;
- procedure TSQLParser.Expect(aTokens: TSQLTokens);
- begin
- if not (CurrentToken in aTokens) then
- UnexpectedToken(aTokens);
- end;
- procedure TSQLParser.Consume(aToken: TSQLToken);
- begin
- Expect(aToken);
- GetNextToken;
- end;
- procedure TSQLParser.Consume(aTokens: TSQLTokens);
- begin
- Expect(aTokens);
- GetNextToken;
- end;
- function TSQLParser.CurSource: String;
- begin
- Result:=FScanner.CurFilename;
- end;
- function TSQLParser.CurLine: Integer;
- begin
- Result:=FScanner.CurRow;
- end;
- function TSQLParser.CurPos: Integer;
- begin
- Result:=FScanner.CurColumn;
- end;
- procedure TSQLParser.Error(Msg: String);
- Var
- ErrAt : String;
- E : ESQLParser;
- begin
- If Assigned(FScanner) then
- If FScanner.CurFilename<>'' then
- ErrAt:=Format('Error: file "%s" line %d, pos %d: ',[FScanner.CurFileName,FScanner.CurRow,FScanner.CurColumn])
- else
- ErrAt:=Format('Error: line %d, pos %d: ',[FScanner.Currow,FScanner.CurColumn]);
- E:=ESQLParser.Create(ErrAt+Msg);
- If Assigned(FScanner) then
- begin
- E.Line:=FScanner.CurRow;
- E.Col:=FScanner.CurColumn;
- E.FileName:=FScanner.CurFilename;
- end;
- Raise E;
- end;
- procedure TSQLParser.Error(Fmt: String; Args: array of const);
- begin
- Error(Format(Fmt,Args));
- end;
- function TSQLParser.CreateElement(AElementClass: TSQLElementClass;
- APArent: TSQLElement): TSQLElement;
- begin
- Result:=AElementClass.Create(AParent);
- Result.Source:=CurSource;
- Result.SourceLine:=CurrentTokenLine;
- Result.SourcePos:=CurrentTokenPos;
- end;
- function TSQLParser.ParseTableRef(AParent: TSQLSelectStatement
- ): TSQLTableReference;
- Var
- T : TSQLSimpleTablereference;
- J : TSQLJoinTableReference;
- begin
- If (CurrentToken=tsqlBraceOpen) then
- begin
- GetNextToken;
- Result:=ParseTableRef(AParent);
- Consume(tsqlBraceClose)
- end
- else
- begin
- Expect(tsqlIdentifier);
- T:=TSQLSimpleTableReference(CreateElement(TSQLSimpleTableReference,AParent));
- Result:=T;
- T.ObjectNamePath.Add(CreateIdentifier(T,CurrentTokenString));
- GetNextToken;
- while CurrentToken=tsqlDOT do
- begin
- GetNextToken;
- Expect(tsqlIdentifier);
- T.ObjectNamePath.Add(CreateIdentifier(T,CurrentTokenString));
- GetNextToken;
- end;
- If CurrentToken=tsqlBraceOpen then
- begin
- T.Params:=ParseValueList(AParent,[eoParamValue]);
- GetNextToken;
- end;
- // Table aliases with and without AS keyword
- if (CurrentToken in [tsqlIdentifier,tsqlAs]) then
- begin
- if CurrentToken=tsqlAs then
- begin
- GetNextToken;
- Expect(tsqlIdentifier);
- end;
- T.AliasName:=CreateIdentifier(T,CurrentTokenString);
- GetNextToken;
- end;
- end;
- Repeat
- If CurrentToken in [tsqlInner,tsqlFull,tsqlJoin,tsqlOuter,tsqlLeft,tsqlRight] then
- begin
- J:=TSQLJoinTableReference(CreateElement(TSQLJoinTableReference,AParent));
- J.Left:=Result;
- Result:=J;
- Case CurrentToken of
- tsqlInner : J.JoinType:=jtInner;
- tsqlJoin : J.JoinType:=jtNone;
- tsqlFull : J.JoinType:=jtFullOuter;
- tsqlLeft : J.JoinType:=jtLeft;
- tsqlRight : J.JoinType:=jtRight;
- else
- expect([tsqlInner,tsqlFull,tsqlJoin,tsqlOuter,tsqlLeft,tsqlRight]);
- end;
- if CurrentToken<>tsqlJoin then
- GetNextToken;
- // Ignore OUTER in FULL OUTER, LEFT OUTER, RIGHT OUTER...:
- if CurrentToken=tsqlOuter then
- begin
- if PreviousToken in [tsqlFull, tsqlLeft, tSQLRight] then
- Consume(tsqlOuter)
- else
- Error(SErrOuterWithout);
- end;
- Consume(tsqlJoin);
- J.Right:=ParseTableRef(AParent);
- Consume(tsqlOn);
- J.JoinClause:=ParseExprLevel1(J,[eoJOIN]);
- end;
- until Not (CurrentToken in [tsqlInner,tsqlFull,tsqlJoin,tsqlOuter,tsqlLeft,tsqlRight]);
- end;
- procedure TSQLParser.ParseFromClause(AParent: TSQLSelectStatement;
- AList: TSQLElementList);
- Var
- T : TSQLTableReference;
- Done : Boolean;
- begin
- // On entry, we are on the FROM keyword.
- AList.Source:=CurSource;
- AList.SourceLine:=CurrentTokenLine;
- AList.SourcePos:=CurrentTokenPos;
- Consume(tsqlFrom);
- Repeat
- T:=ParseTableRef(AParent);
- AList.Add(T);
- Done:=(CurrentToken<>tsqlComma);
- If not Done then
- GetNextToken;
- until Done;
- end;
- procedure TSQLParser.ParseSelectFieldList(AParent: TSQLSelectStatement;
- AList: TSQLElementList; Singleton: Boolean);
- Var
- F : TSQLSelectField;
- A : TSQLSelectAsterisk;
- B : Boolean;
- Expression : TSQLExpression;
- begin
- // On entry, we're on the token preceding the field list.
- AList.Source:=CurSource;
- AList.SourceLine:=CurrentTokenLine;
- AList.SourcePos:=CurrentTokenPos;
- B:=True;
- Repeat
- GetNextToken;
- If B then
- begin
- if (CurrentToken=tsqlTop) then
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- AParent.Limit.Style := lsMSSQL;
- AParent.Limit.Top := StrToInt(CurrentTokenString);
- GetNextToken;
- end;
- if (CurrentToken=tsqlFIRST) then
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- AParent.Limit.Style := lsFireBird;
- AParent.Limit.First := StrToInt(CurrentTokenString);
- GetNextToken;
- if (CurrentToken=tsqlSKIP) then
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- AParent.Limit.Skip := StrToInt(CurrentTokenString);
- GetNextToken;
- end;
- end;
- if (CurrentToken=tsqlDistinct) then
- begin
- AParent.Distinct:=True;
- GetNextToken;
- end
- else if (CurrentToken=tsqlAll) then
- begin
- AParent.All:=True;
- GetNextToken;
- end;
- B:=False;
- end;
- Expression:=ParseExprLevel1(AParent,[eoSelectvalue]);
- if Expression is TSQLAsteriskExpression then
- begin
- If Singleton then
- Error(SErrNoAsteriskInSingleTon);
- A:=TSQLSelectAsterisk(CreateElement(TSQLSelectAsterisk,AParent));
- AList.Add(A);
- A.Expression:=TSQLAsteriskExpression(Expression);
- end
- else
- begin
- F:=TSQLSelectField(CreateElement(TSQLSelectField,AParent));
- AList.Add(F);
- F.Expression:=Expression;
- If CurrentToken in [tsqlAs,Tsqlidentifier,tsqlString] then
- begin
- If currentToken=tsqlAs then
- GetNextToken;
- Expect([tsqlIdentifier,tsqlString]);
- F.AliasName:=CreateIdentifier(F,CurrentTokenString);
- GetNextToken;
- end;
- end;
- Expect([tsqlComma,tsqlFrom,tsqlEOF]);
- until (CurrentToken in [tsqlFROM,tsqlEOF]);
- end;
- procedure TSQLParser.ParseGroupBy(AParent: TSQLSelectStatement;
- AList: TSQLElementList);
- Var
- N : TSQLStringType;
- begin
- // On entry we're on the GROUP token.
- AList.Source:=CurSource;
- AList.SourceLine:=CurrentTokenLine;
- AList.SourcePos:=CurrentTokenPos;
- Consume(tsqlGroup);
- Expect(tsqlBy);
- Repeat
- GetNextToken;
- Expect(tsqlIdentifier);
- N:=CurrentTokenString;
- GetNextToken;
- If (CurrentToken=tsqlDot) then
- begin
- GetNextToken;
- Expect(tsqlIdentifier);
- N:=N+'.'+CurrentTokenString;
- GetNextToken;
- end;
- AList.Add(CreateIdentifier(AParent,N));
- until (CurrentToken<>tsqlComma);
- end;
- function TSQLParser.ParseForUpdate(AParent: TSQLSelectStatement
- ): TSQLElementList;
- begin
- // On entry we're on the FOR token.
- Consume(tsqlFor);
- Expect(tsqlUpdate);
- Result:=TSQLElementList.Create(True);
- try
- Repeat
- GetNextToken;
- Expect(tsqlIdentifier);
- Result.Add(CreateIdentifier(AParent,CurrentTokenString));
- until (CurrentToken<>tsqlComma);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- procedure TSQLParser.ParseOrderBy(AParent: TSQLSelectStatement;
- AList: TSQLElementList);
- Var
- O : TSQLOrderByElement;
- F : TSQLElement;
- BuildToken : string;
- begin
- // On entry we're on the ORDER token.
- AList.Source:=CurSource;
- AList.SourceLine:=CurrentTokenLine;
- AList.SourcePos:=CurrentTokenPos;
- Consume(tsqlOrder);
- Expect(tsqlBy);
- Repeat
- GetNextToken;
- // Deal with table.column notation:
- Case CurrentToken of
- tsqlIdentifier :
- begin
- BuildToken:=CurrentTokenString;
- If (PeekNextToken=tsqlDot) then
- begin
- GetNextToken; //past tsqlDot
- GetNextToken;
- Expect(tsqlIdentifier);
- BuildToken:=BuildToken+'.'+CurrentTokenString;
- end;
- F:=CreateIdentifier(AParent,BuildToken);
- end;
- tsqlIntegerNumber : //e.g. ORDER BY 1
- begin
- F:=TSQLIntegerLiteral(CreateElement(TSQLIntegerLiteral,AParent));
- TSQLIntegerLiteral(F).Value:=StrToInt(CurrentTokenString);
- end
- else
- UnexpectedToken([tsqlIdentifier,tsqlIntegerNumber]);
- end;
- try
- O:=TSQLOrderByElement(CreateElement(TSQLOrderByElement,APArent));
- AList.Add(O);
- O.Field:=F;
- F:=Nil;
- except
- FreeAndNil(F);
- Raise;
- end;
- GetNextToken;
- If (CurrentToken=tsqlCollate) then
- begin
- GetNextToken;
- Expect(tsqlidentifier);
- O.Collation:=CreateIdentifier(O,CurrentTokenString);
- GetNextToken;
- end;
- If (CurrentToken in [tsqlDesc,tsqlAsc,tsqlDescending,tsqlAscending]) then
- begin
- If (CurrentToken in [tsqlDesc,tsqlDescending]) then
- O.OrderBy:=obDescending
- else
- O.OrderBy:=obAscending;
- GetNextToken;
- end;
- until (CurrentToken<>tsqlComma);
- end;
- function TSQLParser.ParseSelectPlan(AParent: TSQLElement): TSQLSelectPlan;
- Var
- E : TSQLSelectPlanExpr;
- I : TSQLSelectPlanItem;
- L : TSQLElementList;
- N : TSQLStringType;
- begin
- Result:=Nil;
- try
- Case CurrentToken of
- tsqlIdentifier :
- begin
- If Not (AParent is TSQLSelectPlanExpr) then
- UnexpectedToken([tsqlJoin,tsqlmerge,tsqlSort]);
- N:=CurrentTokenString;
- Case GetNextToken of
- tsqlNatural:
- begin
- I:=TSQLSelectNaturalPlan(CreateElement(TSQLSelectNaturalPlan,AParent));
- Result:=I;
- end;
- tsqlIndex :
- begin
- I:=TSQLSelectIndexedPlan(CreateElement(TSQLSelectIndexedPlan,AParent));
- Result:=I;
- L:=TSQLSelectIndexedPlan(I).Indexes;
- GetNextToken;
- expect(tsqlBraceOpen);
- Repeat
- GetNextToken;
- Expect(tsqlidentifier);
- L.Add(CreateIdentifier(Result,CurrentTokenString));
- GetNextToken;
- Expect([tsqlComma,tsqlBraceClose]);
- until (CurrentToken=tsqlBraceClose);
- end;
- tsqlOrder:
- begin
- GetNextToken;
- expect(tsqlIdentifier);
- I:=TSQLSelectOrderedPlan(CreateElement(TSQLSelectOrderedPlan,AParent));
- Result:=I;
- TSQLSelectOrderedPlan(I).OrderIndex:=CreateIdentifier(I,CurrentTokenstring);
- end;
- else
- Unexpectedtoken([tsqlNatural,tsqlIndex,tsqlOrder]);
- end;
- I.TableName:=CreateIdentifier(I,N);
- end;
- tsqlJoin,
- tsqlmerge,
- tsqlSort,
- tsqlBraceOpen:
- begin
- E:=TSQLSelectPlanExpr(CreateElement(TSQLSelectPlanExpr,AParent));
- Result:=E;
- Case CurrentToken of
- tsqlJoin,
- tsqlBraceOpen : E.Jointype:=pjtJoin;
- tsqlSort : E.JoinType:=pjtSort;
- tsqlMerge : E.JoinType:=pjtMerge;
- else
- expect([tsqlJoin,tsqlmerge,tsqlSort,tsqlBraceOpen]);
- end;
- If (CurrentToken<>tsqlBraceOpen) then
- GetNextToken;
- expect(tsqlBraceOpen);
- repeat
- GetNextToken;
- E.Items.Add(ParseSelectPlan(E));
- Expect([tsqlComma,tsqlBraceClose]);
- until (CurrentToken=tsqlBraceClose);
- end;
- else
- UnexpectedToken([tsqlIdentifier,tsqlJoin,tsqlmerge,tsqlSort]);
- end;
- GetNextToken;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseSelectStatement(AParent: TSQLElement; Flags : TSelectFlags = []): TSQLSelectStatement;
- begin
- // On entry, we're on the SELECT keyword
- Expect(tsqlSelect);
- Result:=TSQLSelectStatement(CreateElement(TSQLSelectStatement,AParent));
- try
- If (PeekNextToken=tsqlTransaction) then
- begin
- Consume(tsqlSelect);
- GetNextToken;
- Expect(TSQLIdentifier);
- Result.TransactionName:=CreateIdentifier(Result,CurrentTokenString);
- end;
- ParseSelectFieldList(Result,Result.Fields,sfSingleton in Flags);
- If CurrentToken=tsqlEOF then
- Exit;
- // On return, we are on the FROM keyword.
- ParseFromClause(Result,Result.Tables);
- If CurrentToken=tsqlWhere then
- begin
- GetNextToken;
- Result.Where:=ParseExprLevel1(Result,[eoWhereClause]);
- end;
- if CurrentToken=tsqlGroup then
- ParseGroupBy(Result,Result.GroupBy);
- if CurrentToken=tsqlHaving then
- begin
- If (Result.GroupBy.Count=0) then
- Error(SErrHavingWithoutGroupBy);
- GetNextToken;
- Result.Having:=ParseExprLevel1(Result,[eoHaving]);
- end;
- if (CurrentToken=tsqlUnion) then
- begin
- GetNextToken;
- If (CurrentToken=tsqlAll) then
- begin
- Result.UnionAll:=True;
- GetNextToken;
- end;
- Result.Union:=ParseSelectStatement(Result,Flags + [sfunion]);
- If (Result.Fields.count<>Result.Union.Fields.Count) then
- Error(SErrUnionFieldCountMatch,[Result.Fields.Count,Result.Union.Fields.Count])
- end;
- if (CurrentToken=tsqlPlan) then
- begin
- GetNextToken;
- Result.Plan:=ParseSelectPlan(Result);
- end;
- if not (sfUnion in Flags) then
- begin
- if (CurrentToken=tsqlOrder) then
- ParseOrderBy(Result,Result.OrderBy);
- if CurrentToken in [tsqlLimit,tsqlOFFSET] then
- ParseLimit(Result,Result.Limit);
- if (CurrentToken=tsqlFOR) then
- Result.ForUpdate:=ParseForUpdate(Result);
- end;
- if (sfInto in Flags) then
- begin
- if (CurrentToken=tsqlInto) then
- begin
- Result.Into:=TSQLElementList.Create(true);
- ParseIntoList(Result,Result.Into);
- end;
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseUpdateStatement(AParent: TSQLElement
- ): TSQLUpdateStatement;
- Var
- P : TSQLUpdatePair;
- N : String;
- begin
- // On entry, we're on the UPDATE keyword
- Consume(tsqlUpdate);
- Expect(tsqlidentifier);
- Result:=TSQLUpdateStatement(CreateElement(TSQLUpdateStatement,AParent));
- try
- Result.TableName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- Expect(tsqlSet);
- Repeat
- GetNextToken;
- Expect(tsqlIdentifier);
- P:=TSQLUpdatePair(CreateElement(TSQLUpdatePair,Result));
- Result.Values.Add(P);
- N:=CurrentTokenString;
- GetNextToken;
- If (CurrentToken=tsqlDot) then
- begin
- GetNextToken;
- Expect(TSQLIdentifier);
- N:=N+'.'+CurrentTokenString;
- GetNextToken;
- end;
- Consume(tsqlEq);
- P.FieldName:=CreateIdentifier(P,N);
- P.Value:=ParseExprLevel1(P,[eoFieldValue]);
- until (CurrentToken<>tsqlComma);
- If (CurrentToken=tsqlWhere) then
- begin
- GetNextToken;
- Result.WhereClause:=ParseExprLevel1(P,[eoWhereClause]);
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseInsertStatement(AParent: TSQLElement): TSQLInsertStatement;
- begin
- // On entry, we're on the INSERT statement
- Consume(tsqlInsert);
- Consume(tsqlInto);
- Expect(tsqlidentifier);
- Result:=TSQLInsertStatement(CreateElement(TSQLinsertStatement,AParent));
- try
- Result.TableName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- If CurrentToken=tsqlBraceOpen then
- begin
- Result.Fields:=TSQLElementList.Create(True);
- Repeat
- GetNextToken;
- Expect(tsqlIdentifier);
- Result.Fields.Add(CreateIdentifier(Result,CurrentTokenString));
- GetNextToken;
- Expect([tsqlBraceClose,tsqlComma]);
- Until (CurrentToken=tsqlBraceClose);
- GetNextToken;
- end;
- Case CurrentToken of
- tsqlSelect :
- Result.Select:=ParseSelectStatement(Result);
- tsqlValues :
- begin
- GetNextToken;
- Result.Values:=ParsevalueList(Result,[eoFieldValue]);
- GetNextToken; // consume )
- end;
- else
- UnexpectedToken([tsqlselect,tsqlValues]);
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseDeleteStatement(AParent: TSQLElement
- ): TSQLDeleteStatement;
- begin
- // On entry, we're on the DELETE token.
- consume(tsqlDelete);
- consume(tsqlFrom);
- Expect(tsqlidentifier);
- Result:=TSQLDeleteStatement(CreateElement(TSQLDeleteStatement,AParent));
- try
- Result.TableName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- if CurrentToken=tsqlIdentifier then
- begin
- Result.AliasName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- end;
- if CurrentToken=tsqlwhere then
- begin
- Consume(tsqlWhere);
- Result.WhereClause:=ParseExprLevel1(Result,[eoWhereClause]);
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseTableFieldDef(AParent: TSQLElement): TSQLTableFieldDef;
- begin
- // on entry, we're on the field name
- Result:=TSQLTableFieldDef(CreateElement(TSQLTableFieldDef,AParent));
- try
- Result.FieldName:=CreateIdentifier(Result,CurrentTokenString);
- if PeekNextToken = tsqlComputed then
- begin
- GetNextToken;
- Consume(tsqlComputed);
- If CurrentToken=tsqlBy then
- GetNextToken;
- Consume(tsqlBraceopen);
- Result.ComputedBy:=ParseExprLevel1(Result,[eoComputedBy]);
- Consume(tsqlBraceClose);
- end
- else //not computed, regular field
- Result.FieldType:=ParseTypeDefinition(Result,[ptfAllowDomainName,ptfAllowConstraint,ptfTableFieldDef]);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseTableConstraint(AParent: TSQLElement
- ): TSQLTableConstraintDef;
- Procedure ParseFieldList(R : TSQLTableFieldsConstraintDef);
- begin
- GetNextToken;
- Consume(tsqlBraceOpen);
- ParseIdentifierList(AParent,R.FieldList);
- // Consume(tsqlBraceClose);
- end;
- Var
- N : TSQLStringType;
- K : TSQLTableForeignKeyConstraintDef;
- begin
- If CurrentToken=tsqlConstraint then
- begin
- GetNextToken;
- Expect(tsqlIdentifier);
- N:=CurrentTokenString;
- GetNextToken
- end;
- Result:=Nil;
- try
- Case CurrentToken of
- tsqlUnique :
- begin
- Result:=TSQLTableUniqueConstraintDef(CreateElement(TSQLTableUniqueConstraintDef,AParent));
- ParseFieldList(TSQLTableFieldsConstraintDef(Result));
- end;
- tsqlPrimary :
- begin
- GetNextToken;
- Expect(tsqlKey);
- Result:=TSQLTablePrimaryKeyConstraintDef(CreateElement(TSQLTablePrimaryKeyConstraintDef,AParent));
- ParseFieldList(TSQLTableFieldsConstraintDef(Result));
- end;
- tsqlForeign :
- begin
- GetNextToken;
- Expect(tsqlKey);
- K:=TSQLTableForeignKeyConstraintDef(CreateElement(TSQLTableForeignKeyConstraintDef,AParent));
- Result:=K;
- ParseFieldList(TSQLTableFieldsConstraintDef(Result));
- Expect(tsqlReferences);
- K.Definition:=ParseForeignKeyDefinition(K);
- end;
- tsqlCheck:
- begin
- Result:=TSQLTableCheckConstraintDef(CreateElement(TSQLTableCheckConstraintDef,AParent));
- TSQLTableCheckConstraintDef(Result).Check:=ParseCheckConstraint(Result,True);
- end
- else
- UnexpectedToken([tsqlUnique,tsqlPrimary,tsqlForeign,tsqlCheck]);
- end;
- If (N<>'') then
- Result.ConstraintName:=CreateIdentifier(Result,N);
- // GetNextToken;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseCreateTableStatement(AParent: TSQLElement): TSQLCreateOrAlterStatement;
- Var
- C : TSQLCreateTableStatement;
- HC : Boolean;
- begin
- // On enter, we're on the TABLE token.
- Consume(tsqlTable);
- C:=TSQLCreateTableStatement(CreateElement(TSQLCreateTableStatement,AParent));
- try
- Expect(tsqlIdentifier);
- C.ObjectName:=CreateIdentifier(C,CurrentTokenstring);
- GetNextToken;
- If (CurrentToken=tsqlExternal) then
- begin
- GetNextToken;
- If (CurrentToken=tsqlFile) then
- GetNextToken;
- Expect(tsqlString);
- C.ExternalFileName:=CreateLiteral(C) as TSQLStringLiteral;
- GetNextToken;
- end;
- Expect(tsqlBraceOpen);
- HC:=False;
- Repeat
- GetNextToken;
- Case CurrentToken of
- tsqlIdentifier :
- begin
- if HC then
- UnexpectedToken;
- C.FieldDefs.Add(ParseTableFieldDef(C));
- end;
- tsqlCheck,
- tsqlConstraint,
- tsqlForeign,
- tsqlPrimary,
- tsqlUnique:
- begin
- C.Constraints.Add(ParseTableConstraint(C));
- HC:=true;
- end
- else
- UnexpectedToken([tsqlIdentifier,tsqlCheck, tsqlConstraint,tsqlForeign,tsqlPrimary,tsqlUnique]);
- end;
- expect([tsqlBraceClose,tsqlComma]);
- until (CurrentToken=tsqlBraceClose);
- GetNextToken;
- Result:=C;
- except
- FreeandNil(C);
- Raise;
- end;
- end;
- function TSQLParser.ParseDropTableElement(AParent : TSQLElement) : TSQLDropTableElementOperation;
- Var
- C : Boolean;
- begin
- // On entry, we are on DROP token
- C:=(GetNextToken=tsqlConstraint);
- If C then
- GetNextToken;
- Expect(tsqlidentifier);
- If C then
- Result:=TSQLDropTableConstraintOperation(CreateElement(TSQLDropTableConstraintOperation,AParent))
- else
- Result:=TSQLDropTableFieldOperation(CreateElement(TSQLDropTableFieldOperation,AParent));
- Result.ObjectName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- end;
- function TSQLParser.ParseAddTableElement(AParent : TSQLElement) : TSQLAlterTableAddElementOperation;
- begin
- Result:=Nil;
- try
- Case GetNextToken of
- tsqlIdentifier :
- begin
- Result:=TSQLAlterTableAddElementOperation(CreateElement(TSQLAlterTableAddFieldOPeration,AParent));
- Result.Element:=ParseTableFieldDef(Result);
- end;
- tsqlCheck,
- tsqlConstraint,
- tsqlForeign,
- tsqlPrimary,
- tsqlUnique:
- begin
- Result:=TSQLAlterTableAddElementOperation(CreateElement(TSQLAlterTableAddConstraintOperation,AParent));
- Result.Element:=ParseTableConstraint(Result);
- end
- else
- UnexpectedToken([tsqlIdentifier,tsqlCheck, tsqlConstraint,tsqlForeign,tsqlPrimary,tsqlUnique]);
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseAlterTableElement(AParent : TSQLElement) : TSQLAlterTableOperation;
- Var
- N : TSQLStringType;
- begin
- Result:=Nil;
- If GetnextToken=tsqlColumn then
- GetNextToken;
- expect(tsqlidentifier);
- N:=CurrentTokenString;
- try
- Case GetNextToken of
- tsqlTo :
- begin
- GetNextToken;
- Result:=TSQLAlterTableOperation(CreateElement(TSQLAlterTableFieldNameOperation,AParent));
- TSQLAlterTableFieldNameOperation(Result).NewName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- end;
- tsqltype:
- begin
- Result:=TSQLAlterTableOperation(CreateElement(TSQLAlterTableFieldTypeOperation,AParent));
- TSQLAlterTableFieldTypeOperation(Result).NewType:= ParseTypeDefinition(Result,[ptfAllowDomainName,ptfAllowConstraint,ptfTableFieldDef]);
- end;
- tsqlPosition:
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- Result:=TSQLAlterTableOperation(CreateElement(TSQLAlterTableFieldPositionOperation,AParent));
- TSQLAlterTableFieldPositionOperation(Result).NewPosition:=StrToInt(CurrentTokenString);
- GetNextToken;
- end
- else
- UnexpectedToken([tsqlTo,tsqltype,tsqlPosition]);
- end;
- Result.ObjectName:=CreateIdentifier(Result,N);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseAlterTableStatement(AParent: TSQLElement): TSQLAlterTableStatement;
- begin
- // On enter, we're on the TABLE token.
- Consume(tsqlTable);
- Result:=TSQLAlterTableStatement(CreateElement(TSQLAlterTableStatement,AParent));
- try
- Expect(tsqlIdentifier);
- Result.ObjectName:=CreateIdentifier(Result,CurrentTokenstring);
- Repeat
- GetNextToken;
- Case CurrentToken of
- tsqlAdd:
- begin
- Result.Operations.Add(ParseAddTableElement(Result));
- end;
- tsqlAlter:
- begin
- Result.Operations.Add(ParseAlterTableElement(Result));
- end;
- tsqlDrop :
- begin
- Result.Operations.add(ParseDropTableElement(Result));
- end;
- else
- UnexpectedToken([tsqlAdd,tsqlAlter,tsqlDrop]);
- end;
- until (CurrentToken<>tsqlComma);
- except
- FreeandNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseCreateIndexStatement(AParent: TSQLElement; IsAlter: Boolean
- ): TSQLCreateOrAlterStatement;
- Var
- O : TIndexOptions;
- C : TSQLCreateIndexStatement;
- A : TSQLAlterIndexStatement;
- begin
- O:=[];
- // On enter, we're on the UNIQUE, ASCENDING, DESCENDING or INDEX token
- If IsAlter then
- begin
- expect(tsqlIndex);
- Consume(tsqlIndex);
- A:=TSQLAlterIndexStatement(CreateElement(TSQLAlterIndexStatement,APArent));
- try
- Expect(tsqlIdentifier);
- A.ObjectName:=CreateIdentifier(A,CurrentTokenString);
- GetNextToken;
- Expect([tsqlActive,tsqlInactive]);
- A.Inactive:=CurrentToken=tsqlInactive;
- GetNextToken; // Token after ) or (in)Active
- Result:=A;
- except
- FReeAndNil(A);
- Raise;
- end;
- end
- else
- begin
- C:=TSQLCreateIndexStatement(CreateElement(TSQLCreateIndexStatement,APArent));
- try
- If (CurrentToken=tsqlUnique) then
- begin
- GetNextToken;
- Include(O,ioUnique);
- end;
- If (CurrentToken=tsqlAscending) then
- begin
- GetNextToken;
- Include(O,ioAscending);
- end
- else If (CurrentToken=tsqlDescending) or (CurrentToken=tsqlDesc) then
- begin
- GetNextToken;
- Include(O,ioDescending);
- end;
- C.Options:=O;
- Consume(tsqlIndex);
- Expect(tsqlIdentifier);
- C.ObjectName:=CreateIdentifier(C,CurrentTokenString);
- GetNextToken;
- Consume(tsqlOn);
- Expect(tsqlIdentifier);
- C.TableName:=Createidentifier(C,CurrentTokenString); // name of table
- GetNextToken;
- Consume(tsqlBraceOpen);
- ParseIdentifierList(C,C.FieldNames);
- Result:=C;
- except
- FreeAndNil(C);
- Raise;
- end;
- end;
- end;
- function TSQLParser.ParseCreateViewStatement(AParent: TSQLElement; IsAlter: Boolean
- ): TSQLCreateOrAlterStatement;
- Var
- V : TSQLCreateViewStatement;
- begin
- // on entry, we're on the VIEW token.
- If IsAlter then
- UnexpectedToken;
- Result:=Nil;
- Consume(tsqlView);
- Expect(tsqlIdentifier);
- V:=TSQLCreateViewStatement(CreateElement(TSQLCreateViewStatement,APArent));
- Result:=V;
- try
- V.ObjectName:=CreateIdentifier(V,CurrentTokenString);
- GetNextToken;
- If (CurrentToken=tsqlBraceOpen) then
- begin
- GetNextToken;
- ParseIdentifierList(Result,V.Fields);
- end;
- Consume(tsqlAs);
- V.Select:=ParseSelectStatement(V,[]);
- If (CurrentToken=tsqlWith) then
- begin
- GetNextToken;
- Consume(tsqlCheck);
- Consume(tsqlOption);
- V.WithCheckOption:=True;
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- procedure TSQLParser.ParseProcedureParamList(AParent: TSQLElement;
- AList: TSQLElementList);
- Var
- P : TSQLProcedureParamDef;
- begin
- // On Entry, we're on the ( token
- Repeat
- GetNextToken;
- Expect(tsqlIdentifier);
- P:=TSQLProcedureParamDef(CreateElement(TSQLProcedureParamDef,AParent));
- try
- Alist.Add(P);
- except
- P.free;
- Raise;
- end;
- P.ParamName:=CreateIdentifier(P,CurrentTokenString);
- // Typedefinition will go to next token
- P.ParamType:=ParseTypeDefinition(P,[ptProcedureParam]);
- Until (CurrentToken<>tsqlComma);
- Consume(tsqlBraceClose);
- end;
- procedure TSQLParser.ParseCreateProcedureVariableList(AParent: TSQLElement;
- AList: TSQLElementList);
- Var
- P : TSQLProcedureParamDef;
- begin
- // On Entry, we're on the DECLARE token
- Repeat
- Consume(tsqlDeclare);
- Consume(tsqlVariable);
- Expect(tsqlIdentifier);
- P:=TSQLProcedureParamDef(CreateElement(TSQLProcedureParamDef,AParent));
- Try
- AList.Add(P);
- except
- P.Free;
- Raise;
- end;
- P.ParamName:=CreateIdentifier(P,CurrentTokenString);
- // Typedefinition will go to next token
- P.ParamType:=ParseTypeDefinition(P,[ptProcedureParam]);
- Consume(tsqlSemicolon);
- Until (CurrentToken<>tsqlDeclare);
- end;
- function TSQLParser.ParseIfStatement(AParent: TSQLElement): TSQLIFStatement;
- begin
- // On Entry, we're on the IF token
- Consume(tsqlIf);
- Consume(tsqlBraceOpen);
- Result:=TSQLIFStatement(CreateElement(TSQLIFStatement,AParent));
- try
- Result.Condition:=ParseExprLevel1(AParent,[eoIF]);
- Consume(tsqlBraceClose);
- Consume(tsqlThen);
- Result.TrueBranch:=ParseProcedureStatement(Result);
- If (CurrentToken=tsqlSemicolon) and (PeekNextToken=tsqlElse) then
- GetNextToken
- else if (CurrentToken=tsqlElse) then
- if not (PreviousToken=tsqlEnd) then
- UnexpectedToken;
- If CurrentToken=tsqlElse then
- begin
- GetNextToken;
- Result.FalseBranch:=ParseProcedureStatement(Result);
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseCaseExpression(AParent: TSQLElement): TSQLCaseExpression;
- var
- Branch: TSQLCaseExpressionBranch;
- begin
- Consume(tsqlCASE);
- Result:=TSQLCaseExpression(CreateElement(TSQLCaseExpression,AParent));
- try
- if CurrentToken<>tsqlWhen then // case A when 1 the 2 when 3 then 4 else 5
- Result.Selector:=ParseExprLevel1(AParent,[eoIF]);
- while CurrentToken=tsqlWhen do
- begin
- GetNextToken;
- Branch := TSQLCaseExpressionBranch.Create;
- Branch.Condition:=ParseExprLevel1(AParent,[eoIF]);
- Consume(tsqlThen);
- Branch.Expression:=ParseExprLevel1(AParent,[eoIF]);
- Result.AddBranch(Branch);
- end;
- if CurrentToken=tsqlELSE then
- begin
- GetNextToken;
- Result.ElseBranch:=ParseExprLevel1(AParent,[eoIF]);
- end;
- Consume(tsqlEnd);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- procedure TSQLParser.ParseIntoList(AParent : TSQLElement; List : TSQLElementList);
- begin
- // On Entry, we're on the INTO token
- Repeat
- GetNextToken;
- If (currentToken=tsqlColon) then
- Consume(tsqlColon);
- Expect(tsqlIdentifier);
- List.Add(CreateIdentifier(AParent,CurrentTokenString));
- GetNextToken;
- Until (CurrentToken<>tsqlComma);
- end;
- procedure TSQLParser.ParseLimit(AParent: TSQLSelectStatement; ALimit: TSQLSelectLimit);
- procedure DoOffset;
- begin
- if CurrentToken=tsqlOFFSET then
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- ALimit.Offset := StrToInt(CurrentTokenString);
- GetNextToken;
- end;
- end;
- begin
- ALimit.Style:=lsPostgres;
- if CurrentToken=tsqlLIMIT then
- begin
- GetNextToken;
- if CurrentToken=tsqlALL then
- ALimit.RowCount := -1
- else
- begin
- Expect(tsqlIntegerNumber);
- ALimit.RowCount := StrToInt(CurrentTokenString);
- end;
- GetNextToken;
- if CurrentToken=tsqlCOMMA then
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- ALimit.Offset := ALimit.RowCount;
- ALimit.RowCount := StrToInt(CurrentTokenString);
- GetNextToken;
- end
- else
- DoOffset;
- end
- else
- DoOffset;
- end;
- function TSQLParser.ParseForStatement(AParent: TSQLElement): TSQLForStatement;
- begin
- // On Entry, we're on the FOR token
- Consume(tsqlFor);
- Expect(tsqlSelect);
- Result:=TSQLForStatement(CreateElement(TSQLForStatement,AParent));
- try
- Result.Select:=ParseSelectStatement(Result,[]);
- Expect(tsqlInto);
- ParseIntoList(Result,Result.FieldList);
- Consume(tsqlDo);
- Result.Statement:=ParseProcedureStatement(Result);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseExceptionStatement(AParent: TSQLElement
- ): TSQLExceptionStatement;
- begin
- // On Entry, we're on the EXCEPTION token
- Consume(tsqlException);
- Expect(tsqlIdentifier);
- Result:=TSQLExceptionStatement(CreateElement(TSQLExceptionStatement,AParent));
- try
- Result.ExceptionName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseAssignStatement(AParent: TSQLElement
- ): TSQLAssignStatement;
- Var
- N : TSQLStringType;
- begin
- // On entry, we're on the identifier token;
- expect(tsqlIdentifier);
- Result:=TSQLAssignStatement(CreateElement(TSQLAssignStatement,AParent));
- try
- N:=CurrentTokenString;
- GetNextToken;
- If (CurrentToken=tsqlDot) and (Uppercase(N)='NEW') then
- begin
- GetNextToken;
- Expect(tsqlIdentifier);
- N:=N+'.'+CurrentTokenString;
- GetNextToken;
- end;
- Result.Variable:=CreateIdentifier(Result,N);
- Consume(tsqlEq);
- Result.Expression:=ParseExprLevel1(Result,[]);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParsePostEventStatement(AParent: TSQLElement
- ): TSQLPostEventStatement;
- begin
- // On Entry, we're on the POST_EVENT token
- Consume(tsqlPostEvent);
- Result:=TSQLPostEventStatement(CreateElement(TSQLPostEventStatement,AParent));
- try
- Case CurrentToken of
- tsqlIdentifier : Result.ColName:=CreateIdentifier(Result,CurrentTokenString);
- tsqlString : Result.EventName:=CurrentTokenString;
- else
- UnexpectedToken([tsqlIdentifier,tsqlString]);
- end;
- GetNextToken;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseWhileStatement(AParent: TSQLElement
- ): TSQLWhileStatement;
- begin
- // On entry, we're on the WHILE Token
- Consume(tsqlWhile);
- Consume(tsqlBraceOpen);
- Result:=TSQLWhileStatement(CreateElement(TSQLWhileStatement,AParent));
- try
- Result.Condition:=ParseExprLevel1(Result,[eoIF]);
- Consume(tsqlBraceClose);
- Consume(tsqlDO);
- Result.Statement:=ParseProcedureStatement(Result);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseWhenStatement(AParent: TSQLElement): TSQLWhenStatement;
- Var
- E : TSQLWhenException;
- S : TSQLWhenSQLError;
- G : TSQLWhenGDSError;
- begin
- Consume(tsqlWhen);
- Result:=TSQLWhenStatement(CreateElement(TSQLWhenStatement,AParent));
- try
- if (CurrentToken=tsqlAny) then
- begin
- Result.AnyError:=True;
- GetNextToken
- end
- else
- Repeat
- if (Result.Errors.Count>0) then
- GetNextToken;
- Case CurrentToken of
- tsqlException:
- begin
- GetNextToken;
- Expect(tsqlIdentifier);
- E:=TSQLWhenException(CreateElement(TSQLWhenException,AParent));
- E.ExceptionName:=CreateIdentifier(E,CurrentTokenString);
- Result.Errors.Add(E);
- end;
- tsqlSQLCode:
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- S:=TSQLWhenSQLError(CreateElement(TSQLWhenSQLError,AParent));
- S.ErrorCode:=StrToInt(CurrentTokenString);
- Result.Errors.Add(S);
- end;
- tsqlGDSCODE:
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- G:=TSQLWhenGDSError(CreateElement(TSQLWhenGDSError,AParent));
- G.GDSErrorNumber:=StrToInt(CurrentTokenString);
- Result.Errors.Add(G);
- end;
- else
- UnexpectedToken([tsqlException,tsqlSQLCode,tsqlGDSCODE]);
- end;
- GetNextToken;
- until (CurrentToken<>tsqlComma);
- consume(tsqlDo);
- Result.Statement:=ParseProcedureStatement(Result);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseProcedureStatement(AParent: TSQLElement
- ): TSQLStatement;
- begin
- Result:=Nil;
- Case CurrentToken of
- tsqlBegin :
- begin
- Result:=TSQLStatementBlock(CreateElement(TSQLStatementBlock,AParent));
- ParseStatementBlock(Result,TSQLStatementBlock(Result).Statements);
- end;
- tsqlIf : Result:=ParseIfStatement(AParent);
- tsqlFor : Result:=ParseForStatement(AParent);
- tsqlException : Result:=ParseExceptionStatement(AParent);
- tsqlIdentifier : Result:=ParseAssignStatement(AParent);
- tsqlExecute : Result:=ParseExecuteProcedureStatement(AParent);
- tsqlExit : begin
- Result:=TSQLExitStatement(CreateElement(TSQLExitStatement,AParent));
- GetNextToken;
- end;
- tsqlSuspend : begin
- Result:=TSQLSuspendStatement(CreateElement(TSQLSuspendStatement,AParent));
- GetNextToken;
- end;
- tsqlPostEvent : Result:=ParsePostEventStatement(AParent);
- tsqlWhile : Result:=ParseWhileStatement(AParent);
- tsqlWhen : Result:=ParseWhenStatement(AParent);
- tsqlSelect : Result:=ParseSelectStatement(AParent,[sfInto]);
- tsqlInsert : Result:=ParseInsertStatement(AParent);
- tsqlDelete : Result:=ParseDeleteStatement(AParent);
- tsqlUpdate : Result:=ParseUpdateStatement(AParent);
- else
- UnexpectedToken;
- end;
- end;
- procedure TSQLParser.ParseStatementBlock(AParent: TSQLElement;
- Statements: TSQLElementList);
- Var
- S: TSQLStatement;
- begin
- Consume(tsqlBegin);
- While (CurrentToken<>tsqlEnd) do
- begin
- S:=ParseProcedureStatement(AParent);
- Statements.Add(S);
- if not (PreviousToken=tsqlEnd) then
- Consume([tsqlSemicolon]);
- end;
- Consume(tsqlEnd);
- end;
- function TSQLParser.ParseCreateProcedureStatement(AParent: TSQLElement; IsAlter: Boolean
- ): TSQLCreateOrAlterStatement;
- Var
- P : TSQLAlterCreateProcedureStatement;
- begin
- // On entry, we're on the PROCEDURE statement.
- Consume(tsqlProcedure);
- expect(tsqlIdentifier);
- If IsAlter then
- P:=TSQLAlterProcedureStatement(CreateElement(TSQLAlterProcedureStatement,AParent))
- else
- P:=TSQLCreateProcedureStatement(CreateElement(TSQLCreateProcedureStatement,AParent));
- Result:=P;
- try
- Result.ObjectName:=CreateIdentifier(P,CurrentTokenString);
- GetNextToken;
- If (CurrentToken=tsqlBraceOpen) then
- ParseProcedureParamList(Result,P.InputVariables);
- If (CurrentToken=tsqlReturns) then
- begin
- GetNextToken;
- expect(tsqlBraceOpen);
- ParseProcedureParamList(Result,P.OutputVariables);
- end;
- Consume(tsqlAs);
- if (CurrentToken=tsqlDeclare) then
- ParseCreateProcedureVariableList(Result,P.LocalVariables);
- expect(tsqlBegin);
- ParseStatementBlock(Result,P.Statements);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseCreateGeneratorStatement(AParent: TSQLElement; IsAlter: Boolean
- ): TSQLCreateOrAlterStatement;
- Var
- isSequence : Boolean;
- Gen : TSQLCreateOrAlterGenerator;
- Alt : TSQLAlterGeneratorStatement absolute gen;
- begin
- isSequence:=CurrentToken=tsqlSequence;
- GetNextToken;
- Expect(tsqlIdentifier);
- if isAlter then
- Gen:=TSQLCreateOrAlterGenerator(CreateElement(TSQLAlterGeneratorStatement,AParent))
- else
- Gen:=TSQLCreateOrAlterGenerator(CreateElement(TSQLCreateGeneratorStatement,AParent));
- try
- Result:=Gen;
- Result.ObjectName:=CreateIdentifier(Result,CurrentTokenString);
- Gen.IsSequence:=isSequence;
- GetNextToken;
- if isAlter then
- begin
- Expect(tsqlrestart);
- Alt.HasRestart:=True;
- GetNexttoken;
- Consume(tsqlWith);
- Expect(tsqlIntegerNumber);
- Alt.Restart:=StrToInt(CurrentTokenString);
- GetNexttoken;
- end
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseCreateRoleStatement(AParent: TSQLElement;
- IsAlter: Boolean): TSQLCreateOrAlterStatement;
- begin
- If IsAlter then
- UnexpectedToken; // no ALTER ROLE
- GetNextToken;
- Expect(tsqlIdentifier);
- Result:=TSQLCreateOrAlterStatement(CreateElement(TSQLCreateRoleStatement,AParent));
- Result.ObjectName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken; // Comma;
- end;
- procedure TSQLParser.ParseCharTypeDefinition(out DT: TSQLDataType; out
- Len: Integer; out ACharset: TSQLStringType);
- begin
- Len:=0;
- Case CurrentToken of
- tsqlNCHAR : dt:=sdtNchar;
- tsqlVarChar : dt:=sdtVarChar;
- tsqlCharacter,
- tsqlChar : dt:=sdtChar;
- tsqlCString : dt:=sdtCstring;
- tsqlNational :
- begin
- dt:=sdtNChar;
- GetNextToken;
- expect([tsqlCharacter,tsqlChar]);
- end;
- else
- Expect([tsqlNCHAR,tsqlVarChar,tsqlCharacter,tsqlChar, tsqlCString, tsqlNational]);
- end;
- GetNextToken; // VARYING, Start of size, CHARACTER SET or end
- If (CurrentToken=tsqlVarying) then // CHAR VARYING or CHARACTER VARYING;
- begin
- If (dt in [sdtNCHAR,sdtChar]) then
- begin
- if dt=sdtNCHAR then
- dt:=sdtNVARCHAR
- else
- dt:=sdtVarChar;
- GetNextToken
- end
- else
- Error(SErrVaryingNotAllowed);
- end;
- If (CurrentToken=tsqlBraceOpen) then // (LEN)
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- len:=StrToInt(CurrentTokenString);
- GetNextToken;
- Expect(tsqlBraceClose);
- GetNextToken;
- end
- else if (dt=sdtCstring) then
- UnexpectedToken;
- if (CurrentToken=tsqlCharacter) then // Character SET NNN
- begin
- if (dt=sdtCstring) then
- UnexpectedToken;
- GetNextToken;
- Consume(tsqlSet);
- Expect(tsqlIdentifier);
- ACharSet:=CurrentTokenString;
- GetNextToken;
- end;
- end;
- procedure TSQLParser.ParseBlobDefinition(var ASegmentSize, ABlobType: Integer;
- var ACharset: TSQLStringType);
- begin
- // On entry, we are on the blob token.
- GetNextToken;
- If (CurrentToken=tsqlBraceOpen) then // (segment[,subtype])
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- ASegmentSize:=StrtoInt(CurrentTokenString);
- GetNextToken;
- If (CurrentToken=tsqlComma) then
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- ABlobType:=StrtoInt(CurrentTokenString);
- GetNextToken;
- end;
- Consume(tsqlBraceClose);
- If CurrentToken in [tsqlSubtype,tsqlSegment] then
- Error(SErrUnexpectedToken,[CurrentTokenString]);
- end
- else
- begin
- If CurrentToken=tsqlSubtype then // SUB_TYPE T
- begin
- GetNextToken;
- Expect([tsqlIntegerNumber,tsqlBinary,tsqlText]);
- case CurrentToken of
- tsqlBinary: ABlobType:=0; //FB2.0+ see Language Reference Update
- tsqlText: ABlobType:=1;
- tsqlIntegerNumber: ABlobType:=StrtoInt(CurrentTokenString);
- else Error('ParseBlobDefinition: internal error: unknown token type.');
- end;
- GetNextToken;
- end;
- If (CurrentToken=tsqlSegment) then // SEGMENT SIZE S
- begin
- GetNextToken;
- Consume(tsqlSize);
- Expect(tsqlIntegerNumber);
- ASegmentSize:=StrtoInt(CurrentTokenString);
- GetNextToken;
- end;
- end;
- if (CurrentToken=tsqlCharacter) then // CHARACTER SET NNN
- begin
- GetNextToken;
- Consume(tsqlSet);
- Expect(tsqlIdentifier);
- ACharSet:=CurrentTokenString;
- GetNextToken;
- end;
- end;
- function TSQLParser.ParseForeignKeyDefinition(AParent: TSQLElement
- ): TSQLForeignKeyDefinition;
- // On entry, we're on ON Return true if On delete
- Function ParseForeignKeyAction (Out Res : TForeignKeyAction) : Boolean;
- begin
- GetNextToken;
- Case CurrentToken of
- tsqlDelete,
- tsqlUpdate: Result:=CurrentToken=tsqlDelete;
- else
- UnexpectedToken([tsqlDelete,tsqlupdate]);
- end;
- Case GetNextToken of
- tsqlNo :
- begin
- GetNextToken;
- expect(tsqlAction);
- Res:=fkaNoAction;
- end;
- tsqlCascade :
- Res:=fkaCascade;
- tsqlSet:
- begin
- Case GetNextToken of
- tsqlDefault :
- Res:=fkaSetDefault;
- tsqlNull:
- Res:=fkaSetNull;
- else
- UnexpectedToken([tsqlDefault,tsqlNull]);
- end;
- end
- else
- UnexpectedToken([tsqlNo,tsqlCascade,tsqlSet]);
- end;
- GetNextToken;
- end;
- Var
- FKA : TForeignKeyAction;
- begin
- Result:=Nil;
- // on entry, we are on the 'REFERENCES' token
- GetNextToken;
- Expect(tsqlidentifier);
- Result:=TSQLForeignKeyDefinition(CreateElement(TSQLForeignKeyDefinition,AParent));
- try
- Result.TableName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- If (CurrentToken=tsqlBraceOpen) then
- begin
- GetNextToken;
- ParseidentifierList(Result,Result.FieldList);
- end;
- if (CurrentToken=tsqlOn) then
- begin
- If ParseForeignKeyAction(FKA) then
- Result.OnDelete:=FKA
- else
- Result.OnUpdate:=FKA;
- end;
- if (CurrentToken=tsqlOn) then
- begin
- If ParseForeignKeyAction(FKA) then
- Result.OnDelete:=FKA
- else
- Result.OnUpdate:=FKA;
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseFieldConstraint(AParent: TSQLElement
- ): TSQLFieldConstraint;
- Var
- N : TSQLStringType;
- K : TSQLForeignKeyFieldConstraint;
- C : TSQLCheckFieldConstraint;
- L : TSQLFieldConstraintList;
- P : Boolean;
- begin
- Result:=Nil;
- L:=Nil;
- P:=False;
- try
- Repeat
- If (Result<>Nil) then
- begin
- L:=TSQLFieldConstraintList.Create(AParent);
- L.List.Add(Result);
- Result:=Nil;
- end;
- If CurrentToken=tsqlConstraint then
- begin
- GetNextToken;
- Expect(tsqlIdentifier);
- N:=CurrentTokenString;
- GetNextToken
- end;
- Case CurrentToken of
- tsqlUnique :
- begin
- If P then
- Error('Only one primary/unique field constraint allowed');
- Result:=TSQLFieldConstraint(CreateElement(TSQLUniqueFieldConstraint,AParent));
- GetNextToken;
- P:=True;
- end;
- tsqlPrimary :
- begin
- If P then
- Error('Only one primary/unique field constraint allowed');
- GetNextToken;
- Expect(tsqlKey);
- Result:=TSQLFieldConstraint(CreateElement(TSQLPrimaryKeyFieldConstraint,AParent));
- GetNextToken;
- P:=True;
- end;
- tsqlReferences :
- begin
- K:=TSQLForeignKeyFieldConstraint(CreateElement(TSQLForeignKeyFieldConstraint,AParent));
- Result:=K;
- K.Definition:=ParseForeignKeyDefinition(K);
- end;
- tsqlCheck :
- begin
- C:=TSQLCheckFieldConstraint(CreateElement(TSQLCheckFieldConstraint,AParent));
- Result:=C;
- C.Expression:=ParseCheckConstraint(K,True);
- end
- else
- UnexpectedToken([tsqlUnique,tsqlPrimary,tsqlReferences,tsqlCheck]);
- end;
- If (N<>'') then
- Result.ConstraintName:=CreateIdentifier(Result,N);
- Until Not (CurrentToken in [tsqlUnique,tsqlPrimary,tsqlReferences,tsqlCheck,tsqlConstraint]);
- If Assigned(L) then
- begin
- L.List.Add(Result);
- Result:=L;
- end;
- except
- If (L<>Result) then
- FReeAndNil(L);
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseTypeDefinition(AParent: TSQLElement;
- Flags: TParseTypeFlags): TSQLTypeDefinition;
- Var
- TN : String;
- adCount : Integer;
- ADS : TArrayDims;
- AD : Integer;
- DT : TSQLDataType;
- GN : Boolean; // Do GetNextToken ?
- sc,prec : Integer;
- bt : integer;
- D : TSQLTypeDefinition;
- cs : TSQLStringType;
- Coll : TSQLCollation;
- C : TSQLFieldConstraint;
- begin
- // We are positioned on the token prior to the type definition.
- GN:=True;
- prec:=0;
- sc:=0;
- bt:=0;
- Coll:=Nil;
- Case GetNextToken of
- tsqlIdentifier :
- If not (ptfAllowDomainName in Flags) then
- Error(SErrDomainNotAllowed)
- else
- begin
- DT:=sdtDomain;
- TN:=CurrentTokenString;
- end;
- tsqlInt,
- tsqlInteger :
- dt:=sdtInteger;
- tsqlSmallInt :
- dt:=sdtSmallInt;
- tsqlDate:
- dt:=sdtDate;
- tsqlTimeStamp:
- dt:=sdtDateTime;
- tsqlDouble:
- begin
- GetNextToken;
- Expect(tsqlPrecision); //DOUBLE PRECISION
- dt:=sdtDoublePrecision;
- end;
- tsqlFloat:
- dt:=sdtFloat;
- tsqlTime:
- dt:=sdtTime;
- tsqlDecimal,
- tsqlNumeric:
- begin
- if CurrentToken=tsqlDecimal then
- dt:=sdtDecimal
- else
- dt:=sdtNumeric;
- GetNextToken;
- GN:=False;
- If (CurrentToken=tsqlBraceOpen) then
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- prec:=StrToInt(CurrentTokenString);
- if (GetNextToken=tsqlBraceClose) then
- sc:=0
- else
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- sc:=StrToInt(CurrentTokenString);
- GetNextToken;
- Expect(tsqlBraceClose);
- end;
- GetNextToken; // position on first token after closing brace. GN=False !
- end;
- end;
- tsqlCstring,
- tsqlChar,
- tsqlNChar,
- tsqlVarChar,
- tsqlCharacter,
- tsqlNational :
- begin
- If (CurrentToken=tsqlCstring) and Not (([ptfExternalFunction,ptfExternalFunctionResult]*Flags) <> []) then
- UnexpectedToken;
- GN:=False;
- ParseCharTypeDefinition(DT,Prec,cs);
- end;
- tsqlBlob :
- begin
- dt:=sdtBlob;
- GN:=False;
- ParseBlobDefinition(prec,bt,cs);
- end;
- else
- UnexpectedToken;
- end;
- If GN then
- GetNextToken;
- // We are now on array definition or rest of type.
- ADCount:=0;
- ADS:=Default(TArrayDims);
- If (CurrentToken=tsqlSquareBraceOpen) then
- begin
- Repeat
- GetNextToken;
- Expect(tsqlIntegerNumber);
- AD:=StrToInt(CurrentTokenString);
- Inc(ADCount);
- SetLength(ADS,ADCount);
- ADS[ADCount-1][1]:=1;
- ADS[ADCount-1][2]:=AD;
- GetNextToken;
- if CurrentToken=tsqlCOLON then
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- AD:=Strtoint(CurrentTokenString);
- ADS[ADCount-1][1]:=AD;
- GetNextToken;
- end;
- if Not (CurrentToken in [tsqlSquareBraceClose,tsqlComma]) then
- Error(SErrCommaOrSquareArray);
- until (CurrentToken=tsqlSquareBraceClose);
- Expect(tsqlSquareBraceClose);
- GetNextToken;
- end
- else
- AD:=0;
- // Collation is here in domain (needs checking ?)
- If (CurrentToken=tsqlCollate) then
- begin
- If not (dt in [sdtChar,sdtVarchar,sdtNchar,sdtNVarChar,sdtBlob]) then
- Error(SErrInvalidUseOfCollate);
- GetNextToken;
- Expect(tsqlIdentifier);
- Coll:=TSQLCollation(CreateElement(TSQLCollation,AParent));
- Coll.Name:=CurrentTokenString;
- GetNextToken;
- end
- else
- Coll:=Nil;
- C:=Nil;
- D:=TSQLTypeDefinition(CreateElement(TSQLTypeDefinition,AParent));
- try
- D.DataType:=DT;
- D.TypeName:=TN;
- D.Len:=PRec;
- D.Scale:=Sc;
- D.BlobType:=bt;
- D.ArrayDims:=ADS;
- D.Charset:=CS;
- D.Collation:=Coll;
- D.Constraint:=C;
- if (not (ptfAlterDomain in Flags)) then // Alternative is to raise an error in each of the following
- begin
- If (CurrentToken=tsqlDefault) then
- begin
- GetNextToken;
- D.DefaultValue:=CreateLiteral(D);
- GetNextToken;
- end;
- if (CurrentToken=tsqlNot) then
- begin
- GetNextToken;
- Expect(tsqlNULL);
- D.NotNull:=True;
- GetNextToken;
- end;
- If (CurrentToken=tsqlCheck) and not (ptfTableFieldDef in Flags) then
- begin
- D.Check:=ParseCheckConstraint(D,False);
- // Parsecheckconstraint is on next token.
- end;
- // Firebird 2.5 generates/accepts NOT NULL after CHECK constraint instead
- // of before it in at least domain definitions:
- if (CurrentToken=tsqlNot) then
- begin
- GetNextToken;
- Expect(tsqlNULL);
- D.NotNull:=True;
- GetNextToken;
- end;
- // Constraint is before collation.
- if CurrentToken in [tsqlConstraint,tsqlCheck,tsqlUnique,tsqlprimary,tsqlReferences] then
- begin
- If Not (ptfAllowConstraint in Flags) then
- UnexpectedToken;
- D.Constraint:=ParseFieldConstraint(AParent);
- end;
- // table definition can have PRIMARY KEY CHECK
- If (CurrentToken=tsqlCheck) and (ptfTableFieldDef in Flags) then
- begin
- D.Check:=ParseCheckConstraint(D,False);
- // Parsecheckconstraint is on next token.
- end;
- // Collation is after constraint in table
- If (CurrentToken=tsqlCollate) then
- begin
- If not (dt in [sdtChar,sdtVarchar,sdtNchar,sdtNVarChar,sdtBlob]) then
- Error(SErrInvalidUseOfCollate);
- GetNextToken;
- Expect(tsqlIdentifier);
- Coll:=TSQLCollation(CreateElement(TSQLCollation,AParent));
- Coll.Name:=CurrentTokenString;
- GetNextToken;
- end
- else
- Coll:=Nil;
- If (CurrentToken=tsqlBy) and (ptfExternalFunctionResult in Flags) then
- begin
- GetNextToken;
- Consume(tsqlValue);
- D.ByValue:=True;
- end;
- end;
- Result:=D;
- except
- FreeAndNil(D);
- Raise;
- end;
- end;
- function TSQLParser.CreateLiteral(AParent : TSQLElement) : TSQLLiteral;
- var
- SQLFS: TFormatSettings;
- begin
- Result:=Nil;
- Case CurrentToken of
- tsqlIntegerNumber:
- begin
- Result:=TSQLLiteral(CreateElement(TSQLIntegerLiteral,AParent));
- TSQLIntegerLiteral(Result).Value:=StrToInt(CurrentTokenString);
- end;
- tsqlString:
- begin
- Result:=TSQLLiteral(CreateElement(TSQLStringLiteral,AParent));
- TSQLStringLiteral(Result).Value:=CurrentTokenString;
- end;
- tsqlFloatNumber:
- begin
- Result:=TSQLLiteral(CreateElement(TSQLFloatLiteral,AParent));
- SQLFS:=DefaultFormatSettings;
- SQLFS.DecimalSeparator:='.';
- TSQLFloatLiteral(Result).Value:=StrToFloat(CurrentTokenString,SQLFS);
- end;
- tsqlNull :
- Result:=TSQLLiteral(CreateElement(TSQLNullLiteral,AParent));
- tsqlValue :
- Result:=TSQLLiteral(CreateElement(TSQLValueLiteral,AParent));
- tsqlUSER :
- Result:=TSQLLiteral(CreateElement(TSQLUserLiteral,AParent));
- else
- Error(SErrInvalidLiteral,[CurrentTokenString]);
- end;
- end;
- procedure TSQLParser.CheckEOF;
- begin
- If CurrentToken=tsqlEOF then
- Error('Unexpected end of command');
- end;
- function TSQLParser.ParseExprLevel1(AParent: TSQLElement; EO: TExpressionOptions
- ): TSQLExpression;
- var
- tt: TSQLToken;
- B : TSQLBinaryExpression;
- L : TSQLLiteralExpression;
- begin
- Result:=ParseExprLevel2(AParent,EO);
- Try
- while (CurrentToken in [tsqlAnd,tsqlOr{,tsqlIs}]) do
- begin
- tt:=CurrentToken;
- GetNextToken;
- CheckEOF;
- B:=TSQLBinaryExpression(CreateElement(TSQLBinaryExpression,AParent));
- B.Left:=TSQLExpression(Result);
- Result:=B;
- If tt=tsqlIs then
- begin
- If CurrentToken=tsqlNot then
- begin
- // B.Operation:=boIsNot;
- GetNextToken;
- end
- else
- B.Operation:=boIs;
- Expect(tsqlNull);
- L:=TSQLLiteralExpression(CreateElement(TSQLLiteralExpression,AParent));
- L.Literal:=CreateLiteral(AParent);
- B.Right:=L;
- GetNexttoken;
- end
- else
- begin
- case tt of
- tsqlOr : B.Operation:=boOr;
- tsqlAnd : B.Operation:=boAnd;
- Else
- Error(SErrUnknownBooleanOp)
- end;
- B.Right:=ParseExprLevel2(AParent,EO);
- end;
- end;
- Except
- Result.Free;
- Raise;
- end;
- end;
- function TSQLParser.ParseInoperand(AParent: TSQLElement): TSQLExpression;
- Var
- S : TSQLSelectExpression;
- L : TSQLListExpression;
- Done : Boolean;
- begin
- // On entry, we're on the first token after IN token, which is the ( token.
- Consume(tsqlBraceopen);
- try
- If (CurrentToken=tsqlSelect) then
- begin
- S:=TSQLSelectExpression(CreateElement(TSQLSelectExpression,APArent));
- Result:=S;
- S.Select:=ParseSelectStatement(AParent,[sfSingleton]);
- Consume(tsqlBraceClose);
- end
- else
- begin
- L:=TSQLListExpression(CreateElement(TSQLListExpression,AParent));
- Result:=L;
- Repeat
- L.List.Add(ParseExprLevel1(L,[eoListValue]));
- Expect([tsqlBraceClose,tsqlComma]);
- Done:=(CurrentToken=tsqlBraceClose);
- GetNextToken;
- until Done;
- end;
- except
- FreeAndNil(Result);
- end;
- end;
- function TSQLParser.ParseExprLevel2(AParent: TSQLElement; EO: TExpressionOptions
- ): TSQLExpression;
- var
- tt: TSQLToken;
- Right : TSQLExpression;
- B : TSQLBinaryExpression;
- T : TSQLTernaryExpression;
- O : TSQLBinaryOperation;
- U : TSQLUnaryExpression;
- Inverted,bw,doin : Boolean;
- begin
- {$ifdef debugexpr} Writeln('Level 2 ',TokenInfos[CurrentToken],': ',CurrentTokenString);{$endif debugexpr}
- Result:=ParseExprLevel3(AParent,EO);
- try
- if (CurrentToken in sqlComparisons) then
- begin
- tt:=CurrentToken;
- Inverted:=CurrentToken=tsqlnot;
- CheckEOF;
- GetNextToken;
- CheckEOF;
- if Inverted then
- begin
- tt:=CurrentToken;
- if Not (tt in sqlInvertableComparisons) then
- Error(SErrUnexpectedToken,[CurrentTokenString]);
- GetNextToken;
- end
- else
- begin
- if (CurrentToken=tsqlNot) then
- begin
- GetNextToken;
- if not (tt=tsqlIS) then
- UnexpectedToken;
- Inverted:=true;
- end;
- end;
- // Step past expected STARTING WITH
- If (tt=tsqlStarting) and (CurrentToken=tsqlWith) then
- GetNextToken;
- bw:=False;
- doin:=false;
- B:=nil; //needed for test later
- Case tt of
- tsqlLT : O:=boLT;
- tsqlLE : O:=boLE;
- tsqlGT : O:=boGT;
- tsqlGE : O:=boGE;
- tsqlEq : O:=boEq;
- tsqlNE : O:=boNE;
- tsqlLike : O:=boLike;
- tsqlIn : doIn:=true;
- tsqlis : O:=boIs;
- tsqlContaining : O:=boContaining;
- tsqlStarting : O:=boStarting;
- tsqlBetween : bw:=true;
- Else
- Error(SErrUnknownComparison)
- end;
- If doIn then
- begin
- Right:=ParseInOperand(AParent);
- B:=TSQLBinaryExpression(CreateElement(TSQLBinaryExpression,AParent));
- B.Operation:=boIn;
- B.Left:=Result;
- Result:=B;
- B.Right:=Right;
- end
- else
- begin
- Right:=ParseExprLevel3(AParent,EO);
- If (O=boLike) and (CurrentToken=tsqlEscape) then
- begin
- GetNextToken;
- T:=TSQLTernaryExpression(CreateElement(TSQLTernaryExpression,AParent));
- T.Left:=Result;
- Result:=T;
- T.Middle:=Right;
- T.Right:=ParseExprLevel3(AParent,EO);
- T.Operation:=toLikeEscape
- end
- else If bw then
- begin
- Consume(tsqlAnd);
- T:=TSQLTernaryExpression(CreateElement(TSQLTernaryExpression,AParent));
- T.Left:=Result;
- Result:=T;
- T.Middle:=Right;
- T.Right:=ParseExprLevel3(AParent,EO);
- T.Operation:=toBetween;
- end
- else
- begin
- B:=TSQLBinaryExpression(CreateElement(TSQLBinaryExpression,AParent));
- B.Operation:=O;
- B.Left:=Result;
- Result:=B;
- B.Right:=Right;
- end;
- end;
- If Inverted then
- if (Assigned(B)) and (B.Operation=boIs) then
- B.Operation:=boIsNot
- else
- begin
- U:=TSQLUnaryExpression(CreateElement(TSQLUnaryExpression,AParent));
- U.Operand:=Result;
- U.Operation:=uoNot;
- Result:=U;
- end;
- end;
- Except
- Result.Free;
- Raise;
- end;
- end;
- function TSQLParser.ParseExprLevel3(AParent: TSQLElement; EO: TExpressionOptions
- ): TSQLExpression;
- Function NegativeNumber : Boolean; inline;
- begin
- Result:=(CurrentToken in [tsqlIntegerNumber,tsqlFloatNumber]) and (StrToInt(CurrentTokenString)<0)
- end;
- var
- tt : TSQLToken;
- right : TSQLExpression;
- B : TSQLBinaryExpression;
- begin
- {$ifdef debugexpr} Writeln('Level 3 ',TokenInfos[CurrentToken],': ',CurrentTokenString);{$endif debugexpr}
- Result:=ParseExprLevel4(AParent,EO);
- try
- {$ifdef debugexpr} Writeln('Level 3 continues ',TokenInfos[CurrentToken],': ',CurrentTokenString);{$endif debugexpr}
- // Scanner returns -N as an negative number, not as - (positive number)
- // NegativeNumber is for the case A-1 or so: convert to A + -1
- while (CurrentToken in [tsqlConcatenate,tsqlPlus,tsqlMinus]) or NegativeNumber do
- begin
- tt:=CurrentToken;
- If NegativeNumber then
- tt:=tsqlPlus // Pretend we've eaten +
- else
- begin
- GetNextToken;
- CheckEOF;
- end;
- Right:=ParseExprLevel4(AParent,EO);
- B:=TSQLBinaryExpression(CreateElement(TSQLBinaryExpression,AParent));
- B.Left:=Result;
- Result:=B;
- B.Right:=Right;
- Case tt of
- tsqlPlus : B.Operation:=boAdd;
- tsqlMinus : B.Operation:=boSubtract;
- tsqlConcatenate : B.Operation:=boConcat;
- else
- expect([tsqlPlus,tsqlMinus,tsqlConcatenate]);
- end;
- end;
- Except
- Result.Free;
- Raise;
- end;
- end;
- function TSQLParser.ParseExprLevel4(AParent: TSQLElement; EO: TExpressionOptions
- ): TSQLExpression;
- var
- tt : TSQLToken;
- right : TSQLExpression;
- B : TSQLBinaryExpression;
- begin
- {$ifdef debugexpr} Writeln('Level 4 ',TokenInfos[CurrentToken],': ',CurrentTokenString);{$endif debugexpr}
- Result:=ParseExprLevel5(AParent,EO);
- try
- while (CurrentToken in [tsqlMul,tsqlDiv]) do
- begin
- tt:=CurrentToken;
- GetNextToken;
- CheckEOF;
- Right:=ParseExprLevel5(AParent,EO);
- B:=TSQLBinaryExpression(CreateElement(TSQLBinaryExpression,AParent));
- B.Left:=Result;
- Result:=B;
- B.Right:=Right;
- Case tt of
- tsqlMul : B.Operation:=boMultiply;
- tsqlDiv : B.Operation:=boDivide;
- else
- // Do nothing
- end;
- end;
- Except
- Result.Free;
- Raise;
- end;
- end;
- function TSQLParser.ParseExprLevel5(AParent: TSQLElement; EO: TExpressionOptions
- ): TSQLExpression;
- Var
- tt : tsqltoken;
- U : TSQLUnaryExpression;
- begin
- {$ifdef debugexpr} Writeln('Level 5 ',TokenInfos[CurrentToken],': ',CurrentTokenString);{$endif debugexpr}
- tt:=tsqlunknown;
- if (CurrentToken in [tsqlNot,tsqlPlus,tsqlMinus]) then
- begin
- tt:=CurrentToken;
- GetNextToken;
- CheckEOF;
- end;
- Result:=ParseExprLevel6(AParent,EO);
- try
- If tt<>tsqlUnknown then
- begin
- U:=TSQLunaryExpression(CreateElement(TSQLunaryExpression,AParent));
- if tt=tsqlNot then
- U.Operation:=uoNot
- else
- U.Operation:=uoMinus;
- U.Operand:=Result;
- Result:=U;
- end;
- except
- FreeandNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseExprLevel6(AParent: TSQLElement; EO: TExpressionOptions
- ): TSQLExpression;
- begin
- {$ifdef debugexpr} Writeln('Level 6 ',TokenInfos[CurrentToken],': ',CurrentTokenString);{$endif debugexpr}
- if (CurrentToken=tsqlBraceOpen) then
- begin
- GetNextToken;
- If (CurrentToken<>tsqlselect) then
- Result:=ParseExprLevel1(AParent,EO)
- else
- begin
- Result:=TSQLExpression(CreateElement(TSQLSelectExpression,AParent));
- try
- TSQLSelectExpression(Result).Select:=ParseSelectStatement(Result,[sfSingleTon]);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- try
- if (CurrentToken<>tsqlBraceClose) then
- Error(SerrUnmatchedBrace);
- GetNextToken;
- Except
- Result.Free;
- Raise;
- end;
- end
- else
- Result:=ParseExprPrimitive(AParent,EO);
- end;
- function TSQLParser.ParseIdentifierList(AParent: TSQLElement;
- AList: TSQLelementList): integer;
- begin
- // on entry, we're on first identifier
- AList.Source:=CurSource;
- AList.SourceLine:=CurrentTokenLine;
- AList.SourcePos:=CurrentTokenPos;
- Expect(tsqlIdentifier);
- Result:=0;
- repeat
- if CurrentToken=tsqlComma then
- GetNextToken;
- Expect(tsqlIdentifier);
- AList.add(CreateIdentifier(AParent,CurrentTokenString));
- Inc(Result);
- until (GetNextToken<>tsqlComma);
- Expect(tsqlBraceClose);
- GetNextToken;
- end;
- function TSQLParser.ParseValueList(AParent: TSQLElement; EO: TExpressionOptions
- ): TSQLElementList;
- Var
- E : TSQLExpression;
- begin
- Result:=Nil;
- E:=Nil;
- // First token is (
- Expect(tsqlBraceOpen);
- Repeat
- GetNextToken;
- If (CurrentToken<>tsqlBraceClose) then
- E:=ParseExprLevel1(AParent,EO);
- If (E<>Nil) then
- begin
- If Result=Nil then
- Result:=TSQLElementList.Create(True);
- Result.Add(E);
- end;
- Expect([tsqlComma,tsqlBraceClose]);
- Until CurrentToken=tsqlBraceClose;
- end;
- procedure TSQLParser.UnexpectedToken;
- begin
- Error(SErrUnexpectedToken,[CurrentTokenString]);
- end;
- procedure TSQLParser.UnexpectedToken(AExpected: TSQLTokens);
- Var
- S : String;
- I : TSQLToken;
- begin
- S:='';
- For I:=Low(TSQLToken) to High(TSQLToken) do
- if I in AExpected then
- begin
- If (S<>'') then
- S:=S+',';
- S:=S+TokenInfos[i];
- end;
- Error(SErrUnexpectedTokenOf,[CurrentTokenString,S]);
- end;
- function TSQLParser.CreateIdentifier(AParent: TSQLElement;
- const AName: TSQLStringType): TSQLIdentifierName;
- begin
- Result:=TSQLIdentifierName(CreateElement(TSQLIdentifierName,AParent));
- Result.Name:=AName;
- end;
- function TSQLParser.ParseExprAggregate(AParent: TSQLElement;
- EO: TExpressionOptions): TSQLAggregateFunctionExpression;
- begin
- Result:=TSQLAggregateFunctionExpression(CreateElement(TSQLAggregateFunctionExpression,AParent));
- try
- Case CurrentToken of
- tsqlCount : Result.Aggregate:=afCount;
- tsqlSum : Result.Aggregate:=afSum;
- tsqlAvg : Result.Aggregate:=afAvg;
- tsqlMax : Result.Aggregate:=afMax;
- tsqlMin : Result.Aggregate:=afMin;
- else
- Expect([tsqlMin,tsqlMax,tsqlAvg,tsqlSum,tsqlCount]);
- end;
- GetNextToken;
- Consume(tsqlBraceOpen);
- If CurrentToken=tsqlMul then
- begin
- If Result.Aggregate<>afCount then
- Error(SErrAsteriskOnlyInCount);
- Result.OPtion:=aoAsterisk;
- GetNextToken;
- end
- else
- begin
- if (CurrentToken in [tsqlAll,tsqlDistinct]) then
- begin
- If CurrentToken=tsqlAll then
- Result.Option:=aoAll
- else
- Result.Option:=aoDistinct;
- GetNextToken;
- end;
- Result.Expression:=ParseExprLevel1(Result,EO);
- end;
- Consume(tsqlBraceClose);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseExprPrimitive(AParent: TSQLElement;
- EO: TExpressionOptions): TSQLExpression;
- Var
- L : TSQLElementList;
- N : String;
- C : TSQLElementClass;
- E : TSQLExtractElement;
- IdentifierPath : TSQLIdentifierPath;
- begin
- Result:=Nil;
- try
- {$ifdef debugexpr} Writeln('Primitive ',TokenInfos[CurrentToken],': ',CurrentTokenString);{$endif debugexpr}
- Case CurrentToken of
- tsqlIntegerNumber,
- tsqlString,
- tsqlFloatNumber,
- tsqlNull, // True and False belong here
- tsqlValue,
- tsqlUser:
- begin
- Result:=TSQLLiteralExpression(CreateElement(TSQLLiteralExpression,AParent));
- TSQLLiteralExpression(Result).Literal:=CreateLiteral(AParent);
- GetNextToken;
- end;
- tsqlCast:
- begin
- GetNextToken;
- Consume(tsqlBraceOpen);
- Result:=TSQLCastExpression(CreateElement(TSQLCastExpression,AParent));
- TSQLCastExpression(Result).Value:=ParseExprLevel1(Result,EO);
- Expect(tsqlAs);
- TSQLCastExpression(Result).NewType:=ParseTypeDefinition(Result,[ptfCast]);
- Consume(tsqlBraceClose);
- end;
- tsqlCase: Result:=ParseCaseExpression(AParent);
- tsqlExtract:
- begin
- GetNextToken;
- Consume(tsqlBraceOpen);
- Expect(tsqlIdentifier);
- if not StringToSQLExtractElement(CurrentTokenString,E) then
- Error(SErrInvalidExtract,[CurrentTokenString]);
- Consume(tsqlIdentifier);
- Consume(tsqlFrom);
- Result:=TSQLExtractExpression(CreateElement(TSQLExtractExpression,AParent));
- TSQLExtractExpression(Result).Element:=E;
- TSQLExtractExpression(Result).Value:=ParseExprLevel1(Result,EO);
- Consume(tsqlBraceClose);
- end;
- tsqlExists,
- tsqlAll,
- tsqlAny,
- tsqlSome,
- tsqlSingular:
- begin
- Case CurrentToken of
- tsqlExists : C:=TSQLexistsExpression;
- tsqlAll : C:=TSQLAllExpression;
- tsqlAny : C:=TSQLAnyExpression;
- tsqlSome : C:=TSQLSomeExpression;
- tsqlSingular : C:=TSQLSingularExpression;
- else
- expect([tsqlExists, tsqlAll,tsqlAny,tsqlSome,tsqlSingular]);
- end;
- GetNextToken;
- Consume(tsqlBraceOpen);
- Result:=TSQLSelectionExpression(CreateElement(C,AParent));
- TSQLSelectionExpression(Result).Select:=ParseSelectStatement(Result,[]);
- Consume(tsqlBraceClose);
- end;
- tsqlCount,
- tsqlSum,
- tsqlAvg,
- tsqlMax,
- tsqlMin :
- begin
- If not ([eoSelectValue,eoHaving]*EO <> []) then
- Error(SErrNoAggregateAllowed);
- Result:=ParseExprAggregate(APArent,EO);
- end;
- tsqlUpper :
- begin
- GetNextToken;
- L:=ParseValueList(AParent,EO);
- If L.Count<>1 then
- begin
- FreeAndNil(L);
- Error(SErrUpperOneArgument);
- end;
- GetNextToken; // Consume );
- Result:=TSQLFunctionCallExpression(CreateElement(TSQLFunctionCallExpression,AParent));
- TSQLFunctionCallExpression(Result).IDentifier:='UPPER';
- TSQLFunctionCallExpression(Result).Arguments:=L;
- end;
- tsqlGenID :
- begin
- GetNextToken;
- Consume(tsqlBraceOpen);
- expect(tsqlIdentifier);
- N:=CurrentTokenString;
- GetNextToken;
- Consume(tsqlComma);
- Result:=TSQLGenIDExpression(CreateElement(TSQLGenIDExpression,AParent));
- TSQLGenIDExpression(Result).Generator:=CreateIdentifier(Result,N);
- TSQLGenIDExpression(Result).Value:=ParseExprLevel1(AParent,EO);
- Consume(tsqlBraceClose);
- end;
- tsqlColon:
- begin
- if (([eoCheckConstraint,eoTableConstraint,eoComputedBy] * EO)<>[]) then
- Error(SErrUnexpectedToken,[CurrentTokenString]);
- GetNextToken;
- expect(tsqlIdentifier);
- N:=CurrentTokenString;
- Result:=TSQLParameterExpression(CreateElement(TSQLParameterExpression,AParent));
- TSQLParameterExpression(Result).Identifier:=CreateIdentifier(Result,N);
- Consume(tsqlIdentifier);
- end;
- tsqlMUL:
- begin
- Result:=TSQLAsteriskExpression(CreateElement(TSQLAsteriskExpression,APArent));
- GetNextToken;
- end;
- else
- // some keywords (FirstKeyword..LastKeyWord) can also be functions/identifiers (LEFT, RIGHT)
- // To-Do: remove some of them if necessary
- if CurrentToken in [tsqlIdentifier, FirstKeyword..LastKeyWord] then
- begin
- C:=TSQLIdentifierExpression;
- N:=CurrentTokenString;
- If (eoCheckConstraint in EO) and not (eoTableConstraint in EO) then
- Error(SErrUnexpectedToken,[CurrentTokenString]);
- // Plain identifier
- IdentifierPath:=TSQLIdentifierPath.Create;
- IdentifierPath.Add(CreateIdentifier(nil,N));
- GetNextToken;
- while (CurrentToken=tsqlDot) do
- begin
- GetNextToken;
- if CurrentToken=tsqlMUL then
- begin
- C:=TSQLAsteriskExpression;
- GetNextToken;
- break;
- end
- else
- begin
- Expect(tsqlIdentifier);
- N:=CurrentTokenString;
- IdentifierPath.Add(CreateIdentifier(nil,N));
- GetNextToken;
- end;
- end;
- If (CurrentToken=tsqlBraceOpen) and (C=TSQLIdentifierExpression) then
- begin
- L:=ParseValueList(AParent,EO);
- GetNextToken; // Consume );
- // Function call
- Result:=TSQLFunctionCallExpression(CreateElement(TSQLFunctionCallExpression,AParent));
- TSQLFunctionCallExpression(Result).Arguments:=L;
- end
- Else
- // Array access ?
- If (CurrentToken=tsqlSquareBraceOpen) and (C=TSQLIdentifierExpression) then
- // Either something like array[5] or,
- // in procedures etc array[i:] where i is a variable
- begin
- Result:=TSQLIdentifierExpression(CreateElement(TSQLIdentifierExpression,APArent));
- case GetNextToken of
- tsqlIntegerNumber: TSQLIdentifierExpression(Result).ElementIndex:=StrToInt(CurrentTokenString);
- tsqlColon:
- begin
- GetNextToken;
- Expect(tsqlIdentifier);
- // We can't set element index here, but it IS an array...
- //todo: verify if there are repercussions/what these would be
- TSQLIdentifierExpression(Result).ElementIndex:=maxint;
- end;
- else
- Error(SErrIntegerExpected);
- end;
- GetNextToken;
- Consume(tsqlSquareBraceClose);
- end;
- if not Assigned(Result) then
- Result:=TSQLExpression(CreateElement(C,AParent));
- TSQLIdentifierPathExpression(Result).IdentifierPath:=IdentifierPath;
- end
- else
- UnexpectedToken;
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseSQLValue(AParent : TSQLElement) : TSQLExpression;
- Var
- E : TSQLExpression;
- begin
- E:=ParseExprLevel1(AParent,[]);
- Result:=E;
- end;
- function TSQLParser.ParseCheckConstraint(AParent : TSQLElement; TableConstraint : Boolean = False) : TSQLExpression;
- Var
- EO : TExpressionOptions;
- begin
- // We are on the 'CHECK' token.
- GetNextToken;
- Consume(tsqlBraceOpen);
- EO:=[eoCheckConstraint];
- If TableConstraint then
- EO:=EO+[eoTableConstraint];
- Result:=ParseExprLevel1(AParent,EO);
- Consume(tsqlBraceClose);
- end;
- function TSQLParser.ParseCreateDomainStatement(AParent: TSQLElement; IsAlter: Boolean
- ): TSQLCreateOrAlterStatement;
- var
- D : TSQLCreateDomainStatement;
- A : TSQLAlterDomainStatement;
- N : TSQLStringType;
- NN : Boolean;
- begin
- Result:=Nil;
- GetNextToken;
- Expect(tsqlIdentifier);
- N:=CurrentTokenString;
- If not IsAlter then
- begin
- D:=TSQLCreateDomainStatement(CreateElement(TSQLCreateDomainStatement,AParent));
- try
- D.ObjectName:=CreateIdentifier(D,N);
- If (PeekNextToken=tsqlAs) then
- GetNextToken;
- D.TypeDefinition:=ParseTypeDefinition(D,[])
- except
- FreeAndNil(D);
- Raise;
- end;
- Result:=D;
- end
- else
- begin //alter statement
- A:=Nil;
- NN:=False;
- try
- Case GetNextToken of
- tsqlSet:
- begin
- GetNextToken;
- Expect(tsqlDefault);
- GetNextToken;
- A:=TSQLAlterDomainSetDefaultStatement(CreateElement(TSQLAlterDomainSetDefaultStatement,APArent));
- TSQLAlterDomainSetDefaultStatement(A).DefaultValue:=CreateLiteral(A);
- end;
- tsqlDrop:
- begin
- Case GetNextToken of
- tsqlDefault : A:=TSQLAlterDomainDropDefaultStatement(CreateElement(TSQLAlterDomainDropDefaultStatement,APArent));
- tsqlConstraint : A:=TSQLAlterDomainDropCheckStatement(CreateElement(TSQLAlterDomainDropCheckStatement,APArent));
- else
- Error(SErrUnexpectedToken,[CurrentTokenString]);
- end;
- end;
- tsqlAdd:
- begin
- if (GetNextToken=tsqlConstraint) then
- GetNextToken;
- Expect(tsqlCheck);
- A:=TSQLAlterDomainAddCheckStatement(CreateElement(TSQLAlterDomainAddCheckStatement,APArent));
- TSQLAlterDomainAddCheckStatement(A).Check:=ParseCheckConstraint(A);
- NN:=True;
- end;
- tsqlType:
- begin
- A:=TSQLAlterDomainTypeStatement(CreateElement(TSQLAlterDomainTypeStatement,AParent));
- TSQLAlterDomainTypeStatement(A).NewType:=ParseTypeDefinition(A,[ptfAlterDomain]);
- NN:=True;
- end;
- tsqlIdentifier:
- begin
- A:=TSQLAlterDomainRenameStatement(CreateElement(TSQLAlterDomainRenameStatement,APArent));
- TSQLAlterDomainRenameStatement(A).NewName:=CreateIdentifier(A,CurrentTokenString);
- end;
- else
- UnexpectedToken([tsqlSet,tsqlIdentifier,tsqlAdd,tsqlType,tsqlDrop]);
- end;
- A.ObjectName:=CreateIdentifier(A,N);
- Result:=A;
- If not NN then
- GetNextToken;
- except
- FreeAndNil(A);
- Raise;
- end;
- end;
- end;
- function TSQLParser.ParseCreateExceptionStatement(AParent: TSQLElement;
- IsAlter: Boolean): TSQLCreateOrAlterStatement;
- var
- E : TSQLCreateExceptionStatement;
- N : TSQLStringType;
- begin
- GetNextToken;
- Expect(tsqlIdentifier);
- N:=CurrentTokenString;
- try
- if IsAlter then
- E:=TSQLCreateExceptionStatement(CreateElement(TSQLAlterExceptionStatement,AParent))
- else
- E:=TSQLCreateExceptionStatement(CreateElement(TSQLCreateExceptionStatement,AParent));
- E.ObjectName:=CreateIdentifier(E,N);
- GetNextToken;
- Expect(tsqlString);
- E.ExceptionMessage:=TSQLStringLiteral(CreateElement(TSQLStringLiteral,E));
- E.ExceptionMessage.Value:=CurrentTokenString;
- GetNextToken;
- except
- FreeAndNil(E);
- Raise;
- end;
- Result:=E;
- end;
- function TSQLParser.ParseCreateTriggerStatement(AParent: TSQLElement; IsAlter: Boolean
- ): TSQLCreateOrAlterStatement;
- Var
- T : TSQLAlterCreateTriggerStatement;
- begin
- // On entry, we're on the 'TRIGGER' token.
- Consume(tsqlTrigger);
- If IsAlter then
- T:=TSQLAlterTriggerStatement(CreateElement(TSQLAlterTriggerStatement,APArent))
- else
- T:=TSQLCreateTriggerStatement(CreateElement(TSQLCreateTriggerStatement,APArent));
- Result:=T;
- try
- Expect(tsqlidentifier);
- Result.ObjectName:=CreateIdentifier(Result,CurrentTokenString);
- getnexttoken;
- If Not IsAlter then
- begin
- Consume(tsqlfor);
- Expect(tsqlidentifier);
- T.TableName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- end;
- if (CurrentToken in [tsqlActive,tsqlInactive]) then
- begin
- If CurrentToken=tsqlActive then
- T.State:=tsActive
- else
- T.State:=tsInactive;
- GetNextToken;
- end;
- Expect([tsqlBefore,tsqlAfter]);
- if CurrentToken=tsqlBefore then
- T.Moment:=tmBefore
- else
- T.Moment:=tmAfter;
- Repeat
- GetNextToken;
- Case CurrentToken of
- tsqlDelete : T.Operations:=T.Operations+[toDelete];
- tsqlUpdate : T.Operations:=T.Operations+[toUpdate];
- tsqlInsert : T.Operations:=T.Operations+[toInsert];
- else
- Expect([tsqlDelete,tsqlInsert,tsqlUpdate]);
- end;
- GetNextToken;
- Until (CurrentToken<>tsqlOr);
- If CurrentToken=tsqlPosition then
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- T.Position:=StrToInt(CurrentTokenString);
- GetNextToken;
- end;
- Consume(tsqlAs);
- if (CurrentToken=tsqlDeclare) then
- ParseCreateProcedureVariableList(Result,T.LocalVariables);
- expect(tsqlBegin);
- ParseStatementBlock(Result,T.Statements);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseSetGeneratorStatement(AParent: TSQLElement
- ): TSQLSetGeneratorStatement;
- begin
- // On entry, we're on the 'GENERATOR' token
- Consume(tsqlGenerator) ;
- try
- Result:=TSQLSetGeneratorStatement(CreateElement(TSQLSetGeneratorStatement,AParent));
- Expect(tsqlidentifier);
- Result.ObjectName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- Consume(tsqlto);
- Expect(tsqlIntegerNumber);
- Result.NewValue:=StrToInt(CurrentTokenString);
- GetNextToken;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseSetTermStatement(AParent: TSQLElement ): TSQLSetTermStatement;
- begin
- // On entry, we're on the 'TERM' token
- Consume(tsqlTerm) ;
- try
- Result:=TSQLSetTermStatement(CreateElement(TSQLSetTermStatement,AParent));
- case CurrentToken of
- // Only semicolon or something unknown are allowed.
- tsqlSemiColon : Result.NewValue:=TokenInfos[CurrentToken];
- tsqlunknown : Result.NewValue:=CurrentTokenString;
- tsqlSymbolString,
- tsqlIdentifier : Result.NewValue:=CurrentTokenString;
- else
- expect([tsqlSemiColon,tsqlTerminator,tsqlunknown, tsqlSymbolString]);
- end;
- GetNextToken;
- // Next token depends on whether an alternative token is in effect...
- if Scanner.AlternateTerminator<>'' then
- Expect(tsqlTerminator)
- else
- Expect(tsqlSEMICOLON);
- if Result.NewValue=TokenInfos[tsqlSEMICOLON] then
- FScanner.AlternateTerminator:=''
- else
- FScanner.AlternateTerminator:=Result.NewValue;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseSecondaryFile(AParent: TSQLElement) : TSQLDatabaseFileInfo;
- Var
- I : INteger;
- Last : TSQLToken;
- begin
- // On entry, we're on the FILE token
- Consume(tsqlFile);
- Result:=TSQLDatabaseFileInfo(CreateElement(TSQLDatabaseFileInfo,APArent));
- try
- Expect(tsqlString);
- Result.FileName:=CurrentTokenString;
- getNextToken;
- I:=0;
- last:=tsqlEOF;
- While (I<2) and (CurrentToken in [tsqlLength,tsqlStarting]) do
- begin
- Inc(I);
- If (CurrentToken=tsqlLength) then
- begin
- If Last=tsqlLength then
- UnexpectedToken;
- Last:=tsqlLength;
- GetNextToken;
- if (CurrentToken=tsqlEq) then
- GetNextToken;
- Expect(tsqlIntegerNumber);
- Result.Length:=StrToInt(CurrentTokenString);
- GetNextToken;
- If CurrentToken in [tsqlPage,tsqlPages] then
- GetNextToken;
- end
- else if (CurrentToken=tsqlStarting) then
- begin
- If Last=tsqlStarting then
- UnexpectedToken;
- Last:=tsqlStarting;
- GetNextToken;
- if (CurrentToken=tsqlAt) then
- begin
- GetNextToken;
- If CurrentToken=tsqlPage then
- GetNextToken;
- end;
- Expect(tsqlIntegerNumber);
- Result.StartPage:=StrToInt(CurrentTokenString);
- GetNextToken;
- end;
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseCreateDatabaseStatement(AParent: TSQLElement; IsAlter: Boolean) : TSQLCreateDatabaseStatement;
- begin
- // On entry, we're on the DATABASE or SCHEMA token
- Result:=TSQLCreateDatabaseStatement(CreateElement(TSQLCreateDatabaseStatement,AParent));
- try
- Result.UseSchema:=(CurrentToken=tsqlSchema);
- GetNextToken;
- Expect(tsqlString);
- Result.FileName:=CurrentTokenString;
- GetNextToken;
- If (CurrentToken=tsqlUSER) then
- begin
- GetNextToken;
- Expect(tsqlString);
- Result.UserName:=CurrentTokenString;
- GetNextToken;
- end;
- If (CurrentToken=tsqlPassword) then
- begin
- GetNextToken;
- Expect(tsqlString);
- Result.Password:=CurrentTokenString;
- GetNextToken;
- end;
- If (CurrentToken=tsqlPageSize) then
- begin
- GetNextToken;
- if CurrentToken=tsqlEq then
- GetNextToken;
- Expect(tsqlIntegerNumber);
- Result.Pagesize:=StrtoIntDef(CurrentTokenString,0);
- GetNextToken;
- end;
- If (CurrentToken=tsqlLength) then
- begin
- GetNextToken;
- if (CurrentToken=tsqlEq) then
- GetNextToken;
- Expect(tsqlIntegerNumber);
- Result.Length:=StrtoIntDef(CurrentTokenString,0);
- GetNextToken;
- If CurrentToken in [tsqlPage,tsqlPages] then
- GetNextToken;
- end;
- If (CurrentToken=tsqlDefault) then
- begin
- GetNextToken;
- Consume(tsqlCharacter);
- Consume(tsqlSet);
- Expect(tsqlidentifier);
- Result.CharSet:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- end;
- While (CurrentToken=tsqlFile) do
- Result.SecondaryFiles.Add(ParseSecondaryFile(Result));
- except
- FreeAndNil(Result);
- Raise
- end;
- end;
- function TSQLParser.ParseCreateShadowStatement(AParent: TSQLElement;
- IsAlter: Boolean): TSQLCreateShadowStatement;
- begin
- // On entry, we're on the SHADOW token.
- if IsAlter then
- UnexpectedToken;
- Consume(tsqlShadow);
- Result:=TSQLCreateShadowStatement(CreateElement(TSQLCreateShadowStatement,AParent));
- try
- Expect(tsqlIntegerNumber);
- Result.Number:=StrToInt(CurrentTokenString);
- GetNextToken;
- If (CurrentToken=tsqlManual) then
- begin
- Result.Manual:=True;
- GetNextToken;
- end
- else If (CurrentToken=tsqlAuto) then
- GetNextToken;
- if (CurrentToken=tsqlConditional) then
- begin
- Result.Conditional:=True;
- GetNextToken;
- end;
- expect(tsqlString);
- Result.FileName:=CurrentTokenString;
- GetNextToken;
- If (CurrentToken=tsqlLength) then
- begin
- GetNextToken;
- if (CurrentToken=tsqlEq) then
- GetNextToken;
- Expect(tsqlIntegerNumber);
- Result.Length:=StrtoIntDef(CurrentTokenString,0);
- GetNextToken;
- If CurrentToken in [tsqlPage,tsqlPages] then
- GetNextToken;
- end;
- While (CurrentToken=tsqlFile) do
- Result.SecondaryFiles.Add(ParseSecondaryFile(Result));
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseAlterDatabaseStatement(AParent: TSQLElement;
- IsAlter: Boolean): TSQLAlterDatabaseStatement;
- begin
- // On entry, we're on the DATABASE or SCHEMA token.
- Result:=TSQLAlterDatabaseStatement(CreateElement(TSQLAlterDatabaseStatement,APArent));
- try
- Result.UseSchema:=CurrentToken=tsqlSchema;
- GetNextToken;
- expect(tsqlAdd);
- While (CurrentToken in [tsqlAdd,tsqlFile]) do
- begin
- if CurrentToken=tsqlAdd then
- GetNextToken;
- Expect(tsqlFile);
- Result.Operations.Add(ParseSecondaryFile(Result));
- end;
- if Result.Operations.Count=0 then
- UnexpectedToken([tsqlAdd]);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseCreateStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
- var
- Tok : TSQLToken;
- isOrAlter : Boolean;
- isRecreate : Boolean;
- begin
- isRecreate:=CurrentToken=tsqlRecreate;
- tok:=GetNextToken;
- isOrAlter:=tok=tsqlOR;
- if isOrAlter then
- begin
- GetNextToken;
- Consume(tsqlAlter);
- if Not (CurrentToken in [tsqlProcedure,tsqlTrigger]) then
- Expect([tsqlProcedure,tsqlTrigger]);
- end;
- if isRecreate then
- Expect([tsqlProcedure,tsqlTable,tsqlView]);
- Case CurrentToken of
- tsqlTable : if IsAlter then
- Result:=ParseAlterTableStatement(AParent)
- else
- Result:=ParseCreateTableStatement(AParent);
- tsqlUnique,
- tsqlDesc,
- tsqlAsc,
- tsqlAscending,
- tsqlDescending,
- tsqlIndex : Result:=ParseCreateIndexStatement(AParent,IsAlter);
- tsqlView : Result:=ParseCreateViewStatement(AParent,IsAlter);
- tsqlProcedure : Result:=ParseCreateProcedureStatement(AParent,IsAlter);
- tsqlDomain : Result:=ParseCreateDomainStatement(AParent,IsAlter);
- tsqlSequence,
- tsqlGenerator : Result:=ParseCreateGeneratorStatement(AParent,IsAlter);
- tsqlException : Result:=ParseCreateExceptionStatement(AParent,IsAlter);
- tsqlTrigger : Result:=ParseCreateTriggerStatement(AParent,IsAlter);
- tsqlRole : Result:=ParseCreateRoleStatement(AParent,IsAlter);
- tsqlSchema,
- tsqlDatabase : If IsAlter then
- Result:=ParseAlterDatabaseStatement(AParent,IsAlter)
- else
- Result:=ParseCreateDatabaseStatement(AParent,IsAlter);
- tsqlShadow : Result:=ParseCreateShadowStatement(AParent,IsAlter);
- else
- Error(SErrExpectedDBObject,[CurrentTokenString]);
- end;
- Result.IsCreateOrAlter:=isOrAlter;
- Result.isRecreate:=IsRecreate;
- end;
- function TSQLParser.ParseDropStatement(AParent: TSQLElement
- ): TSQLDropStatement;
- Var
- C : TSQLElementClass;
- begin
- // We're positioned on the DROP token.
- C:=Nil;
- Case GetNextToken of
- {
- Filter,
- }
- tsqlExternal : begin
- GetNextToken;
- Expect(tsqlFunction);
- C:=TSQLDropExternalFunctionStatement;
- end;
- tsqlShadow : C:=TSQLDropShadowStatement;
- tsqlRole : C:=TSQLDropRoleStatement;
- tsqlDatabase : C:=TSQLDropDatabaseStatement;
- tsqlException : C:=TSQLDropExceptionStatement;
- tsqlTable : C:=TSQLDropTableStatement;
- tsqlIndex : C:=TSQLDropIndexStatement;
- tsqlView : C:=TSQLDropViewStatement;
- tsqlProcedure : C:=TSQLDropProcedureStatement;
- tsqlDomain : C:=TSQLDropDomainStatement;
- tsqlGenerator : C:=TSQLDropGeneratorStatement;
- tsqlTrigger : C:=TSQLDropTriggerStatement;
- else
- Error(SErrExpectedDBObject,[CurrentTokenString]);
- end;
- GetNextToken;
- If C=TSQLDropShadowStatement then
- Expect(tsqlIntegerNumber)
- else
- Expect(tsqlIdentifier);
- Result:=TSQLDropStatement(CreateElement(C,AParent));
- Result.ObjectName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken; // Comma
- end;
- function TSQLParser.ParseRollbackStatement(AParent: TSQLElement
- ): TSQLRollbackStatement;
- begin
- // On entry, we're on the ROLLBACK statement
- Consume(tsqlRollBack);
- Result:=TSQLRollBackStatement(CreateElement(TSQLRollBackStatement,AParent));
- try
- If (CurrentToken=tsqlTransaction) then
- begin
- GetNextToken;
- expect(tsqlidentifier);
- Result.TransactionName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- end;
- Result.Work:=(CurrentToken=tsqlWork);
- if Result.Work then
- GetNextToken;
- Result.Release:=(CurrentToken=tsqlRelease);
- if Result.Release then
- GetNextToken;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseCommitStatement(AParent: TSQLElement
- ): TSQLCommitStatement;
- begin
- Consume(tsqlCommit);
- Result:=TSQLCommitStatement(CreateElement(TSQLCommitStatement,AParent));
- try
- Result.Work:=(CurrentToken=tsqlWork);
- if Result.Work then
- GetNextToken;
- If (CurrentToken=tsqlTransaction) then
- begin
- GetNextToken;
- expect(tsqlidentifier);
- Result.TransactionName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- end;
- Result.Release:=(CurrentToken=tsqlRelease);
- if Result.Release then
- GetNextToken;
- Result.Retain:=(CurrentToken=tsqlRetain);
- if Result.Retain then
- begin
- GetNextToken;
- If CurrentToken=tsqlSnapshot then
- GetNextToken;
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseExecuteProcedureStatement(AParent: TSQLElement): TSQLExecuteProcedureStatement;
- Var
- NeedClose,
- Done : Boolean;
- TN : TSQLStringType;
- begin
- Result:=Nil;
- // On Entry, we're on the EXECUTE statement
- Consume(tsqlExecute);
- Consume(tsqlProcedure);
- If (CurrentToken=tsqlTransaction) then
- begin
- GetNextToken;
- Expect(TSQLIdentifier);
- TN:=CurrentTokenString;
- GetNextToken;
- end;
- Expect(tsqlIdentifier);
- Result:=TSQLExecuteProcedureStatement(CreateELement(TSQLExecuteProcedureStatement,AParent));
- try
- Result.ProcedureName:=CreateIdentifier(Result,CurrentTokenString);
- if (TN<>'') then
- Result.TransactionName:=CreateIdentifier(Result,TN);
- GetNextToken;
- // ( is optional. It CAN be part of a (SELECT, and then it is NOT part of the brackets around the params.
- NeedClose:=(CurrentToken=tsqlBraceOpen) and (PeekNextToken<>tsqlSelect);
- If NeedClose then
- GetNextToken;
- Done:=False;
- If Not (CurrentToken in [tsqlSemicolon,tsqlEOF,tsqlReturningValues]) then
- Repeat
- Result.Params.Add(ParseExprLevel1(Result,[eoFieldValue]));
- If CurrentToken=tsqlComma then
- GetNextToken
- else if (CurrentToken=tsqlBraceClose) then
- begin
- if Not NeedClose then
- UnexpectedToken;
- Done:=True;
- GetNextToken;
- end
- else
- begin
- If NeedClose then
- UnexpectedToken([tsqlBraceClose]);
- Expect([tsqlEOF,tsqlSemicolon,tsqlReturningValues]);
- Done:=True;
- end;
- until Done;
- if (CurrentToken=tsqlReturningValues) then
- begin
- GetNextToken;
- NeedClose:=(CurrentToken=tsqlBraceOpen);
- If NeedClose then
- Consume(tsqlBraceOpen);
- Repeat
- if CurrentToken=tsqlComma then
- GetNextToken;
- if CurrentToken=tsqlColon then
- GetNextToken;
- Expect(tsqlIdentifier);
- Result.Returning.Add(CreateIdentifier(Result,CurrentTokenString));
- GetNextToken;
- until (CurrentToken<>tsqlComma);
- If NeedClose then
- Consume(tsqlBraceClose);
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseSetStatement(AParent: TSQLElement): TSQLStatement;
- begin
- // On Entry, we're on the SET statement
- Consume(tsqlSet);
- Case CurrentToken of
- tsqlGenerator : Result:=ParseSetGeneratorStatement(AParent); //SET GENERATOR
- tsqlTerm :
- if poAllowSetTerm in Foptions then
- Result:=ParseSetTermStatement(AParent) //SET term
- else
- UnexpectedToken;
- else
- // For the time being
- UnexpectedToken;
- end;
- end;
- function TSQLParser.ParseConnectStatement(AParent: TSQLElement
- ): TSQLConnectStatement;
- begin
- // On entry, we're on CONNECT
- consume(tsqlConnect);
- Expect(tsqlString);
- Result:=TSQLConnectStatement(CreateElement(TSQLConnectStatement,AParent));
- try
- Result.DatabaseName:=CurrentTokenString;
- GetNextToken;
- If CurrentToken=tsqlUSER then
- begin
- GetNextToken;
- Expect(tsqlString);
- Result.UserName:=CurrentTokenString;
- GetNextToken;
- end;
- If CurrentToken=tsqlPassword then
- begin
- GetNextToken;
- Expect(tsqlString);
- Result.Password:=CurrentTokenString;
- GetNextToken;
- end;
- If CurrentToken=tsqlRole then
- begin
- GetNextToken;
- Expect(tsqlString);
- Result.Role:=CurrentTokenString;
- GetNextToken;
- end;
- If CurrentToken=tsqlCache then
- begin
- GetNextToken;
- Expect(tsqlIntegerNumber);
- Result.Cache:=StrtoIntDef(CurrentTokenString,0);
- GetNextToken;
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- constructor TSQLParser.Create(AInput: TStream);
- begin
- FInput:=AInput;
- FCurrent:=TSQLUnknown;
- FScanner:=TSQLScanner.Create(FInput);
- FFreeScanner:=True;
- end;
- constructor TSQLParser.Create(AScanner: TSQLScanner);
- begin
- FCurrent:=TSQLUnknown;
- FScanner:=AScanner;
- FFreeScanner:=False;
- end;
- destructor TSQLParser.Destroy;
- begin
- If FFreeScanner then
- FreeAndNil(FScanner);
- inherited Destroy;
- end;
- function TSQLParser.ParseDeclareFunctionStatement(AParent: TSQLElement
- ): TSQLDeclareExternalFunctionStatement;
- begin
- // On entry, we're on the EXTERNAL token
- Consume(tsqlExternal);
- Consume(tsqlFunction);
- Expect(tsqlidentifier);
- Result:=TSQLDeclareExternalFunctionStatement(CreateElement(TSQLDeclareExternalFunctionStatement,AParent));
- try
- Result.ObjectName:=CreateIdentifier(Result,CurrentTokenString);
- If (PeekNextToken=tsqlReturns) then
- GetNextToken
- else
- Repeat
- Result.Arguments.Add(Self.ParseTypeDefinition(Result,[ptfExternalFunction]));
- Until (CurrentToken<>tsqlComma);
- Expect(tsqlReturns);
- Result.ReturnType:=ParseTypeDefinition(Result,[ptfExternalFunctionResult]);
- Result.FreeIt:=(CurrentToken=tsqlFreeIt);
- If Result.FreeIt then
- GetNextToken;
- Consume(tsqlEntryPoint);
- Expect(tsqlString);
- Result.EntryPoint:=CurrentTokenString;
- GetNextToken;
- Consume(tsqlModuleName);
- Expect(tsqlString);
- Result.ModuleName:=CurrentTokenstring;
- GetNextToken;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseDeclareStatement(AParent: TSQLElement): TSQLStatement;
- begin
- // On entry, we're on the DECLARE statement
- Consume(tsqlDeclare);
- // For the moment, only 'DECLARE EXTERNAL FUNCTION' is supported
- Case CurrentToken of
- tsqlExternal : Result:=ParseDeclareFunctionStatement(AParent);
- else
- UnexpectedToken([tsqlExternal]);
- end;
- end;
- procedure TSQLParser.ParseGranteeList(AParent: TSQLElement;
- List: TSQLElementList; AllowObject, AllowGroup, AllowPublic: Boolean; IsRevoke: Boolean = False);
- Type
- TSQLGranteeClass = Class of TSQLGrantee;
- Function CreateGrantee(NextIdentifier : Boolean; AClass : TSQLGranteeClass) : TSQLGrantee;
- begin
- if NextIdentifier then
- begin
- GetNextToken;
- Expect(tsqlIdentifier);
- end;
- Result:=TSQLGrantee(CreateElement(AClass,AParent));
- Result.Name:=CurrentTokenString;
- List.Add(Result);
- end;
- Var
- E : TSQLTokens;
- begin
- if IsRevoke then
- Consume(tsqlFrom)
- else
- Consume(tsqlTo);
- E:=[tsqlIdentifier,tsqlUser];
- If AllowObject then
- E:=E+[tsqlProcedure,tsqlView,tsqlTrigger,tsqlPublic]
- else If AllowPublic then
- E:=E+[tsqlPublic];
- If AllowGroup then
- E:=E+[tsqlGROUP];
- Expect(E);
- Repeat
- If CurrentToken=tsqlComma then
- GetNextToken;
- Case CurrentToken of
- tsqlUser,
- tsqlIdentifier :
- CreateGrantee(CurrentToken=tsqlUser,TSQLUserGrantee);
- TsqlGroup :
- begin
- If Not AllowGroup then
- UnexpectedToken;
- CreateGrantee(true,TSQLGroupGrantee);
- end;
- TsqlPublic :
- begin
- If Not (AllowPublic or AllowObject) then
- UnexpectedToken;
- CreateGrantee(False,TSQLPublicGrantee);
- end;
- TsqlTrigger:
- begin
- If Not AllowObject then
- UnexpectedToken;
- CreateGrantee(True,TSQLTriggerGrantee);
- end;
- TsqlView:
- begin
- If Not AllowObject then
- UnexpectedToken;
- CreateGrantee(true,TSQLViewGrantee);
- end;
- TsqlProcedure:
- begin
- If Not AllowObject then
- UnexpectedToken;
- CreateGrantee(true,TSQLProcedureGrantee);
- end;
- else
- Expect([tsqlUser, tsqlIdentifier, TsqlGroup, TsqlPublic,TsqlTrigger, TsqlView, TsqlProcedure]);
- end;
- Until (GetNextToken<>tsqlComma);
- end;
- function TSQLParser.ParseGrantTableStatement(AParent: TSQLElement): TSQLTableGrantStatement;
- Var
- C : TSQLColumnPrivilege;
- P : TSQLPrivilege;
- begin
- Result:=TSQLTableGrantStatement(CreateElement(TSQLTableGrantStatement,APArent));
- try
- // On entry, we're on the first ALL/SELECT/UPDATE/INSERT/DELETE/REFERENCE etc. token.
- if CurrentToken=tsqlAll then
- begin
- Result.Privileges.Add(CreateElement(TSQLAllPrivilege,Result));
- If GetNextToken=tsqlPrivileges then
- GetNextToken;
- end
- else
- Repeat
- P:=Nil;
- C:=Nil;
- if CurrentToken=tsqlComma then
- GetNextToken;
- Case CurrentToken of
- tsqlSelect : P:=TSQLSelectPrivilege(CreateElement(TSQLSelectPrivilege,Result));
- tsqlInsert : P:=TSQLInsertPrivilege(CreateElement(TSQLInsertPrivilege,Result));
- tsqlDelete : P:=TSQLDeletePrivilege(CreateElement(TSQLDeletePrivilege,Result));
- tsqlUpdate,
- tsqlReferences :
- begin
- if CurrentToken=tsqlUpdate then
- C:=TSQLUpdatePrivilege(CreateElement(TSQLUpdatePrivilege,AParent))
- else
- C:=TSQLReferencePrivilege(CreateElement(TSQLReferencePrivilege,AParent));
- P:=C;
- GetNextToken;
- If (CurrentToken=tsqlBraceOpen) then
- begin
- GetNextToken;
- C.Columns:=TSQLElementList.Create(True);
- ParseIdentifierList(C,C.Columns);
- end;
- end;
- else
- UnexpectedToken([tsqlselect,tsqlInsert,tsqlDelete,tsqlUpdate,tsqlReferences]);
- end;
- Result.Privileges.Add(P);
- If C=Nil then
- GetNextToken;
- Until (CurrentToken<>tsqlComma);
- Consume(tsqlOn);
- Expect(tsqlidentifier);
- Result.TableName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- ParseGranteeList(Result,Result.Grantees,True,True,True);
- If (CurrentToken=tsqlWith) then
- begin
- Consume(tsqlWith);
- Consume(tsqlGrant);
- Consume(tsqlOption);
- Result.GrantOption:=True;
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseRevokeExecuteStatement(AParent: TSQLElement
- ): TSQLProcedureRevokeStatement;
- BEGIN
- // On entry, we're on the EXECUTE token
- Consume(tsqlExecute);
- Consume(tsqlOn);
- Consume(tsqlProcedure);
- Expect(tsqlIdentifier);
- Result:=TSQLProcedureRevokeStatement(CreateElement(TSQLProcedureRevokeStatement,AParent));
- try
- Result.ProcedureName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- ParseGranteeList(Result,Result.Grantees,True,False,True,True);
- If (CurrentToken=tsqlWith) then
- begin
- Consume(tsqlWith);
- Consume(tsqlGrant);
- Consume(tsqlOption);
- Result.GrantOption:=True;
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseRevokeRoleStatement(AParent: TSQLElement
- ): TSQLRoleRevokeStatement;
- begin
- Result:=Nil;
- // On entry, we're on the identifier token
- expect(tsqlIdentifier);
- Result:=TSQLRoleRevokeStatement(CreateElement(TSQLRoleRevokeStatement,AParent));
- try
- Repeat
- if CurrentToken=tsqlComma then
- GetNextToken;
- expect(tsqlIdentifier);
- Result.Roles.Add(CreateIDentifier(Aparent,CurrentTokenString));
- Until (GetNextToken<>tsqlComma);
- Expect(tsqlFrom);
- ParseGranteeList(Result,Result.Grantees,False,False,True,True);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseRevokeTableStatement(AParent: TSQLElement
- ): TSQLTableRevokeStatement;
- Var
- C : TSQLColumnPrivilege;
- P : TSQLPrivilege;
- begin
- Result:=TSQLTableRevokeStatement(CreateElement(TSQLTableRevokeStatement,APArent));
- try
- // On entry, we're on the first GRANT,ALL/SELECT/UPDATE/INSERT/DELETE/REFERENCE etc. token.
- If (CurrentToken=tsqlGrant) then
- begin
- Consume(tsqlGrant);
- Consume(tsqlOption);
- Consume(tsqlFor);
- Result.GrantOption:=True;
- end;
- if CurrentToken=tsqlAll then
- begin
- Result.Privileges.Add(CreateElement(TSQLAllPrivilege,Result));
- If GetNextToken=tsqlPrivileges then
- GetNextToken;
- end
- else
- Repeat
- P:=Nil;
- C:=Nil;
- if CurrentToken=tsqlComma then
- GetNextToken;
- Case CurrentToken of
- tsqlSelect : P:=TSQLSelectPrivilege(CreateElement(TSQLSelectPrivilege,Result));
- tsqlInsert : P:=TSQLInsertPrivilege(CreateElement(TSQLInsertPrivilege,Result));
- tsqlDelete : P:=TSQLDeletePrivilege(CreateElement(TSQLDeletePrivilege,Result));
- tsqlUpdate,
- tsqlReferences :
- begin
- if CurrentToken=tsqlUpdate then
- C:=TSQLUpdatePrivilege(CreateElement(TSQLUpdatePrivilege,AParent))
- else
- C:=TSQLReferencePrivilege(CreateElement(TSQLReferencePrivilege,AParent));
- P:=C;
- GetNextToken;
- If (CurrentToken=tsqlBraceOpen) then
- begin
- GetNextToken;
- C.Columns:=TSQLElementList.Create(True);
- ParseIdentifierList(C,C.Columns);
- end;
- end;
- else
- UnexpectedToken([tsqlselect,tsqlInsert,tsqlDelete,tsqlUpdate,tsqlReferences]);
- end;
- Result.Privileges.Add(P);
- If C=Nil then
- GetNextToken;
- Until (CurrentToken<>tsqlComma);
- Consume(tsqlOn);
- Expect(tsqlidentifier);
- Result.TableName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- ParseGranteeList(Result,Result.Grantees,True,True,True,True);
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseGrantExecuteStatement(AParent: TSQLElement): TSQLProcedureGrantStatement;
- begin
- // On entry, we're on the EXECUTE token
- Consume(tsqlExecute);
- Consume(tsqlOn);
- Consume(tsqlProcedure);
- Expect(tsqlIdentifier);
- Result:=TSQLProcedureGrantStatement(CreateElement(TSQLProcedureGrantStatement,AParent));
- try
- Result.ProcedureName:=CreateIdentifier(Result,CurrentTokenString);
- GetNextToken;
- ParseGranteeList(Result,Result.Grantees,True,False,True);
- If (CurrentToken=tsqlWith) then
- begin
- Consume(tsqlWith);
- Consume(tsqlGrant);
- Consume(tsqlOption);
- Result.GrantOption:=True;
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseGrantRoleStatement(AParent: TSQLElement): TSQLRoleGrantStatement;
- begin
- Result:=Nil;
- // On entry, we're on the identifier token
- expect(tsqlIdentifier);
- Result:=TSQLRoleGrantStatement(CreateElement(TSQLRoleGrantStatement,AParent));
- try
- Repeat
- if CurrentToken=tsqlComma then
- GetNextToken;
- expect(tsqlIdentifier);
- Result.Roles.Add(CreateIDentifier(Aparent,CurrentTokenString));
- Until (GetNextToken<>tsqlComma);
- Expect(tsqlTo);
- ParseGranteeList(Result,Result.Grantees,False,False,True);
- If (CurrentToken=tsqlWith) then
- begin
- Consume(tsqlWith);
- Consume(tsqlAdmin);
- Consume(tsqlOption);
- Result.AdminOption:=True;
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseGrantStatement(AParent: TSQLElement): TSQLGrantStatement;
- begin
- // On entry, we're on the GRANT token
- Result:=Nil;
- try
- Consume(tsqlGrant);
- Case CurrentToken of
- tsqlExecute: Result:=ParseGrantExecutestatement(AParent);
- tsqlAll,
- tsqlUpdate,
- tsqlReferences,
- tsqlInsert,
- tsqldelete,
- tsqlSelect : Result:=ParseGrantTablestatement(AParent);
- tsqlIdentifier : Result:=ParseGrantRolestatement(AParent);
- else
- UnExpectedToken([tsqlIdentifier, tsqlExecute, tsqlall,
- tsqlUpdate, tsqldelete, tsqlReferences, tsqlInsert, tsqlSelect]);
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.ParseRevokeStatement(AParent: TSQLElement
- ): TSQLGrantStatement;
- begin
- // On entry, we're on the GRANT token
- Result:=Nil;
- try
- Consume(tsqlRevoke);
- Case CurrentToken of
- tsqlExecute: Result:=ParseRevokeExecutestatement(AParent);
- tsqlGrant,
- tsqlAll,
- tsqlUpdate,
- tsqlReferences,
- tsqlInsert,
- tsqldelete,
- tsqlSelect : Result:=ParseRevokeTablestatement(AParent);
- tsqlIdentifier : Result:=ParseRevokeRolestatement(AParent);
- else
- UnExpectedToken([tsqlIdentifier, tsqlExecute,tsqlgrant,tsqlall,
- tsqlUpdate, tsqldelete, tsqlReferences, tsqlInsert, tsqlSelect]);
- end;
- except
- FreeAndNil(Result);
- Raise;
- end;
- end;
- function TSQLParser.Parse: TSQLElement;
- begin
- if CurrentToken=tsqlEOF then begin
- Result:=nil;
- Exit;
- end;
- GetNextToken;
- Case CurrentToken of
- tsqlSelect : Result:=ParseSelectStatement(Nil,[]);
- tsqlUpdate : Result:=ParseUpdateStatement(Nil);
- tsqlInsert : Result:=ParseInsertStatement(Nil);
- tsqlDelete : Result:=ParseDeleteStatement(Nil);
- tsqlReCreate,
- tsqlCreate,
- tsqlAlter : Result:=ParseCreateStatement(Nil,(tsqlAlter=CurrentToken));
- tsqlDrop : Result:=ParseDropStatement(Nil);
- tsqlSet : Result:=ParseSetStatement(Nil);
- tsqlRollback : Result:=ParseRollBackStatement(Nil);
- tsqlCommit : Result:=ParseCommitStatement(Nil);
- tsqlExecute : Result:=ParseExecuteProcedureStatement(Nil);
- tsqlConnect : Result:=ParseConnectStatement(Nil);
- tsqlDeclare : Result:=ParseDeclareStatement(Nil);
- tsqlGrant : Result:=ParseGrantStatement(Nil);
- tsqlRevoke : Result:=ParseRevokeStatement(Nil);
- tsqlEOF : Result:=nil;
- else
- UnexpectedToken;
- end;
- if Not (CurrentToken in [tsqlEOF,tsqlSemicolon,tsqlTerminator]) then
- begin
- FreeAndNil(Result);
- if (CurrentToken=tsqlBraceClose) then
- Error(SerrUnmatchedBrace);
- Error(SErrUnexpectedToken,[CurrentTokenString]);
- end;
- end;
- function TSQLParser.Parse(aOptions: TParserOptions): TSQLElement;
- begin
- FOptions:=aOptions;
- Result:=Parse();
- end;
- function TSQLParser.ParseScript(AllowPartial : Boolean): TSQLElementList;
- begin
- if AllowPartial then
- Result:=ParseScript([poPartial])
- else
- Result:=ParseScript([])
- end;
- Function TSQLParser.ParseScript(aOptions : TParserOptions = []) : TSQLElementList;
- var
- E : TSQLElement;
- begin
- Foptions:=aOptions;
- Result:=TSQLElementList.Create(True);
- try
- E:=Parse;
- While (E<>Nil) do
- begin
- Result.Add(E);
- E:=Parse;
- end;
- except
- If Not (poPartial in Options) then
- begin
- FreeAndNil(Result);
- Raise;
- end;
- end;
- end;
- function TSQLParser.GetNextToken: TSQLToken;
- begin
- FPrevious:=FCurrent;
- // Set if not already peeked; otherwise fetch and look
- If (FPeekToken<>tsqlUnknown) then
- begin
- FCurrent:=FPeekToken;
- FCurrentString:=FPeekTokenString;
- FCurrentTokenLine:=FPeekTokenLine;
- FCurrentTokenPos:=FPeekTokenPos;
- FPeekToken:=tsqlUnknown;
- FPeekTokenString:='';
- end
- else
- begin
- FCurrent:=FScanner.FetchToken;
- FCurrentString:=FScanner.CurTokenString;
- FCurrentTokenLine:=FScanner.CurTokenRow;
- FCurrentTokenPos:=FScanner.CurTokenColumn;
- end;
- Result:=FCurrent;
- {$ifdef debugparser}Writeln('GetNextToken : ',GetEnumName(TypeInfo(TSQLToken),Ord(FCurrent)), ' As string: ',FCurrentString);{$endif debugparser}
- end;
- function TSQLParser.PeekNextToken: TSQLToken;
- begin
- If (FPeekToken=tsqlUnknown) then
- begin
- FPeekToken:=FScanner.FetchToken;
- FPeekTokenString:=FScanner.CurTokenString;
- FPeekTokenLine:=FScanner.CurTokenRow;
- FPeekTokenPos:=FScanner.CurTokenColumn;
- end;
- {$ifdef debugparser}Writeln('PeekNextToken : ',GetEnumName(TypeInfo(TSQLToken),Ord(FPeekToken)), ' As string: ',FPeekTokenString);{$endif debugparser}
- Result:=FPeekToken;
- end;
- function TSQLParser.PreviousToken: TSQLToken;
- begin
- Result:=FPRevious;
- end;
- function TSQLParser.IsEndOfLine: Boolean;
- begin
- Result:=FScanner.IsEndOfLine;
- end;
- end.
|