ID,count,maxID: integer;
begin
  Finalize(Lookup);
  if Lock=nil then
    Lock := TAutoLocker.Create;
  Lock.ProtectMethod;
  TAutoFree.One(
    tag,TSQLTag.CreateAndFillPrepare(aRest,'order by Ident','ID,Ident,Occurence'));
  count := tag.FillTable.RowCount;
  if count=0 then
    exit;
  SetLength(OrderID,count);
  count := 0;
  maxID := 0;
  while tag.FillOne do begin
................................................................................

procedure TSQLTags.SaveOccurence(aRest: TSQLRest);
var tag: TSQLTag;
    batch: TSQLRestBatch;
begin
  Lock.ProtectMethod;
  TAutoFree.Several([
    @tag,TSQLTag.CreateAndFillPrepare(aRest,'','ID,Occurence'),
    @batch,TSQLRestBatch.Create(aRest,TSQLTag,1000)]);
  while tag.FillOne do begin
    if tag.ID<=length(Lookup) then
      if Lookup[tag.ID-1].Occurence<>tag.Occurence then begin
        tag.Occurence := Lookup[tag.ID-1].Occurence;
        batch.Update(tag); // will update only Occurence field
      end;

    ID,count,maxID: integer;
begin
  Finalize(Lookup);
  if Lock=nil then
    Lock := TAutoLocker.Create;
  Lock.ProtectMethod;
  TAutoFree.One(
    tag,TSQLTag.CreateAndFillPrepare(aRest,'order by Ident','RowID,Ident,Occurence'));
  count := tag.FillTable.RowCount;
  if count=0 then
    exit;
  SetLength(OrderID,count);
  count := 0;
  maxID := 0;
  while tag.FillOne do begin
................................................................................

procedure TSQLTags.SaveOccurence(aRest: TSQLRest);
var tag: TSQLTag;
    batch: TSQLRestBatch;
begin
  Lock.ProtectMethod;
  TAutoFree.Several([
    @tag,TSQLTag.CreateAndFillPrepare(aRest,'','RowID,Occurence'),
    @batch,TSQLRestBatch.Create(aRest,TSQLTag,1000)]);
  while tag.FillOne do begin
    if tag.ID<=length(Lookup) then
      if Lookup[tag.ID-1].Occurence<>tag.Occurence then begin
        tag.Occurence := Lookup[tag.ID-1].Occurence;
        batch.Update(tag); // will update only Occurence field
      end;

/// MVC sample web application, publishing a simple BLOG
program MVCServer;

{$APPTYPE CONSOLE}











uses
  {$I SynDprUses.inc}    // will enable FastMM4 prior to Delphi 2006
  SynCrtSock,
  SynCommons,
  mORMot,
  SynSQLite3,
  SynSQLite3Static,
  mORMotSQLite3,
  mORMotHttpServer,
  mORMotMVC,











  MVCModel,
  MVCViewModel,
  SysUtils;

var aModel: TSQLModel;



    aServer: TSQLRestServerDB;
    aApplication: TBlogApplication;
    aHTTPServer: TSQLHttpServer;
begin
  aModel := CreateModel;
  try
















    aServer := TSQLRestServerDB.Create(aModel,ChangeFileExt(paramstr(0),'.db'));
    try
      aServer.DB.Synchronous := smNormal;
      aServer.DB.LockingMode := lmExclusive; 

      aServer.CreateMissingTables;
      aApplication := TBlogApplication.Create(aServer);
      try
        aHTTPServer := TSQLHttpServer.Create('8092',aServer,'+',useHttpApiRegisteringURI);
        try
          aHTTPServer.RootRedirectToURI('blog/default'); // redirect localhost:8092
          writeln('"MVC Blog Server" launched on port 8092 using ',aHttpServer.HttpServer.ClassName);
................................................................................
          aHTTPServer.Free;
        end;
      finally
        aApplication.Free;
      end;
    finally
      aServer.Free;



    end;
  finally
    aModel.Free;
  end;
end.

/// MVC sample web application, publishing a simple BLOG
program MVCServer;

{$APPTYPE CONSOLE}


{.$define USEZEOSPOSTGRESQL}
{.$define USEFIREDACPOSTGRESQL}

// direct ZDBC/FireDAC driver needs only libpq.dll and libintl.dll e.g. from
// http://www.enterprisedb.com/products-services-training/pgbindownload

{$ifdef USEZEOSPOSTGRESQL}    {$define USESYNDB} {$endif}
{$ifdef USEFIREDACPOSTGRESQL} {$define USESYNDB} {$endif}

