source upload

contrib/mORMot/SQLite3/Samples/26 - RESTful ORM/RESTClient.dpr

@@ -0,0 +1,19 @@
+program RESTClient;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  {$ifdef FPC}
+  Interfaces,
+  {$endif}
+  RestClientMain in 'RestClientMain.pas' {MainForm};
+
+{$ifndef FPC}
+{$R *.res}
+{$endif FPC}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TMainForm, MainForm);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/26 - RESTful ORM/RESTData.pas

@@ -0,0 +1,96 @@
+unit RESTData;
+
+{$I Synopse.inc} // define HASINLINE and some FPC-specific options
+
+interface
+
+uses
+  SynCommons,
+  SynTable, // for TSynValidate
+  mORMot;
+
+type
+  TSQLRecordWithModTimeAndMetaData = class(TSQLRecord)
+  protected
+    fCreated: TCreateTime;
+    fModified: TModTime;
+    fMetaData: variant;
+  published
+    property Modified: TModTime read fModified write fModified;
+    property Created: TCreateTime read fCreated write fCreated;
+    property MetaData: variant read fMetaData write fMetaData;
+  end;
+
+  TSQLNoteKind = class(TSQLRecordWithModTimeAndMetaData)
+  protected
+    fName: RawUTF8;
+  public
+    class procedure InitializeTable(Server: TSQLRestServer;
+      const FieldName: RawUTF8; Options: TSQLInitializeTableOptions); override;
+  published
+    property Name: RawUTF8 read fName write fName stored AS_UNIQUE;
+  end;
+
+  TSQLNote = class(TSQLRecordWithModTimeAndMetaData)
+  protected
+    fIdent: RawUTF8;
+    fKind: TSQLNoteKind;
+    fParent: TSQLNote;
+  published
+    property Ident: RawUTF8 read fIdent write fIdent;
+    property Kind: TSQLNoteKind read fKind write fKind;
+    property Parent: TSQLNote read fParent write fParent;
+  end;
+
+  TSQLNoteFile = class(TSQLRecordWithModTimeAndMetaData)
+  protected
+    fFileName: RawUTF8;
+    fNote: TSQLNote;
+  published
+    property FileName: RawUTF8 read fFileName write fFileName;
+    property Note: TSQLNote read fNote write fNote;
+  end;
+
+  TSQLUser = class(TSQLAuthUser)
+  protected
+    fMetaData: variant;
+  published
+    property MetaData: variant read fMetaData write fMetaData;
+  end;
+
+
+function DataModel(const RootURI: RawUTF8): TSQLModel;
+
+const
+  HTTP_PORT = '888'; 
+
+  
+implementation
+
+function DataModel(const RootURI: RawUTF8): TSQLModel;
+begin
+  result := TSQLModel.Create(
+    [TSQLAuthGroup,TSQLUser,TSQLNoteKind,TSQLNote,TSQLNoteFile],
+    RootURI);
+  TSQLNoteKind.AddFilterOrValidate('Name',TSynValidateText.Create('{MinLength:3}'));
+  TSQLNote.AddFilterOrValidate('Ident',TSynValidateText.Create('{MinLength:3}'));
+  TSQLNoteFile.AddFilterOrValidate('FileName',TSynValidateNonVoidText.Create);
+  TSQLNoteFile.AddFilterOrValidate('FileName',TSynValidateText.Create('{MaxPunctCount:0}'));
+end;
+
+{ TSQLNoteKind }
+
+class procedure TSQLNoteKind.InitializeTable(Server: TSQLRestServer;
+  const FieldName: RawUTF8; Options: TSQLInitializeTableOptions);
+var Kind: TSQLNoteKind;
+begin
+  inherited;
+  Kind := TSQLNoteKind.Create;
+  Kind.Name := 'PostIt';
+  Server.Add(Kind,true);
+  Kind.Name := 'Todo';
+  Server.Add(Kind,true);
+  Kind.Free;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/26 - RESTful ORM/RESTServerClass.pas

