mORMot and Open Source friends
Check-in [70f7a1a823]
Not logged in
Home Documentation Forum Download Blog Donate Timeline Tickets Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:{404} sample "30 - MVC Server" will now handle tags (categories) for articles
  • tags are stored as a dynamic array of integers within TArticle.Tags, without any pivot table
  • tags are displayed as text, in alphabetic order
  • performance of the BLOG engine is awsome: if you create 200,000 fake blog articles and 400,000 comments (written in less than 10 seconds in the SQLite3 DB), the web application works without any slow down, including tag search, and simple paging - a WordPress administrator would start to cry :)
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 70f7a1a8231a2c0b06a8e5af5b3112d9373d16a1
User & Date: User 2014-10-25 16:41:06
Context
2014-10-25
17:25
{405} allows static linking of SQLite3.o for FPC under Windows and Linux - thanks Alfred for the patch! check-in: 96a3f4c8b2 user: User tags: trunk
16:41
{404} sample "30 - MVC Server" will now handle tags (categories) for articles
  • tags are stored as a dynamic array of integers within TArticle.Tags, without any pivot table
  • tags are displayed as text, in alphabetic order
  • performance of the BLOG engine is awsome: if you create 200,000 fake blog articles and 400,000 comments (written in less than 10 seconds in the SQLite3 DB), the web application works without any slow down, including tag search, and simple paging - a WordPress administrator would start to cry :)
 check-in: 70f7a1a823 user: User tags: trunk
16:36
{403} small enhancements to mORMotMVC.pas - for instance, RegisterExpressionHelpers() methods can now be chained in a fluent interface check-in: 3499783d21 user: User tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to SQLite3/Samples/30 - MVC Server/MVCModel.pas. 

66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
..
90
91
92
93
94
95
96

97
98
99
100

101
102
103


104
105
106
107
108
109
110
111
112











113

114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
...
183
184
185
186
187
188
189
190



























































191

  public
    class procedure InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
      Options: TSQLInitializeTableOptions); override;
  published
    property Rights: TSQLAuthorRights read fRights write fRights;
  end;

  TSQLCategory = class(TSQLRecord)
  private
    fIdent: RawUTF8;
  published
    property Ident: RawUTF8 read fIdent write fIdent;
  end;

  TSQLContent = class(TSQLRecordTimeStamped)
  private
    fContent: RawUTF8;
    fTitle: RawUTF8;
    fAuthor: TSQLAuthor;
    fAuthorName: RawUTF8;
  published
................................................................................
    property AuthorName: RawUTF8 index 50 read fAuthorName write fAuthorName;
  end;

  TSQLArticle = class(TSQLContent)
  private
    fAbstract: RawUTF8;
    fPublishedMonth: Integer;

  public
    class function CurrentPublishedMonth: Integer;
    class procedure InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
      Options: TSQLInitializeTableOptions); override;

  published
    property PublishedMonth: Integer read fPublishedMonth write fPublishedMonth;
    property Abstract: RawUTF8 index 1024 read fAbstract write fAbstract;


  end;

  TSQLComment = class(TSQLContent)
  private
    fArticle: TSQLArticle;
  published
    property Article: TSQLArticle read fArticle write fArticle;
  end;












  

function CreateModel: TSQLModel;


implementation

function CreateModel: TSQLModel;
begin
  result := TSQLModel.Create([TSQLBlogInfo,TSQLCategory,TSQLAuthor,
    TSQLArticle,TSQLComment],'blog');
  TSQLArticle.AddFilterOrValidate('Title',TSynFilterTrim.Create);
  TSQLArticle.AddFilterOrValidate('Title',TSynValidateText.Create);
  TSQLArticle.AddFilterOrValidate('Content',TSynFilterTrim.Create);
  TSQLArticle.AddFilterOrValidate('Content',TSynValidateText.Create);
end;


................................................................................
class procedure TSQLArticle.InitializeTable(Server: TSQLRestServer;
  const FieldName: RawUTF8; Options: TSQLInitializeTableOptions);
begin
  inherited;
  if (FieldName='') or (FieldName='PublishedMonth') then
    Server.CreateSQLIndex(TSQLArticle,'PublishedMonth',false);
end;




























































end.







<
<
<
<
<
<
<







 







>




>



>
>









>
>
>
>
>
>
>
>
>
>
>
|
>







|
|







 








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


66
67
68
69
70
71
72