uses
  {$I SynDprUses.inc}    // will enable FastMM4 prior to Delphi 2006
  SynCrtSock,
  SynCommons,
  mORMot,
  SynSQLite3,
  SynSQLite3Static,
  mORMotSQLite3,
  mORMotHttpServer,
  mORMotMVC,
  {$ifdef USESYNDB}
  SynDB,
  mORMotDB,
  {$ifdef USEZEOSPOSTGRESQL}
  SynDBZeos,
  {$endif}
  {$ifdef USEFIREDACPOSTGRESQL}
  SynDBFireDAC,
  {$ifdef ISDELPHIXE5} FireDAC.Phys.PG, {$else} uADPhysPG, {$endif}
  {$endif}
  {$endif}
  MVCModel,
  MVCViewModel,
  SysUtils;

var aModel: TSQLModel;
    {$ifdef USESYNDB}
    aExternalDB: TSQLDBConnectionProperties;
    {$endif}
    aServer: TSQLRestServerDB;
    aApplication: TBlogApplication;
    aHTTPServer: TSQLHttpServer;
begin
  aModel := CreateModel;
  try
    {$ifdef USESYNDB}
    {$ifdef USEZEOSPOSTGRESQL}
    aExternalDB := TSQLDBZEOSConnectionProperties.Create(
      TSQLDBZEOSConnectionProperties.URI(dPostgreSQL,'localhost:5432'),
    {$endif}
    {$ifdef USEFIREDACPOSTGRESQL}
    aExternalDB := TSQLDBFireDACConnectionProperties.Create(
      'PG?Server=localhost;Port=5432',
    {$endif}
      'postgres','postgres','postgresPassword');
    VirtualTableExternalRegisterAll(aModel,aExternalDB);
    aServer := TSQLRestServerDB.Create(aModel,SQLITE_MEMORY_DATABASE_NAME);
    try // PostgreSQL uses one fork per connection -> better only two threads
      aServer.AcquireExecutionMode[execORMGet] := amBackgroundThread;
      aServer.AcquireExecutionMode[execORMWrite] := amBackgroundThread;
    {$else}
    aServer := TSQLRestServerDB.Create(aModel,ChangeFileExt(paramstr(0),'.db'));
    try
      aServer.DB.Synchronous := smNormal;
      aServer.DB.LockingMode := lmExclusive;
    {$endif}
      aServer.CreateMissingTables;
      aApplication := TBlogApplication.Create(aServer);
      try
        aHTTPServer := TSQLHttpServer.Create('8092',aServer,'+',useHttpApiRegisteringURI);
        try
          aHTTPServer.RootRedirectToURI('blog/default'); // redirect localhost:8092
          writeln('"MVC Blog Server" launched on port 8092 using ',aHttpServer.HttpServer.ClassName);
................................................................................
          aHTTPServer.Free;
        end;
      finally
        aApplication.Free;
      end;
    finally
      aServer.Free;
      {$ifdef USESYNDB}
      aExternalDB.Free;
      {$endif}
    end;
  finally
    aModel.Free;
  end;
end.

  if VariantToInteger(Value,tag) then
     RawUTF8ToVariant(fTagsLookup.Get(tag),result) else
     SetVariantNull(result);
end;

const
  // just try with 200000 - and let your WordPress blog engine start to cry...
  FAKEDATA_ARTICLESCOUNT = 200000;
  
procedure TBlogApplication.ComputeMinimalData;
var info: TSQLBlogInfo;
    article: TSQLArticle;
    comment: TSQLComment;
    tag: TSQLTag;
    batch: TSQLRestBatch;
................................................................................
begin
  result := inherited GetViewInfo(MethodIndex);
  _ObjAddProps(['blog',fBlogMainInfo,
    'session',CurrentSession.CheckAndRetrieveInfo(TypeInfo(TCookieData))],result);
  if not fDefaultData.AddExistingProp('archives',result) then
    fDefaultData.AddNewProp('archives',RestModel.RetrieveDocVariantArray(
      TSQLArticle,'','group by PublishedMonth order by PublishedMonth desc limit 12',[],
      'distinct(PublishedMonth),max(ID)+1 as FirstID'),result);
  if not fDefaultData.AddExistingProp('tags',result) then
    fDefaultData.AddNewProp('tags',fTagsLookup.GetAsDocVariantArray,result);
end;

procedure TBlogApplication.FlushAnyCache;
begin
  inherited FlushAnyCache; // call fMainRunner.NotifyContentChanged
................................................................................
  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(
................................................................................
end;

procedure TBlogApplication.ArticleView(ID: integer;
  var WithComments: boolean; Direction: integer; var Scope: variant;
  out Article: TSQLArticle; out Author: variant; out Comments: TObjectList);
var newID: integer;
const WHERE: array[1..2] of PUTF8Char = (
  'ID<? order by id desc','ID>? order by id');
begin
  if Direction in [1,2] then // allows fast paging using index on ID
    if RestModel.OneFieldValue(TSQLArticle,'ID',WHERE[Direction],[],[ID],newID) and
      (newID<>0) then
      ID := newID;
  RestModel.Retrieve(ID,Article);
  if Article.ID<>0 then begin
    Author := RestModel.RetrieveDocVariant(
      TSQLAuthor,'ID=?',[Article.Author.ID],'FirstName,FamilyName');
    if WithComments then begin
      Comments.Free; // we will override the TObjectList created at input
      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
................................................................................
  if not RestModel.MemberExists(TSQLArticle,ID) then
    raise EMVCApplication.CreateGotoError(HTML_UNAVAILABLE);
  comm.Title := Title;
  comm.Content := Comment;
  comm.Article := TSQLArticle(ID);
  if comm.FilterAndValidate(RestModel,error) and
     (RestModel.Add(comm,true)<>0) then
    GotoView(result,'ArticleView',['ID',ID,'withComments',true]) else
    GotoView(result,'ArticleView',['ID',ID,'withComments',true,'Scope',_ObjFast([
      'CommentError',error,'CommentTitle',comm.Title,'CommentContent',comm.Content])],
      HTML_BADREQUEST);
end;

procedure TBlogApplication.ArticleEdit(var ID: integer;
  const Title,Content: RawUTF8; const ValidationError: variant;
  out Article: TSQLArticle);

  if VariantToInteger(Value,tag) then
     RawUTF8ToVariant(fTagsLookup.Get(tag),result) else
     SetVariantNull(result);
end;

const
  // just try with 200000 - and let your WordPress blog engine start to cry...
  FAKEDATA_ARTICLESCOUNT = 20000;
  
procedure TBlogApplication.ComputeMinimalData;
var info: TSQLBlogInfo;
    article: TSQLArticle;
    comment: TSQLComment;
    tag: TSQLTag;
    batch: TSQLRestBatch;
................................................................................
begin
  result := inherited GetViewInfo(MethodIndex);
  _ObjAddProps(['blog',fBlogMainInfo,
    'session',CurrentSession.CheckAndRetrieveInfo(TypeInfo(TCookieData))],result);
  if not fDefaultData.AddExistingProp('archives',result) then
    fDefaultData.AddNewProp('archives',RestModel.RetrieveDocVariantArray(
      TSQLArticle,'','group by PublishedMonth order by PublishedMonth desc limit 12',[],
      'distinct(PublishedMonth),max(RowID)+1 as FirstID'),result);
  if not fDefaultData.AddExistingProp('tags',result) then
    fDefaultData.AddNewProp('tags',fTagsLookup.GetAsDocVariantArray,result);
end;

procedure TBlogApplication.FlushAnyCache;
begin
  inherited FlushAnyCache; // call fMainRunner.NotifyContentChanged
................................................................................
  fDefaultData.Clear;
end;


{ TBlogApplication - Commands }

const
  ARTICLE_FIELDS = 'RowID,Title,Tags,Abstract,Author,AuthorName,CreatedAt';
  ARTICLE_DEFAULT_ORDER: RawUTF8 = 'order by RowID 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 := 'RowID<?' else
      whereClause := 'RowID>?'; // 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(
................................................................................
end;

procedure TBlogApplication.ArticleView(ID: integer;
  var WithComments: boolean; Direction: integer; var Scope: variant;
  out Article: TSQLArticle; out Author: variant; out Comments: TObjectList);
var newID: integer;
const WHERE: array[1..2] of PUTF8Char = (
  'RowID<? order by id desc','RowID>? order by id');
begin
  if Direction in [1,2] then // allows fast paging using index on ID
    if RestModel.OneFieldValue(TSQLArticle,'RowID',WHERE[Direction],[],[ID],newID) and
      (newID<>0) then
      ID := newID;
  RestModel.Retrieve(ID,Article);
  if Article.ID<>0 then begin
    Author := RestModel.RetrieveDocVariant(
      TSQLAuthor,'RowID=?',[Article.Author.ID],'FirstName,FamilyName');
    if WithComments then begin
      Comments.Free; // we will override the TObjectList created at input
      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 RowId 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
................................................................................
  if not RestModel.MemberExists(TSQLArticle,ID) then
    raise EMVCApplication.CreateGotoError(HTML_UNAVAILABLE);
  comm.Title := Title;
  comm.Content := Comment;
  comm.Article := TSQLArticle(ID);
  if comm.FilterAndValidate(RestModel,error) and
     (RestModel.Add(comm,true)<>0) then
    GotoView(result,'ArticleView',['RowID',ID,'withComments',true]) else
    GotoView(result,'ArticleView',['RowID',ID,'withComments',true,'Scope',_ObjFast([
      'CommentError',error,'CommentTitle',comm.Title,'CommentContent',comm.Content])],
      HTML_BADREQUEST);
end;

procedure TBlogApplication.ArticleEdit(var ID: integer;
  const Title,Content: RawUTF8; const ValidationError: variant;
  out Article: TSQLArticle);

'1.18.413'

'1.18.414'