@@ -0,0 +1,81 @@
+unit RESTServerClass;
+
+{$I Synopse.inc} // define HASINLINE and some FPC-specific options
+
+interface
+
+uses
+  SysUtils,
+  Classes,
+  SynCommons,
+  SynLog,
+  mORMot,
+  RESTData;
+
+type
+  ENoteServer = class(EORMException);
+  
+  TNoteServer = class(TSQLRestServerFullMemory)
+  protected
+    fRootFolder: TFileName;
+    fBlobFolder: TFileName;
+  public
+    constructor Create(const aRootFolder: TFileName; const aRootURI: RawUTF8); reintroduce;
+    destructor Destroy; override;
+    property RootFolder: TFileName read fRootFolder;
+  published
+    procedure Blob(Ctxt: TSQLRestServerURIContext);
+  end;
+
+
+implementation
+
+
+{ TNoteServer }
+
+constructor TNoteServer.Create(const aRootFolder: TFileName;
+  const aRootURI: RawUTF8);
+begin
+  fRootFolder := EnsureDirectoryExists(ExpandFileName(aRootFolder),true);
+  fBlobFolder := EnsureDirectoryExists(fRootFolder+'blob\',true);
+  // define the log level
+  with TSQLLog.Family do begin
+    Level := LOG_VERBOSE; // LOG_STACKTRACE;
+    DestinationPath := fRootFolder+'..\log\';
+    if not FileExists(DestinationPath) then
+      CreateDir(DestinationPath);
+    PerThreadLog := ptIdentifiedInOnFile;
+  end;
+  // prepare the server in-memory storage
+  inherited Create(DataModel(aRootURI),fRootFolder+'data.json',false,false);
+  UpdateToFile;
+end;
+
+destructor TNoteServer.Destroy;
+begin
+  inherited;
+  fModel.Free;
+end;
+
+procedure TNoteServer.Blob(Ctxt: TSQLRestServerURIContext);
+var FileName: TFileName;
+begin
+  if (Ctxt.Table=TSQLNoteFile) and (Ctxt.TableID<>0) then begin
+    FileName := fBlobFolder+UTF8ToString(
+      OneFieldValue(TSQLNoteFile,'FileName',Ctxt.TableID));
+    case Ctxt.Method of
+    mGET:
+      Ctxt.ReturnFile(FileName);
+    mPOST,mPUT: begin
+      FileFromString(Ctxt.Call.InBody,FileName);
+      Ctxt.Success;
+    end;
+    mDELETE:
+      if DeleteFile(FileName) then
+        Ctxt.Success else
+        Ctxt.Error('',HTTP_NOTFOUND);
+    end;
+  end;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/26 - RESTful ORM/RESTserver.dpr

@@ -0,0 +1,38 @@
+/// RESTful ORM server
+program RESTserver;
+
+{$APPTYPE CONSOLE}
+
+// first line after uses clause should be  {$I SynDprUses.inc}  for FastMM4
+uses
+  {$I SynDprUses.inc}
+  Classes,
+  SysUtils,
+  SynCommons,
+  SynTable,
+  SynLog,
+  mORMot,
+  SynCrtSock,
+  mORMotHTTPServer,
+  RESTData,
+  RESTServerClass;
+
+var ORMServer: TNoteServer;
+    HTTPServer: TSQLHttpServer;
+begin
+  ORMServer := TNoteServer.Create(ExeVersion.ProgramFilePath+'data','root');
+  try
+    TSQLLog.Family.EchoToConsole := LOG_VERBOSE;
+    HTTPServer := TSQLHttpServer.Create(HTTP_PORT,[ORMServer]);
+    try
+      sleep(300); // let the HTTP server start (for the console log refresh)
+      writeln(#13#10'Background server is running at http://localhost:888'#13#10+
+              #13#10'Press [Enter] to close the server.');
+      ConsoleWaitForEnterKey;
+    finally
+      HTTPServer.Free;
+    end;
+  finally
+    ORMServer.Free;
+  end;
+end.

contrib/mORMot/SQLite3/Samples/26 - RESTful ORM/RestClientMain.dfm

@@ -0,0 +1,92 @@
+object MainForm: TMainForm
+  Left = 236
+  Top = 358
+  BorderStyle = bsDialog
+  Caption = ' REST BLOB Client'
+  ClientHeight = 238
+  ClientWidth = 376
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  PixelsPerInch = 96
+  TextHeight = 13
+  object lblNewID: TLabel
+    Left = 144
+    Top = 80
+    Width = 3
+    Height = 13
+  end
+  object btnConnect: TButton
+    Left = 40
+    Top = 16
+    Width = 137
+    Height = 33
+    Caption = 'Connect'
+    TabOrder = 0
+    OnClick = btnConnectClick
+  end
+  object btnGet: TButton
+    Left = 192
+    Top = 104
+    Width = 75
+    Height = 25
+    Caption = 'Get BLOB'
+    Enabled = False
+    TabOrder = 1
+    OnClick = btnGetClick
+  end
+  object btnNew: TButton
+    Left = 48
+    Top = 72
+    Width = 75
+    Height = 25
+    Caption = 'New'
+    Enabled = False
+    TabOrder = 2
+    OnClick = btnNewClick
+  end
+  object btnSet: TButton
+    Left = 48
+    Top = 104
+    Width = 75
+    Height = 25
+    Caption = 'Set BLOB'
+    Enabled = False
+    TabOrder = 3
+    OnClick = btnSetClick
+  end
+  object mmoSet: TMemo
+    Left = 48
+    Top = 136
+    Width = 137
+    Height = 81
+    Enabled = False
+    Lines.Strings = (
+      '')
+    TabOrder = 4
+  end
+  object mmoGet: TMemo
+    Left = 192
+    Top = 136
+    Width = 137
+    Height = 81
+    Enabled = False
+    Lines.Strings = (
+      '')
+    TabOrder = 5
+  end
+  object edtGetID: TEdit
+    Left = 280
+    Top = 108
+    Width = 49
+    Height = 21
+    Enabled = False
+    TabOrder = 6
+  end
+end

contrib/mORMot/SQLite3/Samples/26 - RESTful ORM/RestClientMain.pas

@@ -0,0 +1,111 @@
+unit RestClientMain;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs,
+  SynCommons,
+  mORMot,
+  mORMotHttpClient,
+  RESTData, StdCtrls; // data model unit, shared between server and client
+
+type
+  TMainForm = class(TForm)
+    btnConnect: TButton;
+    btnGet: TButton;
+    btnNew: TButton;
+    lblNewID: TLabel;
+    btnSet: TButton;
+    mmoSet: TMemo;
+    mmoGet: TMemo;
+    edtGetID: TEdit;
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure btnConnectClick(Sender: TObject);
+    procedure btnGetClick(Sender: TObject);
+    procedure btnNewClick(Sender: TObject);
+    procedure btnSetClick(Sender: TObject);
+  protected
+    fModel: TSQLModel;
+    fClient: TSQLHttpClient;
+  public
+  end;
+
+var
+  MainForm: TMainForm;
+
+implementation
+
+{$R *.dfm}
+
+procedure TMainForm.FormCreate(Sender: TObject);
+begin
+  fModel := DataModel('root');
+end;
+
+procedure TMainForm.FormDestroy(Sender: TObject);
+begin
+  FreeAndNil(fClient);
+  FreeAndNil(fModel);
+end;
+
+procedure TMainForm.btnConnectClick(Sender: TObject);
+begin
+  fClient := TSQLHttpClientWinHTTP.Create('localhost','888',fModel);
+  try
+    if not fClient.ServerTimeStampSynchronize then
+      exit;
+    btnConnect.Enabled := false;
+    btnNew.Enabled := true;
+    btnGet.Enabled := true;
+    btnSet.Enabled := true;
+    mmoGet.Enabled := true;
+    mmoSet.Enabled := true;
+    edtGetID.Enabled := true;
+  except
+    FreeAndNil(fClient);
+  end;
+end;
+
+procedure TMainForm.btnGetClick(Sender: TObject);
+var ID: TID;
+    resp: RawUTF8;
+begin
+  if fClient=nil then
+    exit;
+  if not TryStrToInt64(edtGetID.Text,Int64(ID)) then
+    exit;
+  if fClient.CallBackGet('blob',[],resp,TSQLNoteFile,ID)=HTTP_SUCCESS then
+    mmoGet.Text := UTF8ToString(resp) else
+    mmoGet.Text := '? not found';
+end;
+
+procedure TMainForm.btnNewClick(Sender: TObject);
+var Note: TSQLNoteFile;
+begin
+  if fClient=nil then
+    exit;
+  Note := TSQLNoteFile.Create;
+  try
+    Note.FileName := 'Test'+UInt32ToUTF8(GetTickCount64);
+    Note.MetaData := _ObjFast(['timestamp',GetTickCount64]);
+    Tag := fClient.Add(Note,true);
+    lblNewID.Caption := Format('Current ID=%d',[Tag]);
+    mmoSet.Text := Format('Bla bla %d'#13#10'%d',[Tag,GetTickCount64]);
+    edtGetID.Text := IntToStr(Tag);
+  finally
+    Note.Free;
+  end;
+end;
+
+procedure TMainForm.btnSetClick(Sender: TObject);
+var resp: RawUTF8;
+begin
+  if fClient=nil then
+    exit;
+  if fClient.CallBackPut('blob',StringToUTF8(mmoSet.Text),resp,TSQLNoteFile,Tag)=HTTP_CREATED then
+    mmoSet.Text := '.. saved ..';
+end;
+
+end.