1756 lines
68 KiB
ObjectPascal
1756 lines
68 KiB
ObjectPascal
/// generate cross-platform clients code and documentation from a mORMot server
|
|
// - this unit is a part of the freeware Synopse mORMot framework,
|
|
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
|
|
unit mORMotWrappers;
|
|
|
|
{
|
|
This file is part of Synopse mORMot framework.
|
|
|
|
Synopse mORMot framework. Copyright (C) 2022 Arnaud Bouchez
|
|
Synopse Informatique - https://synopse.info
|
|
|
|
*** BEGIN LICENSE BLOCK *****
|
|
Version: MPL 1.1/GPL 2.0/LGPL 2.1
|
|
|
|
The contents of this file are subject to the Mozilla Public License Version
|
|
1.1 (the "License"); you may not use this file except in compliance with
|
|
the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
for the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is Synopse mORMot framework.
|
|
|
|
The Initial Developer of the Original Code is Arnaud Bouchez.
|
|
|
|
Portions created by the Initial Developer are Copyright (C) 2022
|
|
the Initial Developer. All Rights Reserved.
|
|
|
|
Contributor(s) (for this unit and the .mustache templates):
|
|
- EMartin
|
|
- Sabbiolina
|
|
- Sevo
|
|
- Stefan Diestelmann
|
|
|
|
|
|
Alternatively, the contents of this file may be used under the terms of
|
|
either the GNU General Public License Version 2 or later (the "GPL"), or
|
|
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
|
|
in which case the provisions of the GPL or the LGPL are applicable instead
|
|
of those above. If you wish to allow use of your version of this file only
|
|
under the terms of either the GPL or the LGPL, and not to allow others to
|
|
use your version of this file under the terms of the MPL, indicate your
|
|
decision by deleting the provisions above and replace them with the notice
|
|
and other provisions required by the GPL or the LGPL. If you do not delete
|
|
the provisions above, a recipient may use your version of this file under
|
|
the terms of any one of the MPL, the GPL or the LGPL.
|
|
|
|
***** END LICENSE BLOCK *****
|
|
|
|
}
|
|
|
|
{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
|
|
|
|
interface
|
|
|
|
uses
|
|
{$ifdef ISDELPHIXE2}System.SysUtils,{$else}SysUtils,{$endif}
|
|
Classes,
|
|
Contnrs,
|
|
Variants,
|
|
SynCommons,
|
|
SynTable,
|
|
mORMot,
|
|
SynLZ,
|
|
SynMustache;
|
|
|
|
/// compute the Model information, ready to be exported as JSON
|
|
// - will publish the ORM and SOA properties
|
|
// - to be used e.g. for client code generation via Mustache templates
|
|
// - optional aSourcePath parameter may be used to retrieve additional description
|
|
// from the comments of the source code of the unit - this text content may
|
|
// also be injected by WRAPPER_RESOURCENAME
|
|
// - you may specify a description file (as generated by FillDescriptionFromSource)
|
|
function ContextFromModel(aServer: TSQLRestServer;
|
|
const aSourcePath: TFileName=''; const aDescriptions: TFileName=''): variant;
|
|
|
|
/// compute the information of an interface method, ready to be exported as JSON
|
|
// - to be used e.g. for the implementation of the MVC controller via interfaces
|
|
// - no description text will be included - use ContextFromModel() if needed
|
|
function ContextFromMethod(const method: TServiceMethod): variant;
|
|
|
|
/// compute the information of an interface, ready to be exported as JSON
|
|
// - to be used e.g. for the implementation of the MVC controller via interfaces
|
|
// - no description text will be included - use ContextFromModel() if needed
|
|
function ContextFromMethods(int: TInterfaceFactory): variant;
|
|
|
|
/// generate a code/doc wrapper for a given Model and Mustache template content
|
|
// - will use all ORM and SOA properties of the supplied server
|
|
// - aFileName will be transmitted as {{filename}}, e.g. 'mORMotClient'
|
|
// - you should also specify a "fake" HTTP port e.g. 888
|
|
// - the template content could be retrieved from a file via StringFromFile()
|
|
// - you may optionally retrieve a copy of the data context as TDocVariant
|
|
// - this function may be used to generate the client at build time, directly
|
|
// from a just built server, in an automated manner
|
|
// - you may specify custom helpers (e.g. via TSynMustache.HelpersGetStandardList)
|
|
// and retrieve the generated data context after generation (if aContext is
|
|
// a TDocVariant object, its fields would be added to the rendering context),
|
|
// or a custom description file (as generated by FillDescriptionFromSource)
|
|
function WrapperFromModel(aServer: TSQLRestServer;
|
|
const aMustacheTemplate, aFileName: RawUTF8; aPort: integer;
|
|
aHelpers: TSynMustacheHelpers=nil; aContext: PVariant=nil;
|
|
const aDescriptions: TFileName=''): RawUTF8;
|
|
|
|
/// generate a code/doc wrapper for a given set of types and Mustache template content
|
|
// - will use aTables[] to define the ORM information, and supplied aSharedServices[]
|
|
// aSharedServicesContract[] for SOA definition of a shared API (expected to
|
|
// be called from TSQLRestClientURI.ServiceDefineSharedAPI)
|
|
// - aFileName will be transmitted as {{filename}}, e.g. 'mORMotClient'
|
|
// - you should also specify a "fake" HTTP port e.g. 888
|
|
// - the template content could be retrieved from a file via StringFromFile()
|
|
// - you may optionally retrieve a copy of the data context as TDocVariant
|
|
// - this function may be used to generate the client at build time, directly
|
|
// from a just built server, in an automated manner
|
|
// - you may specify custom helpers (e.g. via TSynMustache.HelpersGetStandardList)
|
|
// and retrieve the generated data context after generation (if aContext is
|
|
// a TDocVariant object, its fields would be added to the rendering context),
|
|
// or a custom description file (as generated by FillDescriptionFromSource)
|
|
function WrapperForPublicAPI(const aTables: array of TSQLRecordClass;
|
|
const aRoot, aMustacheTemplate, aFileName: RawUTF8; const aSharedServices: array of TGUID;
|
|
const aSharedServicesContract: array of RawUTF8; aResultAsJSONObjectWithoutResult: boolean;
|
|
aPort: integer; aHelpers: TSynMustacheHelpers=nil; aContext: PVariant=nil;
|
|
const aDescriptions: TFileName=''): RawUTF8;
|
|
|
|
/// instantiate a TSQLRest server instance, including supplied ORM and SOA definitions
|
|
// - will use aTables[] to define the ORM information, and supplied aSharedServices[]
|
|
// aSharedServicesContract[] for SOA definition of a shared API, implemented as
|
|
// abstract classes using TInterfaceStub
|
|
// - as used e.g. by WrapperForPublicAPI() to generate some code/doc wrappers
|
|
function WrapperFakeServer(const aTables: array of TSQLRecordClass; const aRoot: RawUTF8;
|
|
const aSharedServices: array of TGUID; const aSharedServicesContract: array of RawUTF8;
|
|
aResultAsJSONObjectWithoutResult: boolean): TSQLRestServerFullMemory;
|
|
|
|
/// you can call this procedure within a method-based service allow
|
|
// code-generation of an ORM and SOA client from a web browser
|
|
// - you have to specify one or several client *.mustache file paths
|
|
// - the first path containing any *.mustache file will be used as templates
|
|
// - for instance:
|
|
// ! procedure TCustomServer.Wrapper(Ctxt: TSQLRestServerURIContext);
|
|
// ! begin // search in the current path
|
|
// ! WrapperMethod(Ctxt,['.']);
|
|
// ! end;
|
|
// - optional SourcePath parameter may be used to retrieve additional description
|
|
// from the comments of the source code of the unit
|
|
// - you may specify a description file (as generated by FillDescriptionFromSource)
|
|
procedure WrapperMethod(Ctxt: TSQLRestServerURIContext; const Path: array of TFileName;
|
|
const SourcePath: TFileName=''; const Descriptions: TFileName='');
|
|
|
|
/// you can call this procedure to add a 'Wrapper' method-based service
|
|
// to a given server, to allow code-generation of an ORM and SOA client
|
|
// - you have to specify one or several client *.mustache file paths
|
|
// - the first path containing any *.mustache file will be used as templates
|
|
// - if no path is specified (i.e. as []), it will search in the .exe folder
|
|
// - the root/wrapper URI will be accessible without authentication (i.e.
|
|
// from any plain browser)
|
|
// - for instance:
|
|
// ! aServer := TSQLRestServerFullMemory.Create(aModel,'test.json',false,true);
|
|
// ! AddToServerWrapperMethod(aServer,['..']);
|
|
// - optional SourcePath parameter may be used to retrieve additional description
|
|
// from the comments of the source code of the unit
|
|
procedure AddToServerWrapperMethod(Server: TSQLRestServer; const Path: array of TFileName;
|
|
const SourcePath: TFileName='');
|
|
|
|
/// you can call this procedure to generate the mORMotServer.pas unit needed
|
|
// to compile a given server source code using FPC
|
|
// - will locate FPCServer-mORMotServer.pas.mustache in the given Path[] array
|
|
// - will write the unit using specified file name or to mORMotServer.pas in the
|
|
// current directory if DestFileName is '', or to a sub-folder of the matching
|
|
// Path[] if DestFileName starts with '\' (to allow relative folder use)
|
|
// - the missing RTTI for records and interfaces would be defined, together
|
|
// with some patch comments for published record support (if any) for the ORM
|
|
procedure ComputeFPCServerUnit(Server: TSQLRestServer; const Path: array of TFileName;
|
|
DestFileName: TFileName='');
|
|
|
|
/// you can call this procedure to generate the mORMotInterfaces.pas unit needed
|
|
// to register all needed interface RTTI for FPC
|
|
// - to circumvent http://bugs.freepascal.org/view.php?id=26774 unresolved issue
|
|
// - will locate FPC-mORMotInterfaces.pas.mustache in the given Path[] array
|
|
// - will write the unit using specified file name or to mORMotInterfaces.pas in
|
|
// the current directory if DestFileName is '', or to a sub-folder of the
|
|
// matching Path[] if DestFileName starts with '\' (to allow relative folder use)
|
|
// - all used interfaces will be exported, including SOA and mocking/stubing
|
|
// types: so you may have to run this function AFTER all process is done
|
|
procedure ComputeFPCInterfacesUnit(const Path: array of TFileName;
|
|
DestFileName: TFileName='');
|
|
|
|
/// rough parsing of the supplied .pas unit, adding the /// commentaries
|
|
// into a TDocVariant content
|
|
procedure FillDescriptionFromSource(var Descriptions: TDocVariantData;
|
|
const SourceFileName: TFileName);
|
|
|
|
/// rough parsing of the supplied .pas unit, adding the /// commentaries
|
|
// into a compressed binary resource
|
|
// - could be then compiled into a WRAPPER_RESOURCENAME resource, e.g. via the
|
|
// following .rc source file, assuming ResourceDestFileName='wrapper.desc':
|
|
// $ WrappersDescription 10 "wrapper.desc"
|
|
// - you may specify a .json file name, for debugging/validation purposes
|
|
// - calls internally FillDescriptionFromSource
|
|
// - returns the TDocVariant JSON object corresponding to all decriptions
|
|
function ResourceDescriptionFromSource(const ResourceDestFileName: TFileName;
|
|
const SourceFileNames: array of TFileName;
|
|
const JsonDestFileName: TFileName = ''): variant;
|
|
|
|
const
|
|
/// internal Resource name used for bounded description
|
|
// - as generated by FillDescriptionFromSource/ResourceDescriptionFromSource
|
|
// - would be used e.g. by TWrapperContext.Create to inject the available
|
|
// text description from any matching resource
|
|
WRAPPER_RESOURCENAME = 'WrappersDescription';
|
|
|
|
var
|
|
/// how FillDescriptionFromSource() handles trailing '-' in parsed comments
|
|
// - default is [*], as expected by buggy AsciiDoc format
|
|
DESCRIPTION_ITEM_PREFIX: RawUTF8 = ' [*]';
|
|
|
|
/// this function would generate a pascal unit defining asynchronous
|
|
// (non-blocking) types from a DDD's blocking dual-phase Select/Command service
|
|
// - you should specify the services to be converted, as an array - note that
|
|
// due to how RTTI is stored by the compiler, all "pure input" parameters should
|
|
// be defined explicitly as "const", otherwise the generated class won't match
|
|
// - optionally, the TCQRSServiceClass implementing the first Select() phase of
|
|
// the blocking service may be specified in queries array; a set of unit names
|
|
// in which those TCQRSServiceClass are defined may be specified
|
|
// - a Mustache template content should be provided - e.g. asynch.pas.mustache
|
|
// as published in SQLite3\DDD\dom folder of the source code repository
|
|
// - FileName would contain the resulting unit filename (without the .pas)
|
|
// - ProjectName would be written in the main unit comment
|
|
// - CallType should be the type used at Domain level to identify each
|
|
// asynchronous call - this type should be an integer, or a function may be
|
|
// supplied as CallFunction (matching VariantToInteger signature)
|
|
// - the first phase of the service should have set Key: KeyType, which would be
|
|
// used to create a single shared asynchronous service instance for all keys
|
|
// - ExceptionType may be customize, mainly to use a Domain-specific class
|
|
// - blocking execution may reach some timeout waiting for the asynchronous
|
|
// acknowledgement: a default delay (in ms) is to be supplied, and some custom
|
|
// delays may be specified as trios, e.g. ['IMyInterface', 'Method', 10000, ...]
|
|
function GenerateAsynchServices(const services: array of TGUID;
|
|
const queries: array of TClass; const units: array of const;
|
|
const additionalcontext: array of const; Template, FileName, ProjectName,
|
|
CallType, CallFunction, Key, KeyType, ExceptionType: RawUTF8;
|
|
DefaultDelay: integer; const CustomDelays: array of const): RawUTF8;
|
|
|
|
|
|
type
|
|
/// the options retrieved during a ExecuteFromCommandLine() call
|
|
TServiceClientCommandLineOptions = set of (cloPrompt,
|
|
cloNoColor, cloPipe, cloHeaders, cloVerbose, cloNoExpand, cloNoBody);
|
|
|
|
/// event handler to let ExecuteFromCommandLine call a remote server
|
|
// - before call, aParams.InBody will be set with the expected JSON content
|
|
TOnCommandLineCall = procedure(aOptions: TServiceClientCommandLineOptions;
|
|
const aService: TInterfaceFactory; aMethod: PServiceMethod;
|
|
var aParams: TSQLRestURIParams) of object;
|
|
|
|
const
|
|
/// help information displayed by ExecuteFromCommandLine() with no command
|
|
EXECUTEFROMCOMMANDLINEHELP =
|
|
' % help -> show all services (interfaces)'#13#10 +
|
|
' % [service] [help] -> show all methods of a given service'#13#10 +
|
|
' % [service] [method] help -> show parameters of a given method'#13#10 +
|
|
' % [options] [service] [method] [parameters] -> call a given method ' +
|
|
{$ifdef MSWINDOWS}
|
|
'with [parameters] being name=value or name=""value with spaces"" or ' +
|
|
'name:={""some"":""json""}' +
|
|
' and [options] as /nocolor /pipe /headers /verbose /noexpand /nobody';
|
|
{$else}
|
|
'with [parameters] being name=value or name=''"value with spaces"'' or ' +
|
|
'name:=''{"some":"json"}''' +
|
|
' and [options] as --nocolor --pipe --headers --verbose --noexpand --nobody';
|
|
{$endif MSWINDOWS}
|
|
|
|
/// command-line SOA remote access to mORMot interface-based services
|
|
// - supports the following EXECUTEFROMCOMMANDLINEHELP commands
|
|
// - you shall have registered the aServices interface(s) by a previous call to
|
|
// the overloaded Get(TypeInfo(IMyInterface)) method or RegisterInterfaces()
|
|
// - you may specify an optional description file, as previously generated
|
|
// by mORMotWrappers' FillDescriptionFromSource function - a local
|
|
// 'WrappersDescription' resource will also be checked
|
|
// - to actually call the remote server, aOnGetClient should be supplied
|
|
procedure ExecuteFromCommandLine(const aServices: array of TGUID;
|
|
const aOnCall: TOnCommandLineCall; const aDescriptions: TFileName = '');
|
|
|
|
|
|
implementation
|
|
|
|
type
|
|
/// a cross-platform published property kind
|
|
// - does not match mORMot.pas TSQLFieldType: here we recognize only types
|
|
// which may expect a special behavior in SynCrossPlatformREST.pas unit
|
|
// - should match TSQLFieldKind order in SynCrossPlatformREST.pas
|
|
TCrossPlatformSQLFieldKind = (
|
|
cpkDefault, cpkDateTime, cpkTimeLog, cpkBlob, cpkModTime, cpkCreateTime,
|
|
cpkRecord, cpkVariant);
|
|
|
|
const
|
|
/// those text values should match TSQLFieldKind in SynCrossPlatformREST.pas
|
|
CROSSPLATFORMKIND_TEXT: array[TCrossPlatformSQLFieldKind] of RawUTF8 = (
|
|
'sftUnspecified', 'sftDateTime', 'sftTimeLog', 'sftBlob', 'sftModTime',
|
|
'sftCreateTime', 'sftRecord', 'sftVariant');
|
|
|
|
type
|
|
/// types recognized and handled by this mORMotWrappers unit
|
|
TWrapperType = (
|
|
wUnknown,
|
|
wBoolean, wEnum, wSet,
|
|
wByte, wWord, wInteger, wCardinal,
|
|
wInt64, wQWord, wID, wReference, wTimeLog, wModTime, wCreateTime,
|
|
wCurrency, wSingle, wDouble, wDateTime,
|
|
wRawUTF8, wString, wRawJSON, wBlob,
|
|
wGUID, wCustomAnswer, wRecord, wArray, wVariant,
|
|
wObject, wSQLRecord, wInterface, wRecordVersion);
|
|
/// supported languages typesets
|
|
TWrapperLanguage = (
|
|
lngDelphi, lngPascal, lngCS, lngJava, lngTypeScript, lngSwagger);
|
|
|
|
const
|
|
CROSSPLATFORM_KIND: array[TSQLFieldType] of TCrossPlatformSQLFieldKind = (
|
|
// sftUnknown, sftAnsiText, sftUTF8Text, sftEnumerate, sftSet, sftInteger,
|
|
cpkDefault, cpkDefault, cpkDefault, cpkDefault, cpkDefault,cpkDefault,
|
|
// sftID, sftRecord, sftBoolean,sftFloat, sftDateTime,
|
|
cpkDefault,cpkDefault,cpkDefault,cpkDefault,cpkDateTime,
|
|
// sftTimeLog,sftCurrency,
|
|
cpkTimeLog,cpkDefault,
|
|
// sftObject, sftVariant, sftNullable, sftBlob, sftBlobDynArray, sftBlobCustom,
|
|
cpkDefault, cpkVariant, cpkVariant, cpkBlob, cpkDefault, cpkDefault,
|
|
// sftUTF8Custom,sftMany, sftModTime, sftCreateTime, sftTID, sftRecordVersion
|
|
cpkRecord, cpkDefault,cpkModTime, cpkCreateTime, cpkDefault, cpkDefault,
|
|
// sftSessionUserID, sftDateTimeMS, sftUnixTime, sftUnixMStime
|
|
cpkDefault, cpkDateTime, cpkDefault, cpkDefault);
|
|
|
|
SIZETODELPHI: array[0..8] of string[7] = (
|
|
'integer','byte','word','integer','integer','int64','int64','int64','int64');
|
|
|
|
TYPES_SIZE: array[0..8] of TWrapperType = (
|
|
wInteger,wByte,wWord,wInteger,wInteger,wInt64,wInt64,wInt64,wInt64);
|
|
|
|
SWI32 = '{"type":"integer"}';
|
|
SWI64 = '{"type":"integer","format":"int64"}';
|
|
SWD32 = '{"type":"number","format":"float"}';
|
|
SWD64 = '{"type":"number","format":"double"}';
|
|
|
|
{ TODO: refactor TID and Int64 for JavaScript (integers truncated to 53-bit) }
|
|
TYPES_LANG: array[TWrapperLanguage,TWrapperType] of RawUTF8 = (
|
|
// lngDelphi
|
|
('', 'Boolean', '', '', 'Byte', 'Word', 'Integer', 'Cardinal', 'Int64',
|
|
'UInt64', 'TID', 'TRecordReference', 'TTimeLog', 'TModTime', 'TCreateTime',
|
|
'Currency', 'Single', 'Double', 'TDateTime', 'RawUTF8','String', 'RawJSON',
|
|
'TSQLRawBlob', 'TGUID', 'TServiceCustomAnswer', '', '', 'Variant', '', '', '',
|
|
'TRecordVersion'),
|
|
// lngPascal
|
|
('', 'Boolean', '', '', 'Byte', 'Word', 'Integer', 'Cardinal', 'Int64',
|
|
'UInt64', 'TID', 'TRecordReference', 'TTimeLog', 'TModTime', 'TCreateTime',
|
|
'Currency', 'Single', 'Double', 'TDateTime', 'String', 'String', 'Variant',
|
|
'TSQLRawBlob', 'TGUID', 'THttpBody', '', '', 'Variant', '', 'TID', '',
|
|
'TRecordVersion'),
|
|
// lngCS
|
|
('', 'bool', '', '', 'byte', 'word', 'integer', 'uint', 'long', 'ulong',
|
|
'TID', 'TRecordReference', 'TTimeLog', 'TModTime', 'TCreateTime',
|
|
'decimal', 'single', 'double', 'double', 'string', 'string', 'dynamic',
|
|
'byte[]', 'Guid', 'byte[]', '', '', 'dynamic', '', 'TID', '',
|
|
'TRecordVersion'),
|
|
// lngJava
|
|
('', 'boolean', '', '', 'byte', 'int', 'int', 'long', 'long', 'long', 'TID',
|
|
'TRecordReference', 'TTimeLog', 'TModTime', 'TCreateTime', 'BigDecimal',
|
|
'single', 'double', 'double', 'String', 'String', 'Object', 'byte[]',
|
|
'String', 'byte[]', '', '', 'Object', '', 'TID', '', 'TRecordVersion'),
|
|
// lngTypeScript
|
|
('', 'boolean', '', '', 'number', 'number', 'number', 'number', 'number',
|
|
'number', 'mORMot.TID', 'mORMot.TRecordReference', 'mORMot.TTimeLog',
|
|
'mORMot.TModTime', 'mORMot.TCreateTime', 'number', 'number', 'number',
|
|
'mORMot.TDateTime', 'string', 'string', 'any', 'mORMot.TSQLRawBlob',
|
|
'mORMot.TGUID', 'mORMot.THttpBody', '', '', 'any', '', '', '',
|
|
'mORMot.TRecordVersion'),
|
|
// lngSwagger
|
|
('', '{"type":"boolean"}', '', '', SWI32, SWI32, SWI32, SWI32, SWI64,
|
|
SWI64, SWI64, SWI64, SWI64, SWI64, SWI64, SWD64, SWD32, SWD64,
|
|
'{"type":"string","format":"date-time"}', // wDateTime
|
|
'{"type":"string"}','{"type":"string"}',
|
|
'{"type":"object"}', //FIXME! //wRawJSON
|
|
'{"type":"string","format":"binary"}','{"type":"string"}', //wBlob,wGUID
|
|
'', '', '', '', //wCustomAnswer, wRecord, wArray, wVariant
|
|
'', SWI64, '', '' //wObject, wSQLRecord, wInterface, wRecordVersion
|
|
));
|
|
TYPES_ORM: array[TSQLFieldType] of TWrapperType =
|
|
(wUnknown, // sftUnknown
|
|
wString, // sftAnsiText
|
|
wRawUTF8, // sftUTF8Text
|
|
wEnum, // sftEnumerate
|
|
wSet, // sftSet
|
|
wUnknown, // sftInteger - wUnknown to force exact type
|
|
wSQLRecord, // sftID
|
|
wReference, // sftRecord
|
|
wBoolean, // sftBoolean
|
|
wUnknown, // sftFloat - wUnknown to force exact type
|
|
wDateTime, // sftDateTime
|
|
wTimeLog, // sftTimeLog
|
|
wCurrency, // sftCurrency
|
|
wObject, // sftObject
|
|
wVariant, // sftVariant
|
|
wVariant, // sftNullable
|
|
wBlob, // sftBlob
|
|
wBlob, // sftBlobDynArray
|
|
wRecord, // sftBlobCustom
|
|
wRecord, // sftUTF8Custom
|
|
wUnknown, // sftMany
|
|
wModTime, // sftModTime
|
|
wCreateTime, // sftCreateTime
|
|
wID, // sftID
|
|
wRecordVersion, // sftRecordVersion
|
|
wID, // sftSessionUserID
|
|
wDateTime, // sftDateTimeMS
|
|
wUnknown, // sftUnixTime
|
|
wUnknown); // sftUnixMSTime
|
|
|
|
TYPES_SIMPLE: array[TJSONCustomParserRTTIType] of TWrapperType = (
|
|
//ptArray, ptBoolean, ptByte, ptCardinal, ptCurrency, ptDouble, ptExtended,
|
|
wArray, wBoolean, wByte, wCardinal, wCurrency, wDouble, wDouble,
|
|
//ptInt64, ptInteger, ptQWord, ptRawByteString, ptRawJSON, ptRawUTF8, ptRecord,
|
|
wInt64, wInteger, wQWord, wBlob, wRawJSON, wRawUTF8, wRecord,
|
|
//ptSingle, ptString, ptSynUnicode, ptDateTime, ptDateTimeMS,
|
|
wSingle, wString, wRawUTF8, wDateTime, wDateTime,
|
|
//ptGUID, ptID, ptTimeLog, ptUnicodeString,
|
|
wGUID, wID, wTimeLog, {$ifdef HASVARUSTRING} wRawUTF8, {$endif}
|
|
//ptVariant, ptWideString, ptWord, ptCustom
|
|
wVariant, wRawUTF8, wWord, wUnknown);
|
|
|
|
TYPES_SOA: array[TServiceMethodValueType] of TWrapperType = (
|
|
wUnknown,wUnknown,wBoolean,wEnum,wSet,wUnknown,wUnknown,wUnknown,
|
|
wDouble,wDateTime,wCurrency,wRawUTF8,wString,wRawUTF8,wRawUTF8,wRawUTF8,
|
|
wRecord,wVariant,wObject,wRawJSON,wArray,
|
|
wUnknown); // integers are wUnknown to force best type
|
|
|
|
type
|
|
EWrapperContext = class(ESynException);
|
|
|
|
TWrapperContext = class
|
|
protected
|
|
fServer: TSQLRestServer;
|
|
fORM, fRecords,fEnumerates,fSets,fArrays,fUnits,fDescriptions: TDocVariantData;
|
|
fSOA: variant;
|
|
fSourcePath: TFileNameDynArray;
|
|
fHasAnyRecord: boolean;
|
|
function ContextFromInfo(typ: TWrapperType; typName: RawUTF8='';
|
|
typInfo: PTypeInfo=nil): variant;
|
|
function ContextNestedProperties(rtti: TJSONCustomParserRTTI): variant;
|
|
function ContextOneProperty(prop: TJSONCustomParserRTTI): variant;
|
|
function ContextFromMethods(int: TInterfaceFactory): variant;
|
|
function ContextFromMethod(const meth: TServiceMethod): variant;
|
|
function ContextArgsFromMethod(const meth: TServiceMethod): variant;
|
|
procedure AddUnit(const aUnitName: ShortString; addAsProperty: PVariant);
|
|
public
|
|
constructor Create(const aDescriptions: TFileName);
|
|
constructor CreateFromModel(aServer: TSQLRestServer; const aSourcePath: TFileName;
|
|
const aDescriptions: TFileName);
|
|
constructor CreateFromUsedInterfaces(const aDescriptions: TFileName);
|
|
function Context: variant;
|
|
end;
|
|
|
|
{ TWrapperContext }
|
|
|
|
constructor TWrapperContext.Create(const aDescriptions: TFileName);
|
|
var desc: RawByteString;
|
|
begin
|
|
TDocVariant.NewFast([@fORM,@fRecords,@fEnumerates,@fSets,@fArrays,
|
|
@fUnits,@fDescriptions]);
|
|
if aDescriptions<>'' then
|
|
desc := StringFromFile(aDescriptions);
|
|
if desc='' then
|
|
ResourceSynLZToRawByteString(WRAPPER_RESOURCENAME,desc);
|
|
if desc<>'' then
|
|
fDescriptions.InitJSONInPlace(Pointer(desc),JSON_OPTIONS_FAST);
|
|
end;
|
|
|
|
constructor TWrapperContext.CreateFromModel(aServer: TSQLRestServer;
|
|
const aSourcePath, aDescriptions: TFileName);
|
|
var t,f,s,n: integer;
|
|
nfoList: TSQLPropInfoList;
|
|
nfo: TSQLPropInfo;
|
|
nfoSQLFieldRTTITypeName: RawUTF8;
|
|
kind: TCrossPlatformSQLFieldKind;
|
|
hasRecord: boolean;
|
|
fields,services: TDocVariantData;
|
|
field,rec: variant;
|
|
srv: TServiceFactoryServer;
|
|
uri: RawUTF8;
|
|
source: TFileName;
|
|
src: PChar;
|
|
begin
|
|
Create(aDescriptions);
|
|
if aSourcePath<>'' then begin
|
|
src := pointer(aSourcePath);
|
|
n := 0;
|
|
repeat
|
|
source := GetNextItemString(src,';');
|
|
if (source<>'') and DirectoryExists(source) then begin
|
|
SetLength(fSourcePath,n+1);
|
|
fSourcePath[n] := IncludeTrailingPathDelimiter(source);
|
|
inc(n);
|
|
end;
|
|
until src=nil;
|
|
end;
|
|
fServer := aServer;
|
|
TDocVariant.NewFast([@fields,@services]);
|
|
// compute ORM information
|
|
for t := 0 to fServer.Model.TablesMax do begin
|
|
nfoList := fServer.Model.TableProps[t].Props.Fields;
|
|
fields.Clear;
|
|
fields.Init;
|
|
hasRecord := false;
|
|
for f := 0 to nfoList.Count-1 do begin
|
|
nfo := nfoList.List[f];
|
|
nfoSQLFieldRTTITypeName := nfo.SQLFieldRTTITypeName;
|
|
if nfo.InheritsFrom(TSQLPropInfoRTTI) then
|
|
field := ContextFromInfo(TYPES_ORM[nfo.SQLFieldType],nfoSQLFieldRTTITypeName,
|
|
TSQLPropInfoRTTI(nfo).PropType) else
|
|
if nfo.InheritsFrom(TSQLPropInfoRecordTyped) then begin
|
|
hasRecord := true;
|
|
fHasAnyRecord := true;
|
|
field := ContextFromInfo(wRecord,nfoSQLFieldRTTITypeName,
|
|
TSQLPropInfoRecordTyped(nfo).TypeInfo);
|
|
end else
|
|
raise EWrapperContext.CreateUTF8('Unexpected type % for %.%',
|
|
[nfo,fServer.Model.Tables[t],nfo.Name]);
|
|
kind := CROSSPLATFORM_KIND[nfo.SQLFieldType];
|
|
_ObjAddProps(['index',f+1,'name',nfo.Name,'sql',ord(nfo.SQLFieldType),
|
|
'sqlName',nfo.SQLFieldTypeName^,'typeKind',ord(kind),
|
|
'typeKindName',CROSSPLATFORMKIND_TEXT[kind],'attr',byte(nfo.Attributes)],field);
|
|
if aIsUnique in nfo.Attributes then
|
|
_ObjAddProps(['unique',true],field);
|
|
if nfo.FieldWidth>0 then
|
|
_ObjAddProps(['width',nfo.FieldWidth],field);
|
|
if f<nfoList.Count-1 then
|
|
_ObjAddProps(['comma',','],field) else
|
|
_ObjAddProps(['comma',null],field); // may conflict with rec.comma otherwise
|
|
fields.AddItem(field);
|
|
end;
|
|
with fServer.Model.TableProps[t] do
|
|
rec := _JsonFastFmt(
|
|
'{tableName:?,className:?,classParent:?,fields:?,isInMormotPas:%,unitName:?,comma:%}',
|
|
[NULL_OR_TRUE[(Props.Table=TSQLAuthGroup) or (Props.Table=TSQLAuthUser)],
|
|
NULL_OR_COMMA[t<fServer.Model.TablesMax]],
|
|
[Props.SQLTableName,Props.Table.ClassName,
|
|
Props.Table.ClassParent.ClassName,Variant(fields),
|
|
Props.TableClassType^.UnitName]);
|
|
if hasRecord then
|
|
rec.hasRecords := true;
|
|
fORM.AddItem(rec);
|
|
end;
|
|
// compute SOA information
|
|
if fServer.Services.Count>0 then begin
|
|
for s := 0 to fServer.Services.Count-1 do begin
|
|
srv := fServer.Services.Index(s) as TServiceFactoryServer;
|
|
if fServer.Services.ExpectMangledURI then
|
|
uri := srv.InterfaceMangledURI else
|
|
uri := srv.InterfaceURI;
|
|
with srv do
|
|
rec := _ObjFast(['uri',uri,'interfaceURI',InterfaceURI,
|
|
'interfaceMangledURI',InterfaceMangledURI,
|
|
'interfaceName',InterfaceFactory.InterfaceTypeInfo^.Name,
|
|
'GUID',GUIDToRawUTF8(InterfaceFactory.InterfaceIID),
|
|
'contractExpected',UnQuoteSQLString(ContractExpected),
|
|
'instanceCreation',ord(InstanceCreation),
|
|
'instanceCreationName',GetEnumNameTrimed(
|
|
TypeInfo(TServiceInstanceImplementation),InstanceCreation),
|
|
'methods',ContextFromMethods(InterfaceFactory),
|
|
'bypassAuthentication',ByPassAuthentication,
|
|
'resultAsJSONObject',ResultAsJSONObject,
|
|
'resultAsJSONObjectWithoutResult',ResultAsJSONObjectWithoutResult and
|
|
(InstanceCreation in SERVICE_IMPLEMENTATION_NOID),
|
|
'resultAsXMLObject',ResultAsXMLObject,
|
|
'timeoutSec',TimeoutSec,
|
|
'serviceDescription',fDescriptions.GetValueOrNull(InterfaceFactory.InterfaceName)]);
|
|
if srv.InstanceCreation=sicClientDriven then
|
|
rec.isClientDriven := true;
|
|
services.AddItem(rec);
|
|
end;
|
|
fSOA := _ObjFast(['enabled',True,'services',variant(services),
|
|
'expectMangledURI',fServer.Services.ExpectMangledURI]);
|
|
end;
|
|
end;
|
|
|
|
constructor TWrapperContext.CreateFromUsedInterfaces(const aDescriptions: TFileName);
|
|
var interfaces: TSynObjectListLocked;
|
|
services: TDocVariantData;
|
|
i: Integer;
|
|
begin
|
|
Create(aDescriptions);
|
|
interfaces := TInterfaceFactory.GetUsedInterfaces;
|
|
if interfaces=nil then
|
|
exit;
|
|
services.InitFast;
|
|
for i := 0 to interfaces.Count-1 do
|
|
services.AddItem(_ObjFast([
|
|
'interfaceName',TInterfaceFactory(interfaces.List[i]).InterfaceTypeInfo^.Name,
|
|
'methods',ContextFromMethods(interfaces.List[i])]));
|
|
fSOA := _ObjFast(['enabled',True,'services',variant(services)]);
|
|
end;
|
|
|
|
function TWrapperContext.ContextArgsFromMethod(const meth: TServiceMethod): variant;
|
|
const
|
|
DIRTODELPHI: array[TServiceMethodValueDirection] of string[7] = (
|
|
'const','var','out','result');
|
|
DIRTOSMS: array[TServiceMethodValueDirection] of string[7] = (
|
|
'const','var','var','result');
|
|
var a,r: integer;
|
|
arg: variant;
|
|
begin
|
|
TDocVariant.NewFast(result);
|
|
r := 0;
|
|
for a := 1 to high(meth.Args) do begin
|
|
with meth.Args[a] do begin
|
|
arg := ContextFromInfo(TYPES_SOA[ValueType],'',ArgTypeInfo);
|
|
arg.argName := ParamName^;
|
|
arg.argType := ArgTypeName^;
|
|
arg.dir := ord(ValueDirection);
|
|
arg.dirName := DIRTODELPHI[ValueDirection];
|
|
arg.dirNoOut := DIRTOSMS[ValueDirection]; // no OUT in DWS/SMS -> VAR instead
|
|
if ValueDirection in [smdConst,smdVar] then
|
|
arg.dirInput := true;
|
|
if ValueDirection in [smdVar,smdOut,smdResult] then
|
|
arg.dirOutput := true;
|
|
if ValueDirection=smdResult then
|
|
arg.dirResult := true;
|
|
end;
|
|
if a<meth.ArgsNotResultLast then
|
|
_ObjAddProps(['commaArg','; '],arg);
|
|
if a=high(meth.Args) then
|
|
_ObjAddProps(['isArgLast',true],arg);
|
|
if (meth.args[a].ValueDirection in [smdConst,smdVar]) and (a<meth.ArgsInLast) then
|
|
_ObjAddProps(['commaInSingle',','],arg);
|
|
if (meth.args[a].ValueDirection in [smdVar,smdOut]) and (a<meth.ArgsOutNotResultLast) then
|
|
_ObjAddProps(['commaOut','; '],arg);
|
|
if meth.args[a].ValueDirection in [smdVar,smdOut,smdResult] then begin
|
|
_ObjAddProps(['indexOutResult',UInt32ToUtf8(r)+']'],arg);
|
|
inc(r);
|
|
if a<meth.ArgsOutLast then
|
|
_ObjAddProps(['commaOutResult','; '],arg);
|
|
end;
|
|
TDocVariantData(result).AddItem(arg);
|
|
end;
|
|
end;
|
|
|
|
function TWrapperContext.ContextFromMethod(const meth: TServiceMethod): variant;
|
|
const
|
|
VERB_DELPHI: array[boolean] of string[9] = ('procedure','function');
|
|
var d: variant;
|
|
begin
|
|
with meth do begin
|
|
result := _ObjFast(['methodName',URI, 'methodIndex',ExecutionMethodIndex,
|
|
'verb',VERB_DELPHI[ArgsResultIndex>=0],
|
|
'args',ContextArgsFromMethod(meth),
|
|
'argsOutputCount',ArgsOutputValuesCount]);
|
|
if self<>nil then begin// can be called as TWraperContext(nil).ContextFromMethod
|
|
d := fDescriptions.GetValueOrNull(InterfaceDotMethodName);
|
|
if VarIsEmptyOrNull(d) then
|
|
RawUTF8ToVariant(InterfaceDotMethodName,d);
|
|
result.methodDescription := d;
|
|
end;
|
|
if ArgsInFirst>=0 then
|
|
result.hasInParams := true;
|
|
if ArgsOutFirst>=0 then begin
|
|
result.hasOutParams := true;
|
|
if ArgsOutNotResultLast>0 then
|
|
result.hasOutNotResultParams := true;
|
|
end;
|
|
if ArgsResultIsServiceCustomAnswer then
|
|
result.resultIsServiceCustomAnswer := true;
|
|
if IsInherited then
|
|
result.isInherited := true;
|
|
end;
|
|
end;
|
|
|
|
function ResourceDescriptionFromSource(const ResourceDestFileName: TFileName;
|
|
const SourceFileNames: array of TFileName; const JsonDestFileName: TFileName): variant;
|
|
var desc: TDocVariantData absolute result;
|
|
i: integer;
|
|
json: RawUTF8;
|
|
begin
|
|
VarClear(result);
|
|
desc.InitFast;
|
|
for i := 0 to high(SourceFileNames) do
|
|
FillDescriptionFromSource(desc,SourceFileNames[i]);
|
|
json := desc.ToJSON;
|
|
if JsonDestFileName <> '' then
|
|
JSONReformatToFile(json, JsonDestFileName);
|
|
FileFromString(SynLZCompress(json),ResourceDestFileName);
|
|
end;
|
|
|
|
procedure FillDescriptionFromSource(var Descriptions: TDocVariantData;
|
|
const SourceFileName: TFileName);
|
|
var desc,typeName,interfaceName: RawUTF8;
|
|
P: PUTF8Char;
|
|
withinCode: boolean;
|
|
begin
|
|
P := pointer(StringFromFile(SourceFileName));
|
|
if P=nil then
|
|
exit;
|
|
withinCode := false;
|
|
repeat // rough parsing of the .pas unit file to extract /// description
|
|
P := GotoNextNotSpace(P);
|
|
if IdemPChar(P,'IMPLEMENTATION') then
|
|
break; // only the "interface" section is parsed
|
|
if IdemPChar(P,'{$IFDEF ') then begin
|
|
repeat // just ignore any $ifdef ... $endif
|
|
P := GotoNextLine(P);
|
|
if P=nil then exit;
|
|
until IdemPChar(GotoNextNotSpace(P),'{$ENDIF');
|
|
P := GotoNextLine(P);
|
|
P := GotoNextNotSpace(P);
|
|
end;
|
|
if (P[0]='/') and (P[1]='/') and (P[2]='/') then begin
|
|
desc := GetNextLine(GotoNextNotSpace(P+3),P);
|
|
if desc='' then
|
|
break;
|
|
desc[1] := UpCase(desc[1]);
|
|
repeat
|
|
if P=nil then
|
|
exit;
|
|
P := GotoNextNotSpace(P);
|
|
if IdemPChar(P,'{$IFDEF ') then begin
|
|
repeat // just ignore any $ifdef ... $endif
|
|
P := GotoNextLine(P);
|
|
if P=nil then exit;
|
|
until IdemPChar(GotoNextNotSpace(P),'{$ENDIF');
|
|
P := GotoNextLine(P);
|
|
end else
|
|
if (P[0]='/') and (P[1]='/') then begin
|
|
if P[2]='/' then inc(P,3) else inc(P,2);
|
|
P := GotoNextNotSpace(P);
|
|
if P^ in ['$','!'] then begin
|
|
if not withinCode then begin
|
|
withinCode := true;
|
|
desc := desc+#13#10#13#10'----'; // AsciiDoc source code block
|
|
end;
|
|
desc := desc+#13#10;
|
|
inc(P);
|
|
end else
|
|
if P^='-' then begin
|
|
desc := desc+#13#10#13#10'-'+ DESCRIPTION_ITEM_PREFIX;
|
|
inc(P);
|
|
end else
|
|
desc := desc+' ';
|
|
desc := desc+GetNextLine(P,P);
|
|
end else
|
|
break;
|
|
until false;
|
|
if withinCode then begin
|
|
desc := desc+#13#10'----'; // code block should end the description
|
|
withinCode := false;
|
|
end;
|
|
GetNextItem(P,' ',typeName);
|
|
if P=nil then
|
|
exit;
|
|
if typeName<>'' then
|
|
if P^='=' then begin // simple type (record, array, enumeration, set)
|
|
if Descriptions.GetValueIndex(typeName)<0 then begin
|
|
Descriptions.AddValue(typeName,RawUTF8ToVariant(desc));
|
|
if typeName[1]='I' then
|
|
interfaceName := Copy(typeName,2,128) else
|
|
interfaceName := '';
|
|
end;
|
|
end else
|
|
if interfaceName<>'' then
|
|
if IdemPropNameU(typeName,'function') or
|
|
IdemPropNameU(typeName,'procedure') then
|
|
if GetNextFieldProp(P,typeName) then
|
|
Descriptions.AddValue(interfaceName+'.'+typeName,RawUTF8ToVariant(desc));
|
|
end else
|
|
P := GotoNextLine(P);
|
|
until (P=nil);
|
|
end;
|
|
|
|
procedure TWrapperContext.AddUnit(const aUnitName: ShortString;
|
|
addAsProperty: PVariant);
|
|
var unitName: variant;
|
|
i: Integer;
|
|
begin
|
|
if (aUnitName='') or IdemPropName(aUnitName,'mORMot') then
|
|
exit;
|
|
RawUTF8ToVariant(@aUnitName[1],ord(aUnitName[0]),unitName);
|
|
if addAsProperty<>nil then
|
|
_ObjAddProps(['unitName',unitName],addAsProperty^);
|
|
if (self=nil) or (fUnits.SearchItemByValue(unitName)>=0) then
|
|
exit; // already registered
|
|
fUnits.AddItem(unitName);
|
|
if fSourcePath=nil then
|
|
exit;
|
|
for i := 0 to high(fSourcePath) do
|
|
FillDescriptionFromSource(fDescriptions,format('%s%s.pas',[fSourcePath[i], aUnitName]));
|
|
end;
|
|
|
|
function TWrapperContext.ContextFromMethods(int: TInterfaceFactory): variant;
|
|
var m: integer;
|
|
methods: TDocVariantData; // circumvent FPC -O2 memory leak
|
|
begin
|
|
AddUnit(int.InterfaceTypeInfo^.InterfaceUnitName^,nil);
|
|
methods.InitFast;
|
|
for m := 0 to int.MethodsCount-1 do
|
|
methods.AddItem(ContextFromMethod(int.Methods[m]));
|
|
result := variant(methods);
|
|
end;
|
|
|
|
function TWrapperContext.ContextOneProperty(prop: TJSONCustomParserRTTI): variant;
|
|
var typ: pointer;
|
|
l,level: integer;
|
|
begin
|
|
if prop.InheritsFrom(TJSONCustomParserCustom) then begin
|
|
typ := TJSONCustomParserCustom(prop).CustomTypeInfo;
|
|
if (typ=nil) and (prop.ClassType=TJSONCustomParserCustomSimple) then
|
|
case TJSONCustomParserCustomSimple(prop).KnownType of
|
|
ktBinary: typ := TypeInfo(RawUTF8);
|
|
end;
|
|
end else
|
|
typ := nil;
|
|
result := ContextFromInfo(TYPES_SIMPLE[prop.PropertyType],prop.CustomTypeName,typ);
|
|
if prop.PropertyName<>'' then
|
|
_ObjAddProps(['propName',prop.PropertyName,'fullPropName',prop.FullPropertyName],result);
|
|
level := 0;
|
|
for l := 1 to length(prop.FullPropertyName) do
|
|
if prop.FullPropertyName[l]='.' then
|
|
inc(level);
|
|
if level>0 then
|
|
result.nestedIdentation := StringOfChar(' ',level*2);
|
|
case prop.PropertyType of
|
|
ptRecord: begin
|
|
result.isSimple := null;
|
|
result.nestedRecord := _ObjFast(
|
|
['nestedRecord',null,'fields',ContextNestedProperties(prop)]);
|
|
end;
|
|
ptArray: begin
|
|
result.isSimple := null;
|
|
if prop.NestedProperty[0].PropertyName='' then
|
|
result.nestedSimpleArray := ContextOneProperty(prop.NestedProperty[0]) else
|
|
result.nestedRecordArray := _ObjFast(
|
|
['nestedRecordArray',null,'fields',ContextNestedProperties(prop)]);
|
|
end;
|
|
else
|
|
if TDocVariantData(result).GetValueIndex('toVariant')<0 then
|
|
result.isSimple := true else
|
|
result.isSimple := null;
|
|
end;
|
|
end;
|
|
|
|
function TWrapperContext.ContextNestedProperties(rtti: TJSONCustomParserRTTI): variant;
|
|
var i: integer;
|
|
begin
|
|
SetVariantNull(result);
|
|
if rtti.PropertyType in [ptRecord,ptArray] then begin
|
|
TDocVariant.NewFast(result);
|
|
for i := 0 to high(rtti.NestedProperty) do
|
|
TDocVariantData(result).AddItem(ContextOneProperty(rtti.NestedProperty[i]));
|
|
end;
|
|
end;
|
|
|
|
function TWrapperContext.ContextFromInfo(typ: TWrapperType; typName: RawUTF8;
|
|
typInfo: PTypeInfo): variant;
|
|
var typeWrapper: PShortString;
|
|
function VarName(lng: TWrapperLanguage): variant;
|
|
begin
|
|
if TYPES_LANG[lng,typ]<>'' then
|
|
RawUTF8ToVariant(TYPES_LANG[lng,typ],result) else
|
|
if typName='' then
|
|
SetVariantNull(result) else
|
|
RawUTF8ToVariant(typName,result);
|
|
end;
|
|
procedure RegisterType(var list: TDocVariantData);
|
|
var info: variant;
|
|
item: PTypeInfo;
|
|
itemSize: integer;
|
|
objArray: PClassInstance;
|
|
objArrayType: TWrapperType;
|
|
parser: TJSONRecordAbstract;
|
|
begin
|
|
if list.SearchItemByProp('name',typName,false)>=0 then
|
|
exit; // already registered
|
|
if typInfo=nil then
|
|
raise EWrapperContext.CreateUTF8('%.RegisterType(%): no RTTI',[typeWrapper^,typName]);
|
|
case typ of
|
|
wEnum: // full (untrimed) identifier: values[] may be trimmed at mustache level
|
|
info := _JsonFastFmt('{name:?,values:%}',
|
|
[typInfo^.EnumBaseType^.GetEnumNameAllAsJSONArray(false)],[typName]);
|
|
wSet: // full (untrimed) identifier: values[] may be trimmed at mustache level
|
|
info := _JsonFastFmt('{name:?,values:%}',
|
|
[typInfo^.SetEnumType^.GetEnumNameAllAsJSONArray(false)],[typName]);
|
|
wRecord: begin
|
|
parser := TTextWriter.RegisterCustomJSONSerializerFindParser(typInfo,true);
|
|
if (parser<>nil) and (parser.Root<>nil) and (parser.Root.CustomTypeName<>'') then
|
|
info := _ObjFast(['name',typName,'fields',ContextNestedProperties(parser.Root)]);
|
|
end;
|
|
wArray: begin
|
|
item := typInfo^.DynArrayItemType(@itemSize);
|
|
if item=nil then begin
|
|
if itemSize=SizeOf(pointer) then begin
|
|
objArray := TJSONSerializer.RegisterObjArrayFindType(typInfo);
|
|
if objArray<>nil then begin
|
|
// T*ObjArray -> retrieve item information
|
|
if objArray.ItemCreate=cicTSQLRecord then
|
|
objArrayType := wSQLRecord else
|
|
objArrayType := wObject;
|
|
info := ContextFromInfo(objArrayType,'',objArray^.ItemClass.ClassInfo);
|
|
_ObjAddProps(['isObjArray',true],info);
|
|
end;
|
|
end;
|
|
if VarIsEmptyOrNull(info) and DynArrayItemTypeIsSimpleBinary(typName) then
|
|
info := ContextFromInfo(wRawUTF8);
|
|
if VarIsEmptyOrNull(info) then
|
|
info := ContextFromInfo(TYPES_SIZE[itemSize]);
|
|
end else
|
|
info := ContextFromInfo(wUnknown,'',item);
|
|
info.name := typName;
|
|
end;
|
|
end;
|
|
if not VarIsEmptyOrNull(info) then // null e.g. for a record without custom text definition
|
|
list.AddItem(info);
|
|
end;
|
|
var siz, i: integer;
|
|
enum: PEnumType;
|
|
begin
|
|
if typ=wUnknown then begin
|
|
if typInfo=nil then
|
|
raise EWrapperContext.CreateUTF8('No RTTI nor typ for [%]',[typName]);
|
|
typ := TYPES_ORM[typInfo.GetSQLFieldType];
|
|
if typ=wUnknown then begin
|
|
typ := TYPES_SIMPLE[TJSONCustomParserRTTI.TypeInfoToSimpleRTTIType(typInfo)];
|
|
if typ=wUnknown then
|
|
case typInfo^.Kind of
|
|
tkRecord{$ifdef FPC},tkObject{$endif}:
|
|
typ := wRecord;
|
|
tkInterface:
|
|
typ := wInterface;
|
|
else
|
|
raise EWrapperContext.CreateUTF8('Not enough RTTI for [%]',[typInfo^.Name]);
|
|
end;
|
|
end;
|
|
end;
|
|
if typName='' then begin
|
|
if typInfo<>nil then begin
|
|
TypeInfoToQualifiedName(typInfo,typName);
|
|
i := PosExChar('.',typName);
|
|
if i>0 then
|
|
trimcopy(typName,i+1,maxInt,typName); // trim unit name
|
|
end else
|
|
typName := TYPES_LANG[lngDelphi,typ];
|
|
end;
|
|
if (typ=wRecord) and IdemPropNameU(typName,'TGUID') then
|
|
typ := wGUID else
|
|
if (typ=wRecord) and IdemPropNameU(typName,'TServiceCustomAnswer') then
|
|
typ := wCustomAnswer;
|
|
typeWrapper := GetEnumName(TypeInfo(TWrapperType),ord(typ));
|
|
result := _ObjFast([
|
|
'typeWrapper',typeWrapper^, 'typeSource',typName,
|
|
'typeDelphi',VarName(lngDelphi), 'typePascal',VarName(lngPascal),
|
|
'typeCS',VarName(lngCS), 'typeJava',VarName(lngJava),
|
|
'typeTS',VarName(lngTypeScript), 'typeSwagger',VarName(lngSwagger)]);
|
|
if self=nil then
|
|
exit; // no need to have full info if called e.g. from MVC
|
|
if typInfo<>nil then
|
|
case typInfo^.Kind of
|
|
tkClass:
|
|
AddUnit(typInfo^.ClassType^.UnitName,@result);
|
|
end;
|
|
case typ of
|
|
wBoolean,wByte,wWord,wInteger,wCardinal,wInt64,wQWord,wID,wReference,wTimeLog,
|
|
wModTime,wCreateTime,wSingle,wDouble,wRawUTF8,wString:
|
|
; // simple types have no special marshalling
|
|
wDateTime:
|
|
_ObjAddProps(['isDateTime',true,'toVariant','DateTimeToIso8601',
|
|
'fromVariant','Iso8601ToDateTime'],result);
|
|
wRecordVersion:
|
|
_ObjAddProps(['isRecordVersion',true],result);
|
|
wCurrency:
|
|
_ObjAddProps(['isCurrency',true],result);
|
|
wVariant:
|
|
_ObjAddProps(['isVariant',true],result);
|
|
wRawJSON:
|
|
_ObjAddProps(['isJson',true],result);
|
|
wEnum: begin
|
|
_ObjAddProps(['isEnum',true,'toVariant','ord','fromVariant','Variant2'+typName],result);
|
|
if self<>nil then
|
|
RegisterType(fEnumerates);
|
|
end;
|
|
wSet: begin
|
|
enum := typInfo^.SetEnumType;
|
|
if enum=nil then
|
|
siz := 0 else
|
|
siz := enum^.SizeInStorageAsSet;
|
|
_ObjAddProps(['isSet',true,'toVariant',SIZETODELPHI[siz],'fromVariant',typName],result);
|
|
if self<>nil then
|
|
RegisterType(fSets);
|
|
end;
|
|
wGUID:
|
|
_ObjAddProps(['toVariant','GUIDToVariant','fromVariant','VariantToGUID'],result);
|
|
wCustomAnswer:
|
|
_ObjAddProps(['toVariant','HttpBodyToVariant','fromVariant','VariantToHttpBody'],result);
|
|
wRecord: begin
|
|
_ObjAddProps(['isRecord',true],result);
|
|
if typInfo<>nil then begin
|
|
_ObjAddProps(['toVariant',typName+'2Variant','fromVariant','Variant2'+typName],result);
|
|
if self<>nil then
|
|
RegisterType(fRecords);
|
|
end;
|
|
end;
|
|
wSQLRecord:
|
|
if fServer.Model.GetTableIndexInheritsFrom(TSQLRecordClass(typInfo^.ClassType^.ClassType))<0 then
|
|
raise EWrapperContext.CreateUTF8('% should be part of the model',[typName]) else
|
|
_ObjAddProps(['isSQLRecord',true],result);
|
|
wObject: begin
|
|
_ObjAddProps(['isObject',true],result);
|
|
if typInfo<>nil then
|
|
_ObjAddProps(['toVariant','ObjectToVariant','fromVariant',typName+'.CreateFromVariant'],result);
|
|
end;
|
|
wArray: begin
|
|
_ObjAddProps(['isArray',true],result);
|
|
if typInfo<>nil then begin
|
|
_ObjAddProps(['toVariant',typName+'2Variant','fromVariant','Variant2'+typName],result);
|
|
if self<>nil then
|
|
RegisterType(fArrays);
|
|
end;
|
|
end;
|
|
wBlob:
|
|
_ObjAddProps(['isBlob',true,
|
|
'toVariant','BlobToVariant','fromVariant','VariantToBlob'],result);
|
|
wInterface:
|
|
_ObjAddProps(['isInterface',true],result);
|
|
else raise EWrapperContext.CreateUTF8('Unexpected type % (%) for [%]',
|
|
[typeWrapper^,ord(typ),typName]);
|
|
end;
|
|
end;
|
|
|
|
function TWrapperContext.Context: variant;
|
|
procedure AddDescription(var list: TDocVariantData; const propName,descriptionName: RawUTF8);
|
|
var i: integer;
|
|
propValue: RawUTF8;
|
|
begin
|
|
if (list.Kind<>dvArray) or (fDescriptions.Count=0) then
|
|
exit;
|
|
for i := 0 to list.Count-1 do
|
|
with _Safe(list.Values[i])^ do
|
|
if GetAsRawUTF8(propName,propValue) then
|
|
AddValue(descriptionName,fDescriptions.GetValueOrNull(propValue));
|
|
end;
|
|
var s: integer;
|
|
authClass: TClass;
|
|
begin
|
|
// compute the Model information as JSON
|
|
result := _ObjFast(['time',NowToString, 'year',CurrentYear,
|
|
'mORMotVersion',SYNOPSE_FRAMEWORK_VERSION,
|
|
'exeVersion',VarStringOrNull(StringToUTF8(ExeVersion.Version.DetailedOrVoid)),
|
|
'exeInfo',ExeVersion.Version.VersionInfo,
|
|
'exeName',ExeVersion.ProgramName,
|
|
'hasorm',fORM.Count>0, 'orm',variant(fORM),
|
|
'soa',fSOA]);
|
|
if fServer<>nil then
|
|
_ObjAddProps(['root',fServer.Model.Root],result);
|
|
if fHasAnyRecord then
|
|
result.ORMWithRecords := true;
|
|
if fRecords.Count>0 then begin
|
|
AddDescription(fRecords,'name','recordDescription');
|
|
result.records := variant(fRecords);
|
|
result.withRecords := true;
|
|
result.withHelpers := true;
|
|
end;
|
|
if fEnumerates.Count>0 then begin
|
|
AddDescription(fEnumerates,'name','enumDescription');
|
|
result.enumerates := variant(fEnumerates);
|
|
result.withEnumerates := true;
|
|
result.withHelpers := true;
|
|
end;
|
|
if fSets.Count>0 then begin
|
|
AddDescription(fSets,'name','setDescription');
|
|
result.sets := variant(fSets);
|
|
result.withsets := true;
|
|
result.withHelpers := true;
|
|
end;
|
|
if fArrays.Count>0 then begin
|
|
result.arrays := variant(fArrays);
|
|
result.withArrays := true;
|
|
result.withHelpers := true;
|
|
end;
|
|
if fUnits.Count>0 then
|
|
result.units := variant(fUnits);
|
|
// add the first registered supported authentication class type as default
|
|
if fServer<>nil then
|
|
for s := 0 to fServer.AuthenticationSchemesCount-1 do begin
|
|
authClass := fServer.AuthenticationSchemes[s].ClassType;
|
|
if (authClass=TSQLRestServerAuthenticationDefault) or
|
|
(authClass=TSQLRestServerAuthenticationNone) then begin
|
|
result.authClass := authClass.ClassName;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ContextFromModel(aServer: TSQLRestServer;
|
|
const aSourcePath, aDescriptions: TFileName): variant;
|
|
begin
|
|
with TWrapperContext.CreateFromModel(aServer,aSourcePath,aDescriptions) do
|
|
try
|
|
result := Context;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
function ContextFromMethod(const method: TServiceMethod): variant;
|
|
begin
|
|
result := TWrapperContext(nil).ContextFromMethod(method);
|
|
end;
|
|
|
|
function ContextFromMethods(int: TInterfaceFactory): variant;
|
|
begin
|
|
result := TWrapperContext(nil).ContextFromMethods(int);
|
|
end;
|
|
|
|
|
|
procedure WrapperMethod(Ctxt: TSQLRestServerURIContext; const Path: array of TFileName;
|
|
const SourcePath, Descriptions: TFileName);
|
|
var root, templateName, templateTitle, savedName, templateExt, unitName, template,
|
|
result, host, uri, head: RawUTF8;
|
|
context: variant;
|
|
SR: TSearchRec;
|
|
i, templateFound, port: integer;
|
|
begin // URI is e.g. GET http://localhost:888/root/wrapper/Delphi/UnitName.pas
|
|
if (Ctxt.Method<>mGET) or (high(Path)<0) then
|
|
exit;
|
|
templateFound := -1;
|
|
for i := 0 to high(Path) do
|
|
if FindFirst(Path[i]+PathDelim+'*.mustache',faAnyFile,SR)=0 then begin
|
|
templateFound := i;
|
|
break;
|
|
end;
|
|
if templateFound<0 then
|
|
Ctxt.Error('Please copy some .mustache files in the expected folder (e.g. %)',[Path[0]]) else
|
|
try
|
|
context := ContextFromModel(Ctxt.Server,SourcePath,Descriptions);
|
|
context.uri := Ctxt.URIWithoutSignature;
|
|
if llfHttps in Ctxt.Call^.LowLevelFlags then begin
|
|
context.protocol := 'https';
|
|
context.https := true;
|
|
end else
|
|
context.protocol := 'http';
|
|
host := Ctxt.InHeader['host'];
|
|
if host<>'' then
|
|
context.host := host;
|
|
port := GetInteger(pointer(split(host,':',host)));
|
|
if port=0 then
|
|
port := 80;
|
|
context.port := port;
|
|
if IdemPropNameU(Ctxt.URIBlobFieldName,'context') then begin
|
|
Ctxt.ReturnsJson(context,200,{304=}true,twNone,{humanreadable=}true);
|
|
exit;
|
|
end;
|
|
root := Ctxt.Server.Model.Root;
|
|
if Ctxt.URIBlobFieldName='' then begin
|
|
result := '<html><title>mORMot Wrappers</title>'+
|
|
'<body style="font-family:verdana;"><h1>Generated Code/Doc Wrappers</h1>'+
|
|
'<hr><h2>Available Templates:</h2><ul>';
|
|
repeat
|
|
Split(StringToUTF8(SR.Name),'.',templateName,templateExt);
|
|
templateTitle := templateName;
|
|
i := PosExChar('-',templateName);
|
|
if i>0 then begin
|
|
SetLength(templateTitle,i-1);
|
|
savedName := copy(templateName,i+1,maxInt);
|
|
end else
|
|
savedName := 'mORMotClient';
|
|
Split(templateExt,'.',templateExt);
|
|
uri := FormatUTF8('<a href=/%/wrapper/%/%.%',
|
|
[root,templateName,savedName,templateExt]);
|
|
result := FormatUTF8(
|
|
'%<li><b>%</b><br><i>%.%</i> - %>download as file</a> - '+
|
|
'%.txt>see as text</a> - %.mustache>see template</a></li><br>',
|
|
[result,templateTitle,savedName,templateExt,uri,uri,uri]);
|
|
until FindNext(SR)<>0;
|
|
result := FormatUTF8('%</ul><p>You can also retrieve the corresponding '+
|
|
'<a href=/%/wrapper/context>template context</a>.<hr><p>Generated by a '+
|
|
'<a href=http://mormot.net>Synopse <i>mORMot</i> '+SYNOPSE_FRAMEWORK_VERSION+
|
|
'</a> server.',[result,root]);
|
|
Ctxt.Returns(result,HTTP_SUCCESS,HTML_CONTENT_TYPE_HEADER);
|
|
exit;
|
|
end;
|
|
finally
|
|
FindClose(SR);
|
|
end;
|
|
Split(Ctxt.URIBlobFieldName,'/',templateName,unitName);
|
|
Split(unitName,'.',unitName,templateExt);
|
|
if PosExChar('.',templateExt)>0 then begin // see as text
|
|
if IdemPropNameU(Split(templateExt,'.',templateExt),'mustache') then
|
|
unitName := ''; // force return .mustache
|
|
head := TEXT_CONTENT_TYPE_HEADER;
|
|
end else // download as file
|
|
head := HEADER_CONTENT_TYPE+'application/'+LowerCase(templateExt);
|
|
templateName := templateName+'.'+templateExt+'.mustache';
|
|
template := AnyTextFileToRawUTF8(
|
|
Path[templateFound]+PathDelim+UTF8ToString(templateName),true);
|
|
if template='' then begin
|
|
Ctxt.Error(templateName,HTTP_NOTFOUND);
|
|
exit;
|
|
end;
|
|
if unitName='' then
|
|
result := template else begin
|
|
context.templateName := templateName;
|
|
context.filename := unitName;
|
|
result := TSynMustache.Parse(template).Render(context,nil,
|
|
TSynMustache.HelpersGetStandardList,nil,true);
|
|
end;
|
|
Ctxt.Returns(result,HTTP_SUCCESS,head);
|
|
end;
|
|
|
|
function WrapperFromModel(aServer: TSQLRestServer; const aMustacheTemplate,
|
|
aFileName: RawUTF8; aPort: integer; aHelpers: TSynMustacheHelpers;
|
|
aContext: PVariant; const aDescriptions: TFileName): RawUTF8;
|
|
var context: variant;
|
|
begin // no context.uri nor context.host here
|
|
context := ContextFromModel(aServer,'',aDescriptions);
|
|
with _Safe(context)^ do begin
|
|
if aPort<>0 then
|
|
I['port'] := aPort;
|
|
U['filename'] := aFileName;
|
|
if aContext<>nil then begin
|
|
AddFrom(aContext^);
|
|
aContext^ := context;
|
|
end;
|
|
end;
|
|
if aHelpers=nil then
|
|
aHelpers := TSynMustache.HelpersGetStandardList;
|
|
result := TSynMustache.Parse(aMustacheTemplate).Render(context,nil,aHelpers,nil,true);
|
|
end;
|
|
|
|
function WrapperFakeServer(const aTables: array of TSQLRecordClass; const aRoot: RawUTF8;
|
|
const aSharedServices: array of TGUID; const aSharedServicesContract: array of RawUTF8;
|
|
aResultAsJSONObjectWithoutResult: boolean): TSQLRestServerFullMemory;
|
|
var contract: RawUTF8;
|
|
fake: IInterface;
|
|
i: integer;
|
|
begin
|
|
result := TSQLRestServerFullMemory.CreateWithOwnModel(aTables,false,aRoot);
|
|
for i := 0 to high(aSharedServices) do begin
|
|
if i<=high(aSharedServicesContract) then
|
|
contract := aSharedServicesContract[i] else
|
|
contract := '';
|
|
result.ServiceDefine(TInterfaceStub.Create(aSharedServices[i], fake).
|
|
LastInterfacedObjectFake,[aSharedServices[i]],contract).
|
|
ResultAsJSONObjectWithoutResult := aResultAsJSONObjectWithoutResult;
|
|
end;
|
|
end;
|
|
|
|
function WrapperForPublicAPI(const aTables: array of TSQLRecordClass;
|
|
const aRoot, aMustacheTemplate, aFileName: RawUTF8; const aSharedServices: array of TGUID;
|
|
const aSharedServicesContract: array of RawUTF8; aResultAsJSONObjectWithoutResult: boolean;
|
|
aPort: integer; aHelpers: TSynMustacheHelpers; aContext: PVariant; const aDescriptions: TFileName): RawUTF8;
|
|
var server: TSQLRestServer;
|
|
begin
|
|
server := WrapperFakeServer(aTables,aRoot,aSharedServices,aSharedServicesContract,
|
|
aResultAsJSONObjectWithoutResult);
|
|
try
|
|
result := WrapperFromModel(server,aMustacheTemplate,aFileName,aPort,aHelpers,
|
|
aContext,aDescriptions);
|
|
finally
|
|
server.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ TWrapperMethodHook }
|
|
|
|
type
|
|
TWrapperMethodHook = class(TPersistent)
|
|
public
|
|
SearchPath: TFileNameDynArray;
|
|
SourcePath: TFileName;
|
|
published
|
|
procedure Wrapper(Ctxt: TSQLRestServerURIContext);
|
|
end;
|
|
|
|
procedure TWrapperMethodHook.Wrapper(Ctxt: TSQLRestServerURIContext);
|
|
begin
|
|
WrapperMethod(Ctxt,SearchPath,SourcePath);
|
|
end;
|
|
|
|
procedure ComputeSearchPath(const Path: array of TFileName;
|
|
out SearchPath: TFileNameDynArray);
|
|
var i: integer;
|
|
begin
|
|
if length(Path)=0 then begin
|
|
SetLength(SearchPath,1);
|
|
SearchPath[0] := ExeVersion.ProgramFilePath; // use .exe path
|
|
end else begin
|
|
SetLength(SearchPath,length(Path));
|
|
for i := 0 to high(Path) do
|
|
SearchPath[i] := ExpandFileName(Path[i]); // also convert \ if needed on FPC
|
|
end;
|
|
end;
|
|
|
|
procedure AddToServerWrapperMethod(Server: TSQLRestServer; const Path: array of TFileName;
|
|
const SourcePath: TFileName);
|
|
var hook: TWrapperMethodHook;
|
|
begin
|
|
if Server=nil then
|
|
exit;
|
|
hook := TWrapperMethodHook.Create;
|
|
Server.PrivateGarbageCollector.Add(hook); // Server.Free will call hook.Free
|
|
ComputeSearchPath(Path,hook.SearchPath);
|
|
hook.SourcePath := SourcePath;
|
|
Server.ServiceMethodRegisterPublishedMethods('',hook);
|
|
Server.ServiceMethodByPassAuthentication('wrapper');
|
|
end;
|
|
|
|
|
|
function FindTemplate(const TemplateName: TFileName; const Path: array of TFileName): TFileName;
|
|
var SearchPath: TFileNameDynArray;
|
|
i: integer;
|
|
begin
|
|
ComputeSearchPath(Path,SearchPath);
|
|
for i := 0 to High(SearchPath) do begin
|
|
result := IncludeTrailingPathDelimiter(SearchPath[i])+TemplateName;
|
|
if FileExists(result) then
|
|
exit;
|
|
end;
|
|
result := '';
|
|
end;
|
|
|
|
procedure ComputeFPCServerUnit(Server: TSQLRestServer; const Path: array of TFileName;
|
|
DestFileName: TFileName);
|
|
var TemplateName: TFileName;
|
|
begin
|
|
TemplateName := FindTemplate('FPCServer-mORMotServer.pas.mustache',Path);
|
|
if TemplateName='' then
|
|
exit;
|
|
if DestFileName='' then
|
|
DestFileName := 'mORMotServer.pas' else
|
|
if DestFileName[1]=PathDelim then
|
|
DestFileName := ExtractFilePath(TemplateName)+DestFileName;
|
|
FileFromString(WrapperFromModel(Server,AnyTextFileToRawUTF8(TemplateName,true),
|
|
StringToUTF8(ExtractFileName(DestFileName)),0),DestFileName);
|
|
end;
|
|
|
|
procedure ComputeFPCInterfacesUnit(const Path: array of TFileName;
|
|
DestFileName: TFileName);
|
|
const TEMPLATE_NAME = 'FPC-mORMotInterfaces.pas.mustache';
|
|
var TemplateName: TFileName;
|
|
ctxt: variant;
|
|
begin
|
|
TemplateName := FindTemplate(TEMPLATE_NAME,Path);
|
|
if TemplateName='' then
|
|
exit;
|
|
if DestFileName='' then
|
|
DestFileName := 'mORMotInterfaces.pas' else
|
|
if DestFileName[1]=PathDelim then
|
|
DestFileName := ExtractFilePath(TemplateName)+DestFileName;
|
|
with TWrapperContext.CreateFromUsedInterfaces('') do
|
|
try
|
|
ctxt := Context;
|
|
finally
|
|
Free;
|
|
end;
|
|
ctxt.fileName := GetFileNameWithoutExt(ExtractFileName(DestFileName));
|
|
FileFromString(TSynMustache.Parse(AnyTextFileToRawUTF8(TemplateName,true)).
|
|
Render(ctxt,nil,nil,nil,true),DestFileName);
|
|
end;
|
|
|
|
{$ifdef ISDELPHI20062007}
|
|
{$WARNINGS OFF} // circument Delphi 2007 false positive warning
|
|
{$endif}
|
|
|
|
function GenerateAsynchServices(const services: array of TGUID;
|
|
const queries: array of TClass; const units: array of const;
|
|
const additionalcontext: array of const; Template, FileName, ProjectName,
|
|
CallType, CallFunction, Key, KeyType, ExceptionType: RawUTF8;
|
|
DefaultDelay: integer; const CustomDelays: array of const): RawUTF8;
|
|
var
|
|
server: TSQLRestServerFullMemory;
|
|
stub: IInvokable;
|
|
context: variant;
|
|
service, method: PDocVariantData;
|
|
pas, intf, meth: RawUTF8;
|
|
delay: Int64;
|
|
i: integer;
|
|
begin
|
|
result := '';
|
|
if high(services) < 0 then
|
|
exit;
|
|
if FileName = '' then
|
|
FileName := 'ServicesAsynch';
|
|
if CallType = '' then
|
|
CallType := 'TBlockingProcessPoolCall';
|
|
if ExceptionType = '' then
|
|
ExceptionType := 'EServiceException';
|
|
server := TSQLRestServerFullMemory.CreateWithOwnModel([]);
|
|
try
|
|
for i := 0 to high(services) do
|
|
server.ServiceDefine(TInterfaceStub.Create(services[i], stub).
|
|
LastInterfacedObjectFake, [services[i]]);
|
|
context := ContextFromModel(server);
|
|
_Safe(context)^.AddNameValuesToObject(['filename', FileName,
|
|
'projectname', ProjectName, 'exeName', ExeVersion.ProgramName,
|
|
'User', ExeVersion.User, 'calltype', CallType, 'callfunction', CallFunction,
|
|
'exception', ExceptionType, 'defaultdelay', DefaultDelay]);
|
|
if high(units) >= 0 then
|
|
_Safe(context.units)^.AddItems(units);
|
|
if Key <> '' then
|
|
_Safe(context)^.AddNameValuesToObject(['asynchkey', Key, 'asynchkeytype', KeyType]);
|
|
_Safe(context)^.AddNameValuesToObject(additionalcontext);
|
|
for i := 0 to high(services) do
|
|
if i < length(queries) then begin
|
|
intf := ToUTF8(TInterfaceFactory.GUID2TypeInfo(services[i])^.Name);
|
|
if _Safe(context.soa.services)^.GetDocVariantByProp(
|
|
'interfaceName', intf, false, service) then
|
|
service^.AddValue('query', queries[i].ClassName)
|
|
else
|
|
raise EWrapperContext.CreateUTF8('CustomDelays: unknown %', [intf]);
|
|
end;
|
|
i := 0;
|
|
while i + 2 <= high(CustomDelays) do begin
|
|
if VarRecToUTF8IsString(CustomDelays[i], intf) and
|
|
VarRecToUTF8IsString(CustomDelays[i + 1], meth) and
|
|
VarRecToInt64(CustomDelays[i + 2], delay) then
|
|
if _Safe(context.soa.services)^.GetDocVariantByProp(
|
|
'interfaceName',intf, false, service) and
|
|
service^.GetAsDocVariantSafe('methods')^.GetDocVariantByProp(
|
|
'methodName', meth, false, method) then
|
|
method^.I['asynchdelay'] := delay
|
|
else
|
|
raise EWrapperContext.CreateUTF8('CustomDelays: unknown %.%', [intf, meth]);
|
|
inc(i, 3);
|
|
end;
|
|
pas := TSynMustache.Parse(Template).Render(context, nil, TSynMustache.HelpersGetStandardList);
|
|
result := StringReplaceAll(pas, ['();', ';', '():', ':']);
|
|
//FileFromString(_Safe(context)^.ToJSON('','',jsonUnquotedPropName),FileName+'.json');
|
|
finally
|
|
server.Free;
|
|
end;
|
|
end;
|
|
|
|
{$ifdef ISDELPHI20062007}
|
|
{$WARNINGS ON} // circument Delphi 2007 false positive warning
|
|
{$endif}
|
|
|
|
{ TServiceClientCommandLine }
|
|
|
|
type
|
|
/// a class implementing ExecuteFromCommandLine()
|
|
TServiceClientCommandLine = class(TSynPersistent)
|
|
protected
|
|
fExe: RawUTF8;
|
|
fOptions: TServiceClientCommandLineOptions;
|
|
fServices: array of TInterfaceFactory;
|
|
fDescriptions: TDocVariantData;
|
|
fOnCall: TOnCommandLineCall;
|
|
procedure ToConsole(const Fmt: RawUTF8; const Args: array of const;
|
|
Color: TConsoleColor = ccLightGray; NoLineFeed: boolean = false);
|
|
function Find(const name: RawUTF8; out service: TInterfaceFactory): boolean;
|
|
procedure WriteDescription(desc: RawUTF8; color: TConsoleColor; firstline: boolean);
|
|
procedure ShowHelp;
|
|
procedure ShowAllServices;
|
|
procedure ShowService(service: TInterfaceFactory);
|
|
procedure ShowMethod(service: TInterfaceFactory; method: PServiceMethod);
|
|
procedure ExecuteMethod(service: TInterfaceFactory; method: PServiceMethod;
|
|
firstparam: integer);
|
|
public
|
|
constructor Create(const aServices: array of TGUID;
|
|
const aOnCall: TOnCommandLineCall;
|
|
const aDescriptions: TFileName); reintroduce;
|
|
procedure Execute;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{$I-}
|
|
|
|
procedure TServiceClientCommandLine.ToConsole(const Fmt: RawUTF8;
|
|
const Args: array of const; Color: TConsoleColor; NoLineFeed: boolean);
|
|
begin
|
|
ConsoleWrite(FormatUTF8(Fmt, Args), Color, NoLineFeed, cloNoColor in fOptions);
|
|
end;
|
|
|
|
function TServiceClientCommandLine.Find(const name: RawUTF8;
|
|
out service: TInterfaceFactory): boolean;
|
|
var
|
|
s: integer;
|
|
begin
|
|
for s := 0 to high(fServices) do
|
|
if IdemPropNameU(fServices[s].InterfaceURI, name) then begin
|
|
service := fServices[s];
|
|
result := true;
|
|
exit;
|
|
end;
|
|
result := false;
|
|
end;
|
|
|
|
procedure TServiceClientCommandLine.WriteDescription(desc: RawUTF8;
|
|
color: TConsoleColor; firstline: boolean);
|
|
var
|
|
line: RawUTF8;
|
|
P: PUTF8Char;
|
|
i, j, k, l: integer;
|
|
begin
|
|
if not(cloNoColor in fOptions) then
|
|
TextColor(color);
|
|
if firstline then
|
|
SetLength(desc, PosExChar(#13, desc) - 1);
|
|
if desc = '' then
|
|
exit;
|
|
P := pointer(desc);
|
|
repeat
|
|
line := GetNextLine(P,P);
|
|
if line = '' then
|
|
continue;
|
|
if line = '----' then begin
|
|
if not(cloNoColor in fOptions) then
|
|
TextColor(ccBrown);
|
|
end
|
|
else begin
|
|
line := StringReplaceAll(line, ['`','', '<<','', '>>','']);
|
|
i := 1;
|
|
repeat
|
|
j := PosEx('[', line, i);
|
|
if j = 0 then
|
|
break;
|
|
k := PosEx('](', line, j + 1);
|
|
if k = 0 then
|
|
break;
|
|
l := PosEx(')', line, k + 2);
|
|
if l = 0 then
|
|
break;
|
|
delete(line, k, l - k + 1);
|
|
delete(line, j, 1);
|
|
i := k;
|
|
until false;
|
|
writeln(line);
|
|
end;
|
|
until P = nil;
|
|
end;
|
|
|
|
procedure TServiceClientCommandLine.ShowHelp;
|
|
begin
|
|
ToConsole('% %'#13#10, [fExe, ExeVersion.Version.DetailedOrVoid], ccLightGreen);
|
|
ToConsole(EXECUTEFROMCOMMANDLINEHELP, [fExe, fExe, fExe, fExe]);
|
|
end;
|
|
|
|
procedure TServiceClientCommandLine.ShowAllServices;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to high(fServices) do begin
|
|
ToConsole('% %', [fExe, fServices[i].InterfaceURI], ccWhite);
|
|
WriteDescription(fDescriptions.U[fServices[i].InterfaceName], ccLightGray, true);
|
|
end;
|
|
end;
|
|
|
|
procedure TServiceClientCommandLine.ShowService(service: TInterfaceFactory);
|
|
var
|
|
m: integer;
|
|
begin
|
|
ToConsole('% %', [fExe, service.InterfaceURI], ccWhite);
|
|
WriteDescription(fDescriptions.U[service.InterfaceName], ccLightGray, false);
|
|
for m := 0 to service.MethodsCount - 1 do
|
|
with service.Methods[m] do begin
|
|
ToConsole('% % % [parameters]', [fExe, service.InterfaceURI, URI], ccWhite);
|
|
WriteDescription(fDescriptions.U[InterfaceDotMethodName], ccLightGray, true);
|
|
end;
|
|
end;
|
|
|
|
procedure TServiceClientCommandLine.ShowMethod(service: TInterfaceFactory;
|
|
method: PServiceMethod);
|
|
|
|
procedure Arguments(input: boolean);
|
|
const IN_OUT: array[boolean] of RawUTF8 = ('OUT', ' IN');
|
|
var
|
|
i: integer;
|
|
line, typ: RawUTF8;
|
|
begin
|
|
ToConsole('%', [IN_OUT[input]], ccDarkGray, {nolinefeed=}true);
|
|
if not input and method^.ArgsResultIsServiceCustomAnswer then
|
|
line := ' is undefined'
|
|
else begin
|
|
line := ' { ';
|
|
i := 0;
|
|
while method^.ArgNext(i, input) do
|
|
with method^.Args[i] do begin
|
|
typ := TYPES_LANG[lngCS, TYPES_SOA[ValueType]];
|
|
if typ = '' then
|
|
ShortStringToAnsi7String(ArgTypeName^, typ);
|
|
line := FormatUTF8('%"%":%, ', [line, ParamName^, typ]);
|
|
end;
|
|
i := length(line);
|
|
line[i - 1] := ' ';
|
|
line[i] := '}';
|
|
end;
|
|
ToConsole('%', [line], ccDarkGray);
|
|
end;
|
|
|
|
begin
|
|
ToConsole('% % % [parameters]', [fExe, service.InterfaceURI, method.URI], ccWhite);
|
|
WriteDescription(fDescriptions.U[method.InterfaceDotMethodName], ccLightGray, false);
|
|
if method.ArgsInputValuesCount <> 0 then
|
|
Arguments({input=}true);
|
|
if method.ArgsOutputValuesCount <> 0 then
|
|
Arguments({input=}false);
|
|
end;
|
|
|
|
procedure TServiceClientCommandLine.ExecuteMethod(service: TInterfaceFactory;
|
|
method: PServiceMethod; firstparam: integer);
|
|
var
|
|
params, result: RawUTF8;
|
|
i: integer;
|
|
cc: TConsoleColor;
|
|
call: TSQLRestURIParams;
|
|
begin
|
|
call.Init;
|
|
if cloPipe in fOptions then
|
|
call.InBody := ConsoleReadBody
|
|
else begin
|
|
for i := firstparam to ParamCount do
|
|
params := FormatUTF8('% %', [params, ParamStr(i)]);
|
|
//writeln(params); // for debugging
|
|
call.InBody := method^.ArgsCommandLineToObject(pointer(params), {input=}true, true);
|
|
end;
|
|
// writeln(call.InBody); exit;
|
|
if [cloVerbose, cloHeaders] * fOptions <> [] then
|
|
ToConsole('POST %', [method.InterfaceDotMethodName], ccLightGray);
|
|
if cloVerbose in fOptions then
|
|
ToConsole('%', [call.InBody], ccLightBlue);
|
|
if not Assigned(fOnCall) then
|
|
raise EServiceException.CreateUTF8('No Client available to call %',
|
|
[method.InterfaceDotMethodName]);
|
|
fOnCall(fOptions, service, method, call); // will set URI + Bearer
|
|
if [cloVerbose, cloHeaders] * fOptions <> [] then
|
|
ToConsole('HTTP %'#13#10'%', [call.OutStatus, call.OutHead], ccLightGray);
|
|
if (call.OutBody <> '') and (call.OutBody[1] = '[') then
|
|
call.OutBody := method^.ArgsArrayToObject(pointer(call.OutBody), false);
|
|
if cloNoBody in fOptions then
|
|
FormatUTF8('% bytes received', [length(call.OutBody)], result)
|
|
else if (cloNoExpand in fOptions) or not call.OutBodyTypeIsJson then
|
|
result := call.OutBody
|
|
else
|
|
JSONBufferReformat(pointer(call.OutBody), result);
|
|
cc := ccWhite;
|
|
if not StatusCodeIsSuccess(call.OutStatus) then
|
|
cc := ccLightRed;
|
|
ToConsole('%', [result], cc, {nofeed=}true);
|
|
end;
|
|
|
|
constructor TServiceClientCommandLine.Create(const aServices: array of TGUID;
|
|
const aOnCall: TOnCommandLineCall; const aDescriptions: TFileName);
|
|
var
|
|
desc: RawByteString;
|
|
n, s, i: integer;
|
|
begin
|
|
inherited Create;
|
|
fExe := {$ifndef MSWINDOWS}'./' + {$endif} ExeVersion.ProgramName;
|
|
n := length(aServices);
|
|
SetLength(fServices, n);
|
|
s := 0;
|
|
for i := 0 to n - 1 do begin
|
|
fServices[s] := TInterfaceFactory.Get(aServices[i]);
|
|
if fServices[s] <> nil then
|
|
inc(s);
|
|
end;
|
|
if s = 0 then
|
|
raise EServiceException.Create('ExecuteFromCommandLine: no service - did you call RegisterInterfaces()?');
|
|
if s <> n then
|
|
SetLength(fServices, s);
|
|
fOnCall := aOnCall;
|
|
TDocVariant.NewFast([@fDescriptions]);
|
|
if aDescriptions <> '' then
|
|
desc := StringFromFile(aDescriptions);
|
|
if desc = '' then
|
|
ResourceSynLZToRawByteString(WRAPPER_RESOURCENAME, desc);
|
|
if desc <> '' then
|
|
fDescriptions.InitJSONInPlace(pointer(desc), JSON_OPTIONS_FAST);
|
|
end;
|
|
|
|
procedure TServiceClientCommandLine.Execute;
|
|
var
|
|
p: array[0..3] of RawUTF8;
|
|
a: PUTF8Char;
|
|
i, j, n, first: integer;
|
|
s: TInterfaceFactory;
|
|
m: PServiceMethod;
|
|
begin
|
|
first := 3;
|
|
n := 0;
|
|
for i := 1 to ParamCount do begin
|
|
StringToUTF8(ParamStr(i), p[n]);
|
|
a := pointer(p[n]);
|
|
if a^ in ['-', '/'] then begin
|
|
inc(a);
|
|
if a^ = '-' then
|
|
inc(a);
|
|
j := PTypeInfo(TypeInfo(TServiceClientCommandLineOptions))^.SetEnumType^.
|
|
GetEnumNameTrimedValue(a);
|
|
if j >= 0 then begin
|
|
SetBitPtr(@fOptions, j);
|
|
if n < high(p) then
|
|
inc(first);
|
|
continue;
|
|
end;
|
|
raise EServiceException.CreateUTF8('%.Execute: unknown option [%]', [self, p[n]]);
|
|
end;
|
|
if n < high(p) then
|
|
inc(n);
|
|
end;
|
|
case n of
|
|
0:
|
|
ShowHelp;
|
|
1:
|
|
if Find(p[0], s) then
|
|
ShowService(s)
|
|
else
|
|
ShowAllServices;
|
|
else
|
|
if Find(p[0], s) then begin
|
|
m := s.FindMethod(p[1]);
|
|
if m = nil then
|
|
ShowService(s)
|
|
else
|
|
if IdemPropNameU(p[2], 'help') or
|
|
((m^.ArgsInputValuesCount <> 0) and (PosExChar('=', p[2]) = 0)) then
|
|
ShowMethod(s, m)
|
|
else
|
|
ExecuteMethod(s, m, first);
|
|
end
|
|
else
|
|
ShowAllServices;
|
|
end;
|
|
ToConsole('', [], ccDarkGray);
|
|
end;
|
|
|
|
destructor TServiceClientCommandLine.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{$I+}
|
|
|
|
procedure ExecuteFromCommandLine(const aServices: array of TGUID;
|
|
const aOnCall: TOnCommandLineCall; const aDescriptions: TFileName);
|
|
begin
|
|
with TServiceClientCommandLine.Create(aServices, aOnCall, aDescriptions) do
|
|
try
|
|
try
|
|
Execute;
|
|
except
|
|
on E: Exception do
|
|
ConsoleShowFatalException(E, {waitforkey=}false);
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|