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