12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241 |
- {
- 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.
- 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.
- 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] then
- begin
- If currentToken=tsqlAs then
- GetNextToken;
- Expect(tsqlIdentifier);
- 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.
- 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.
- 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
- 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;
- 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));
- TSQLFloatLiteral(Result).Value:=StrToFloat(CurrentTokenString);
- 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
- 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;
- tsqlIdentifier:
- begin
- N:=CurrentTokenString;
- If (GetNextToken<>tsqlBraceOpen) then
- begin
- If (eoCheckConstraint in EO) and not (eoTableConstraint in EO) then
- Error(SErrUnexpectedToken,[CurrentTokenString]);
- // Plain identifier
- IdentifierPath:=TSQLIdentifierPath.Create;
- IdentifierPath.Add(CreateIdentifier(Result,N));
- while (CurrentToken=tsqlDot) do
- begin
- GetNextToken;
- if CurrentToken=tsqlMUL then
- begin
- Result:=TSQLAsteriskExpression(CreateElement(TSQLAsteriskExpression,APArent));
- GetNextToken;
- break;
- end
- else
- begin
- Expect(tsqlIdentifier);
- N:=CurrentTokenString;
- IdentifierPath.Add(CreateIdentifier(Result,N));
- GetNextToken;
- end;
- end;
- if not Assigned(Result) then
- Result:=TSQLIdentifierExpression(CreateElement(TSQLIdentifierExpression,APArent));
- TSQLIdentifierPathExpression(Result).IdentifierPath:=IdentifierPath;
- // Array access ?
- If (CurrentToken=tsqlSquareBraceOpen) and (Result is TSQLIdentifierExpression) then
- // Either something like array[5] or,
- // in procedures etc array[i:] where i is a variable
- begin
- 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;
- end
- else
- begin
- L:=ParseValueList(AParent,EO);
- GetNextToken; // Consume );
- // Function call
- Result:=TSQLFunctionCallExpression(CreateElement(TSQLFunctionCallExpression,AParent));
- TSQLFunctionCallExpression(Result).IDentifier:=N;
- TSQLFunctionCallExpression(Result).Arguments:=L;
- end;
- 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.
|