73
74
75
76
77
78
79
..
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
...
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259

  public
    class procedure InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
      Options: TSQLInitializeTableOptions); override;
  published
    property Rights: TSQLAuthorRights read fRights write fRights;
  end;








  TSQLContent = class(TSQLRecordTimeStamped)
  private
    fContent: RawUTF8;
    fTitle: RawUTF8;
    fAuthor: TSQLAuthor;
    fAuthorName: RawUTF8;
  published
................................................................................
    property AuthorName: RawUTF8 index 50 read fAuthorName write fAuthorName;
  end;

  TSQLArticle = class(TSQLContent)
  private
    fAbstract: RawUTF8;
    fPublishedMonth: Integer;
    fTags: TIntegerDynArray;
  public
    class function CurrentPublishedMonth: Integer;
    class procedure InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
      Options: TSQLInitializeTableOptions); override;
    procedure TagsAddOrdered(aTagID: Integer; const AlphabeticalOrder: TCardinalDynArray);
  published
    property PublishedMonth: Integer read fPublishedMonth write fPublishedMonth;
    property Abstract: RawUTF8 index 1024 read fAbstract write fAbstract;
    // "index 1" below to allow writing e.g. aArticle.DynArray(1).Delete(aIndex)
    property Tags: TIntegerDynArray index 1 read fTags write fTags;
  end;

  TSQLComment = class(TSQLContent)
  private
    fArticle: TSQLArticle;
  published
    property Article: TSQLArticle read fArticle write fArticle;
  end;

  TSQLTag = class(TSQLRecord)
  private
    fIdent: RawUTF8;
    fCreatedAt: TCreateTime;
  public
    class function ComputeTagIdentPerIDArray(aRest: TSQLRest;
      out AlphabeticalOrder: TCardinalDynArray): TRawUTF8DynArray;
  published
    property Ident: RawUTF8 read fIdent write fIdent;
    property CreatedAt: TCreateTime read fCreatedAt write fCreatedAt;
  end;


function CreateModel: TSQLModel;


implementation

function CreateModel: TSQLModel;
begin
  result := TSQLModel.Create([TSQLBlogInfo,TSQLAuthor,
    TSQLTag,TSQLArticle,TSQLComment],'blog');
  TSQLArticle.AddFilterOrValidate('Title',TSynFilterTrim.Create);
  TSQLArticle.AddFilterOrValidate('Title',TSynValidateText.Create);
  TSQLArticle.AddFilterOrValidate('Content',TSynFilterTrim.Create);
  TSQLArticle.AddFilterOrValidate('Content',TSynValidateText.Create);
end;


................................................................................
class procedure TSQLArticle.InitializeTable(Server: TSQLRestServer;
  const FieldName: RawUTF8; Options: TSQLInitializeTableOptions);
begin
  inherited;
  if (FieldName='') or (FieldName='PublishedMonth') then
    Server.CreateSQLIndex(TSQLArticle,'PublishedMonth',false);
end;

procedure TSQLArticle.TagsAddOrdered(aTagID: Integer;
  const AlphabeticalOrder: TCardinalDynArray);
var sets: TByteDynArray;
    i,n,max: integer;
begin // add tag ID per alphabetic order - a bit complicated but works
  max := length(AlphabeticalOrder);
  if (aTagID=0) or (aTagID>max) then
    exit;
  n := length(fTags);
  if n=0 then begin
    SetLength(fTags,1);
    fTags[0] := aTagID;
    exit;
  end;
  SetLength(sets,(max shr 3)+1);
  for i := 0 to n-1 do
    SetBit(sets[0],fTags[i]-1);
  if GetBit(sets[0],aTagID-1) then
    exit; // duplicated aTagID
  SetBit(sets[0],aTagID-1);
  SetLength(fTags,n+1);
  n := 0;
  for i := 0 to max-1 do
    if GetBit(sets[0],AlphabeticalOrder[i]) then begin
      fTags[n] := AlphabeticalOrder[i]+1;
      inc(n);
    end;
  assert(n=length(fTags));
end;


{ TSQLTag }

class function TSQLTag.ComputeTagIdentPerIDArray(aRest: TSQLRest;
  out AlphabeticalOrder: TCardinalDynArray): TRawUTF8DynArray;
var tag: TSQLTag;
    max: integer;
begin
  result := nil;
  tag := TSQLTag.CreateAndFillPrepare(aRest,'','ID,Ident');
  try
    if tag.FillTable.RowCount=0 then
      exit;
    max := 0;
    while tag.FillOne do
      if tag.ID>max then
        max := tag.ID;
    SetLength(result,max);
    tag.FillRewind;
    while tag.FillOne do
      result[tag.ID-1] := tag.Ident;
    SetLength(AlphabeticalOrder,max);
    FillIncreasing(pointer(AlphabeticalOrder),0,max);
    QuickSortIndexedPUTF8Char(pointer(result),max,AlphabeticalOrder);
  finally
    tag.Free;
  end;
end;

end.

Changes to SQLite3/Samples/30 - MVC Server/MVCViewModel.pas. 

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
..
48
49
50
51
52
53
54



55
56
57
58
59
60
61

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
..
89
90
91
92
93
94
95








96
97
98
99
100
101
102

103
104
105
106
107
108
109
110
111
112
113
114











115



116

117




118
119
120
121


122
123
124
125
126


127
128
129
130
131
132
133
134
135
136
137
138
139
140
141

142








143
144
145
146
147
148
149



150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
...
193
194
195
196
197
198
199
200

201
202
203

204
205
206
207
208

209
210
211






212
213
214

215






216
217


218
219
220
221
222
223
224
...
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
...
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349

  // ! blog/main/articlecommit -> article edition commit (ID=0 for new)
  IBlogApplication = interface(IMVCApplication)
    procedure ArticleView(
      ID: integer; var WithComments: boolean; Direction: integer;
      out Article: TSQLArticle; out Author: variant;
      out Comments: TObjectList);
    procedure AuthorView(
      var ID: integer; out Author: TSQLAuthor; out Articles: RawJSON);
    function Login(
      const LogonName,PlainPassword: RawUTF8): TMVCAction;
    function Logout: TMVCAction;
    procedure ArticleEdit(var ID: integer; const Title,Content: RawUTF8;
      const ValidationError: variant;
      out Article: TSQLArticle);
    function ArticleCommit(
................................................................................
    AuthorRights: TSQLAuthorRights;
  end;

  /// implements the ViewModel/Controller of this BLOG web site
  TBlogApplication = class(TMVCApplication,IBlogApplication)
  protected
    fBlogMainInfo: variant;



    fDefaultData: ILockedDocVariant;
    fDefaultLastID: integer;
    procedure ComputeMinimalData; virtual;
    procedure FlushAnyCache; override;
    function GetViewInfo(MethodIndex: integer): variant; override;
    function GetLoggedAuthorID(Rights: TSQLAuthorRights): integer;
    procedure MonthToText(const Value: variant; out result: variant);

  public
    constructor Create(aServer: TSQLRestServer); reintroduce;
  public
    procedure Default(var Scope: variant);
    procedure ArticleView(ID: integer; var WithComments: boolean;
      Direction: integer;
      out Article: TSQLArticle; out Author: variant;
      out Comments: TObjectList);
    procedure AuthorView(
      var ID: integer; out Author: TSQLAuthor; out Articles: RawJSON);
    function Login(const LogonName,PlainPassword: RawUTF8): TMVCAction;
    function Logout: TMVCAction;
    procedure ArticleEdit(var ID: integer; const Title,Content: RawUTF8;
      const ValidationError: variant;
      out Article: TSQLArticle);
    function ArticleCommit(ID: integer; const Title,Content: RawUTF8): TMVCAction;
  end;
................................................................................
{ TBlogApplication }

constructor TBlogApplication.Create(aServer: TSQLRestServer);
begin
  fDefaultData := TLockedDocVariant.Create;
  inherited Create(aServer,TypeInfo(IBlogApplication));
  ComputeMinimalData;








  // publish IBlogApplication using Mustache Views (TMVCRunOnRestServer default)
  fMainRunner := TMVCRunOnRestServer.Create(Self).
    SetCache('Default',cacheRootIfNoSession,15).
    SetCache('ArticleView',cacheWithParametersIfNoSession,60).
    SetCache('AuthorView',cacheWithParametersIgnoringSession,60);
  (TMVCRunOnRestServer(fMainRunner).Views as TMVCViewsMustache).
    RegisterExpressionHelpers(['MonthToText'],[MonthToText]);

end;

procedure TBlogApplication.MonthToText(const Value: variant;
  out result: variant);
const MONTHS: array[0..11] of RawUTF8 = (
  'January','February','March','April','May','June','July','August',
  'September','October','November','December');
var month: integer;
    text: RawUTF8;
begin
  if VariantToInteger(Value,month) and (month>0) then
    text := MONTHS[month mod 12]+' '+UInt32ToUTF8(month div 12);











  RawUTF8ToVariant(text,result);



end;






procedure TBlogApplication.ComputeMinimalData;
var info: TSQLBlogInfo;
    article: TSQLArticle;
    comment: TSQLComment;


    n: integer;
    res: TIntegerDynArray;
begin
  info := TSQLBlogInfo.Create;
  try


    if not RestModel.Retrieve('',info) then begin // retrieve first item
      info.Title := 'mORMot BLOG';
      info.Language := 'en';
      info.Description := 'Sample Blog Web Application using Synopse mORMot MVC';
      info.Copyright := '&copy;2014 <a href=http://synopse.info>Synopse Informatique</a>';
      info.About := TSynTestCase.RandomTextParagraph(30,'!');
      RestModel.Add(info,true);
    end;
    fBlogMainInfo := info.GetSimpleFieldsAsDocVariant(false);
  finally
    info.Free;
  end;
  if not RestModel.TableHasRows(TSQLArticle) then begin
    RestModel.BatchStart(TSQLArticle,1000);
    article := TSQLArticle.Create;

    try








      article.Author := TSQLAuthor(1);
      article.AuthorName := 'synopse';
      for n := 1 to 100 do begin
        article.PublishedMonth := 2014*12+(n div 10);
        article.Title := TSynTestCase.RandomTextParagraph(5,' ');
        article.Abstract := TSynTestCase.RandomTextParagraph(30,'!');
        article.Content := TSynTestCase.RandomTextParagraph(200,'.','http://synopse.info');



        RestModel.BatchAdd(article,true);
      end;
      if RestModel.BatchSend(res)=HTML_SUCCESS then begin
        comment := TSQLComment.Create;
        try
          comment.Author := article.Author;
          comment.AuthorName := article.AuthorName;
          RestModel.BatchStart(TSQLComment,1000);
          for n := 1 to 200 do begin
            comment.Article := Pointer(res[random(length(res))]);
            comment.Title := TSynTestCase.RandomTextParagraph(5,' ');
            comment.Content := TSynTestCase.RandomTextParagraph(30,'.','http://mormot.net');
            RestModel.BatchAdd(Comment,true);
          end;
          RestModel.BatchSend(res)
        finally
          comment.Free;
        end;
      end;
    finally
      article.Free;
    end;
  end;
end;

function TBlogApplication.GetLoggedAuthorID(Rights: TSQLAuthorRights): integer;
var SessionInfo: TCookieData;
begin
................................................................................
  fDefaultData.Clear;
end;


{ TBlogApplication - Commands }

const
  ARTICLE_FIELDS = 'ID,Title,Abstract,Author,AuthorName,CreatedAt';


procedure TBlogApplication.Default(var Scope: variant);
var lastID: integer;

begin
  if VariantToInteger(Scope,lastID) and (lastID>0) then begin
    _ObjAddProps(['articles',RestModel.RetrieveDocVariantArray(
        TSQLArticle,'','ID<? order by ID desc limit 20',[lastID],ARTICLE_FIELDS,
        nil,@lastID)],Scope);

    if lastID>1 then
      _ObjAddProps(['lastID',lastID],Scope);
  end else begin






    if not fDefaultData.AddExistingProp('Articles',Scope) then
      fDefaultData.AddNewProp('Articles',RestModel.RetrieveDocVariantArray(
        TSQLArticle,'','order by ID desc limit 20',[],ARTICLE_FIELDS,

        nil,@fDefaultLastID),Scope);






    _ObjAddProps(['lastID',fDefaultLastID],Scope);
  end;


  if not fDefaultData.AddExistingProp('Archives',Scope) then
    fDefaultData.AddNewProp('Archives',RestModel.RetrieveDocVariantArray(
      TSQLArticle,'','group by PublishedMonth order by PublishedMonth desc limit 12',[],
      'distinct(PublishedMonth),max(ID)+1 as FirstID'),Scope);
end;

procedure TBlogApplication.ArticleView(
................................................................................
      Comments := RestModel.RetrieveList(TSQLComment,'Article=?',[Article.ID]);
    end;
  end else
    raise EMVCApplication.CreateGotoError(HTML_NOTFOUND);
end;

procedure TBlogApplication.AuthorView(var ID: integer; out Author: TSQLAuthor;
  out Articles: RawJSON);
begin
  RestModel.Retrieve(ID,Author);
  Author.HashedPassword := ''; // no need to publish it
  if Author.ID<>0 then
    Articles := RestModel.RetrieveListJSON(
      TSQLArticle,'Author=? order by id desc limit 50',[ID],ARTICLE_FIELDS) else
    raise EMVCApplication.CreateGotoError(HTML_NOTFOUND);
end;

function TBlogApplication.Login(const LogonName, PlainPassword: RawUTF8): TMVCAction;
var Author: TSQLAuthor;
    SessionInfo: TCookieData;
begin
................................................................................
        RestModel.Update(Article);
  finally
    Article.Free;
  end;
end;

{$ifndef ISDELPHI2010}


initialization
  TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(TypeInfo(TSQLAuthorRights));
  TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TCookieData),
    'AuthorName RawUTF8 AuthorID cardinal AuthorRights TSQLAuthorRights');
{$endif}
end.







|







 







>
>
>







>









|







 







>
>
>
>
>
>
>
>






|
>








<


|
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
|
>

>
>
>
>




>
>
|
|

<
<
>
>
|
|
|
|
|
|
|
|
<
<
<
<

<
<
>

>
>
>
>
>
>
>
>


|




>
>
>
|

|
<
<
|
|
|
|
|
|
|
|
|
|
<
<
|
<

|







 







|
>


|
>

<
<
<
|
>
|
|
|
>
>
>
>
>
>


<
>
|
>
>
>
>
>
>
|
<
>
>







 







|




|
|







 







<








21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
..
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123

124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157


158
159
160
161
162
163
164
165
166
167




168


169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191


192
193
194
195
196
197
198
199
200
201


202

203
204
205
206
207
208
209
210
211
...
227
228
229
230
231
232
233
234
235
236
237
238
239
240



241
242
243
244
245
246
247
248
249
250
251
252
253

254
255
256
257
258
259
260
261
262

263
264
265
266
267
268
269
270
271
...
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
...
382
383
384
385
386
387
388

389
390
391
392
393
394
395

  // ! blog/main/articlecommit -> article edition commit (ID=0 for new)
  IBlogApplication = interface(IMVCApplication)
    procedure ArticleView(
      ID: integer; var WithComments: boolean; Direction: integer;
      out Article: TSQLArticle; out Author: variant;
      out Comments: TObjectList);
    procedure AuthorView(
      var ID: integer; out Author: TSQLAuthor; out Articles: variant);
    function Login(
      const LogonName,PlainPassword: RawUTF8): TMVCAction;
    function Logout: TMVCAction;
    procedure ArticleEdit(var ID: integer; const Title,Content: RawUTF8;
      const ValidationError: variant;
      out Article: TSQLArticle);
    function ArticleCommit(
................................................................................
    AuthorRights: TSQLAuthorRights;
  end;

  /// implements the ViewModel/Controller of this BLOG web site
  TBlogApplication = class(TMVCApplication,IBlogApplication)
  protected
    fBlogMainInfo: variant;
    fTagsLookupLock: IAutoLocker;
    fTagsLookup: TRawUTF8DynArray;
    fTagsLookupOrder: TCardinalDynArray;
    fDefaultData: ILockedDocVariant;
    fDefaultLastID: integer;
    procedure ComputeMinimalData; virtual;
    procedure FlushAnyCache; override;
    function GetViewInfo(MethodIndex: integer): variant; override;
    function GetLoggedAuthorID(Rights: TSQLAuthorRights): integer;
    procedure MonthToText(const Value: variant; out result: variant);
    procedure TagToText(const Value: variant; out result: variant);
  public
    constructor Create(aServer: TSQLRestServer); reintroduce;
  public
    procedure Default(var Scope: variant);
    procedure ArticleView(ID: integer; var WithComments: boolean;
      Direction: integer;
      out Article: TSQLArticle; out Author: variant;
      out Comments: TObjectList);
    procedure AuthorView(
      var ID: integer; out Author: TSQLAuthor; out Articles: variant);
    function Login(const LogonName,PlainPassword: RawUTF8): TMVCAction;
    function Logout: TMVCAction;
    procedure ArticleEdit(var ID: integer; const Title,Content: RawUTF8;
      const ValidationError: variant;
      out Article: TSQLArticle);
    function ArticleCommit(ID: integer; const Title,Content: RawUTF8): TMVCAction;
  end;
................................................................................
{ TBlogApplication }

constructor TBlogApplication.Create(aServer: TSQLRestServer);
begin
  fDefaultData := TLockedDocVariant.Create;
  inherited Create(aServer,TypeInfo(IBlogApplication));
  ComputeMinimalData;
  with TSQLBlogInfo.Create(RestModel,'') do
  try
    fBlogMainInfo := GetSimpleFieldsAsDocVariant(false);
  finally
    Free;
  end;
  fTagsLookupLock := TAutoLocker.Create;
  fTagsLookup := TSQLTag.ComputeTagIdentPerIDArray(RestModel,fTagsLookupOrder);
  // publish IBlogApplication using Mustache Views (TMVCRunOnRestServer default)
  fMainRunner := TMVCRunOnRestServer.Create(Self).
    SetCache('Default',cacheRootIfNoSession,15).
    SetCache('ArticleView',cacheWithParametersIfNoSession,60).
    SetCache('AuthorView',cacheWithParametersIgnoringSession,60);
  (TMVCRunOnRestServer(fMainRunner).Views as TMVCViewsMustache).
    RegisterExpressionHelpers(['MonthToText'],[MonthToText]).
    RegisterExpressionHelpers(['TagToText'],[TagToText]);
end;

procedure TBlogApplication.MonthToText(const Value: variant;
  out result: variant);
const MONTHS: array[0..11] of RawUTF8 = (
  'January','February','March','April','May','June','July','August',
  'September','October','November','December');
var month: integer;

begin
  if VariantToInteger(Value,month) and (month>0) then
    RawUTF8ToVariant(MONTHS[month mod 12]+' '+UInt32ToUTF8(month div 12),result) else
    SetVariantNull(result);
end;

procedure TBlogApplication.TagToText(const Value: variant;
  out result: variant);
var tag: integer;
begin
  fTagsLookupLock.Enter;
  try
    if VariantToInteger(Value,tag) and
       (tag>0) and (tag<=length(fTagsLookup)) then
      RawUTF8ToVariant(fTagsLookup[tag-1],result) else
      SetVariantNull(result);
  finally
    fTagsLookupLock.Leave;
  end;
end;

const
  // just try with 200000 - and let your WordPress blog engine start to cry...
  FAKEDATA_ARTICLESCOUNT = 200;
  
procedure TBlogApplication.ComputeMinimalData;
var info: TSQLBlogInfo;
    article: TSQLArticle;
    comment: TSQLComment;
    tag: TSQLTag;
    batch: TSQLRestBatch;
    n,t: integer;
    articles,tags,comments: TIntegerDynArray;
begin


  TSQLRecord.AutoFree([ // avoid several try..finally
    @info,TSQLBlogInfo, @article,TSQLArticle, @comment,TSQLComment, @tag,TSQLTag]);
  if not RestModel.Retrieve('',info) then begin // retrieve first item
    info.Title := 'mORMot BLOG';
    info.Language := 'en';
    info.Description := 'Sample Blog Web Application using Synopse mORMot MVC';
    info.Copyright := '&copy;2014 <a href=http://synopse.info>Synopse Informatique</a>';
    info.About := TSynTestCase.RandomTextParagraph(30,'!');
    RestModel.Add(info,true);
  end;




  if not RestModel.TableHasRows(TSQLArticle) then begin


    batch := TSQLRestBatch.Create(RestModel,TSQLTag,100);
    try
      for n := 1 to 32 do begin
        tag.Ident := 'Tag'+UInt32ToUtf8(n);
        tag.ID := n*2; // force ID to test TSQLTag.ComputeTagIdentPerIDArray
        batch.Add(tag,true,true);
      end;
      RestModel.BatchSend(batch,tags);
      fTagsLookup := TSQLTag.ComputeTagIdentPerIDArray(RestModel,fTagsLookupOrder);
      batch.Reset(TSQLArticle,20000);
      article.Author := TSQLAuthor(1);
      article.AuthorName := 'synopse';
      for n := 1 to FAKEDATA_ARTICLESCOUNT do begin
        article.PublishedMonth := 2014*12+(n div 10);
        article.Title := TSynTestCase.RandomTextParagraph(5,' ');
        article.Abstract := TSynTestCase.RandomTextParagraph(30,'!');
        article.Content := TSynTestCase.RandomTextParagraph(200,'.','http://synopse.info');
        article.Tags := nil;
        for t := 1 to Random(6) do
          article.TagsAddOrdered(tags[random(length(tags))],fTagsLookupOrder);
        batch.Add(article,true);
      end;
      if RestModel.BatchSend(batch,articles)=HTML_SUCCESS then begin


        comment.Author := article.Author;
        comment.AuthorName := article.AuthorName;
        batch.Reset(TSQLComment,20000);
        for n := 1 to FAKEDATA_ARTICLESCOUNT*2 do begin
          comment.Article := Pointer(articles[random(length(articles))]);
          comment.Title := TSynTestCase.RandomTextParagraph(5,' ');
          comment.Content := TSynTestCase.RandomTextParagraph(30,'.','http://mormot.net');
          batch.Add(Comment,true);
        end;
        RestModel.BatchSend(batch,comments)


      end;

    finally
      batch.Free;
    end;
  end;
end;

function TBlogApplication.GetLoggedAuthorID(Rights: TSQLAuthorRights): integer;
var SessionInfo: TCookieData;
begin
................................................................................
  fDefaultData.Clear;
end;


{ TBlogApplication - Commands }

const
  ARTICLE_FIELDS = 'ID,Title,Tags,Abstract,Author,AuthorName,CreatedAt';
  ARTICLE_DEFAULT_ORDER: RawUTF8 = 'order by ID desc limit 20';

procedure TBlogApplication.Default(var Scope: variant);
var lastID,tag: integer;
    whereClause: RawUTF8;
begin



  lastID := 0;
  tag := 0;
  with DocVariantDataSafe(Scope)^ do begin
    if GetAsInteger('lastID',lastID) then
      whereClause := 'ID<?' else
      whereClause := 'ID>?'; // will search ID>0 so always true
    if GetAsInteger('tag',tag) then // uses custom function to search in BLOB
      whereClause := whereClause+' and IntegerDynArrayContains(Tags,?)';
  end;
  if (lastID=0) and (tag=0) then begin // use simple cache if no parameters
    SetVariantNull(Scope);
    if not fDefaultData.AddExistingProp('Articles',Scope) then
      fDefaultData.AddNewProp('Articles',RestModel.RetrieveDocVariantArray(

        TSQLArticle,'',pointer(ARTICLE_DEFAULT_ORDER),[],
        ARTICLE_FIELDS,nil,@fDefaultLastID),Scope);
    lastID := fDefaultLastID;
  end else // use more complex request using lastID + tag parameters
    scope := _ObjFast(['Articles',RestModel.RetrieveDocVariantArray(
        TSQLArticle,'',Pointer(whereClause+ARTICLE_DEFAULT_ORDER),[lastID,tag],
        ARTICLE_FIELDS,nil,@lastID)]);
  if lastID>1 then
    _ObjAddProps(['lastID',lastID],Scope);

  if tag>0 then
    _ObjAddProps(['tag',tag],Scope);
  if not fDefaultData.AddExistingProp('Archives',Scope) then
    fDefaultData.AddNewProp('Archives',RestModel.RetrieveDocVariantArray(
      TSQLArticle,'','group by PublishedMonth order by PublishedMonth desc limit 12',[],
      'distinct(PublishedMonth),max(ID)+1 as FirstID'),Scope);
end;

procedure TBlogApplication.ArticleView(
................................................................................
      Comments := RestModel.RetrieveList(TSQLComment,'Article=?',[Article.ID]);
    end;
  end else
    raise EMVCApplication.CreateGotoError(HTML_NOTFOUND);
end;

procedure TBlogApplication.AuthorView(var ID: integer; out Author: TSQLAuthor;
  out Articles: variant);
begin
  RestModel.Retrieve(ID,Author);
  Author.HashedPassword := ''; // no need to publish it
  if Author.ID<>0 then
    Articles := RestModel.RetrieveDocVariantArray(
      TSQLArticle,'','Author=? order by id desc limit 50',[ID],ARTICLE_FIELDS) else
    raise EMVCApplication.CreateGotoError(HTML_NOTFOUND);
end;

function TBlogApplication.Login(const LogonName, PlainPassword: RawUTF8): TMVCAction;
var Author: TSQLAuthor;
    SessionInfo: TCookieData;
begin
................................................................................
        RestModel.Update(Article);
  finally
    Article.Free;
  end;
end;

{$ifndef ISDELPHI2010}


initialization
  TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(TypeInfo(TSQLAuthorRights));
  TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TCookieData),
    'AuthorName RawUTF8 AuthorID cardinal AuthorRights TSQLAuthorRights');
{$endif}
end.

Changes to SQLite3/Samples/30 - MVC Server/Views/ArticleView.html. 

1
2
3
4
5
6

7
8
9
10
11
12
13

{{>header}}
{{>masthead}}
      <div class="blog-header">
        <h1 class="blog-title">{{article.title}}</h1>
        <div class="lead blog-description">
		Written by <a href="authorView?id={{article.Author}}">{{article.AuthorName}}</a> ({{author.FirstName}} {{author.FamilyName}}) on {{TimeLogToText article.CreatedAt}}

		</div>
      </div>
      <div class="blog-main">
		  {{{WikiToHtml article.abstract}}}
		  <hr>
		  {{{WikiToHtml article.content}}}
		  <hr>





|
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14

{{>header}}
{{>masthead}}
      <div class="blog-header">
        <h1 class="blog-title">{{article.title}}</h1>
        <div class="lead blog-description">
		Written by <a href="authorView?id={{article.Author}}">{{article.AuthorName}}</a> ({{author.FirstName}} {{author.FamilyName}}) on {{TimeLogToText article.CreatedAt}}<br />
		{{#article.tags}}<a href="default?scope={tag:{{.}}}" class="label label-info">{{TagToText .}}</a> {{/article.tags}}
		</div>
      </div>
      <div class="blog-main">
		  {{{WikiToHtml article.abstract}}}
		  <hr>
		  {{{WikiToHtml article.content}}}
		  <hr>

Changes to SQLite3/Samples/30 - MVC Server/Views/Default.html. 

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

        <p class="lead blog-description">{{main.blog.description}}</p>
      </div>
      <div class="row">
        <div class="col-sm-8 blog-main">
{{#Scope}}
{{>articlerow}}
		{{#lastID}}
		<p><a href="default?scope={{.}}" class="btn btn-primary btn-sm">Previous Articles</a></p>
		{{/lastID}}
        </div>
        <div class="col-sm-3 col-sm-offset-1 blog-sidebar">
          <div class="sidebar-module sidebar-module-inset">
            <h4>About</h4>
            {{{WikiToHtml main.blog.about}}}
          </div>
          <div class="sidebar-module">
            <h4>Archives</h4>
            <ol class="list-unstyled">
			  {{#Archives}}
              <li><a href="default?scope={{FirstID}}">{{MonthToText PublishedMonth}}</a></li>
			  {{/Archives}}
            </ol>
          </div>
		</div>
	  </div>
{{/Scope}}
{{>footer}}







|











|








5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

        <p class="lead blog-description">{{main.blog.description}}</p>
      </div>
      <div class="row">
        <div class="col-sm-8 blog-main">
{{#Scope}}
{{>articlerow}}
		{{#lastID}}
		<p><a href="default?scope={lastID:{{.}},tag:{{tag}}}" class="btn btn-primary btn-sm">Previous Articles</a></p>
		{{/lastID}}
        </div>
        <div class="col-sm-3 col-sm-offset-1 blog-sidebar">
          <div class="sidebar-module sidebar-module-inset">
            <h4>About</h4>
            {{{WikiToHtml main.blog.about}}}
          </div>
          <div class="sidebar-module">
            <h4>Archives</h4>
            <ol class="list-unstyled">
			  {{#Archives}}
              <li><a href="default?scope={lastID:{{FirstID}}}">{{MonthToText PublishedMonth}}</a></li>
			  {{/Archives}}
            </ol>
          </div>
		</div>
	  </div>
{{/Scope}}
{{>footer}}

Changes to SQLite3/Samples/30 - MVC Server/Views/articlerow.partial. 

1
2
3

4


5
6
7






        {{#articles}}
		  <div class="blog-post">
            <h2 class="blog-post-title"><a href=articleView?id={{id}}>{{Title}}</a></h2>

            <p class="blog-post-meta">{{TimeLogToText CreatedAt}} by <a href="authorView?id={{Author}}">{{AuthorName}}</a></p>


            {{{WikiToHtml Abstract}}}
		  </div>
        {{/articles}}








>
|
>
>



>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

        {{#articles}}
		  <div class="blog-post">
            <h2 class="blog-post-title"><a href=articleView?id={{id}}>{{Title}}</a></h2>
            <p class="blog-post-meta">
			{{TimeLogToText CreatedAt}} by <a href="authorView?id={{Author}}">{{AuthorName}}</a><br />
			{{#Tags}}<a href="default?scope={tag:{{.}}}" class="label label-info">{{TagToText .}}</a> {{/Tags}}
			</p>
            {{{WikiToHtml Abstract}}}
		  </div>
        {{/articles}}
        {{^articles}}
		  <div class="blog-post">
		  <p>There is no more article corresponding to this research criteria.</p>
		  </div>
        {{/articles}}

Changes to synopseCommit.inc. 

1

'1.18.403'

|

1

'1.18.404'

©2010-2022 Synopse Informatique