source upload
This commit is contained in:
Razor12911
653
contrib/mORMot/SQLite3/Samples/30 - MVC Server/MVCModel.pas
Normal file
653
contrib/mORMot/SQLite3/Samples/30 - MVC Server/MVCModel.pas
Normal file
@@ -0,0 +1,653 @@
|
||||
/// database Model for the MVCServer BLOG sample
|
||||
unit MVCModel;
|
||||
|
||||
{$I Synopse.inc} // define HASINLINE WITHLOG ONLYUSEHTTPSOCKET
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
SynCommons,
|
||||
SynCrypto,
|
||||
mORMot;
|
||||
|
||||
type
|
||||
TSQLBlogInfo = class(TSQLRecord)
|
||||
private
|
||||
fCopyright: RawUTF8;
|
||||
fDescription: RawUTF8;
|
||||
fTitle: RawUTF8;
|
||||
fLanguage: RawUTF8;
|
||||
fAbout: RawUTF8;
|
||||
published
|
||||
property Title: RawUTF8 index 80 read fTitle write fTitle;
|
||||
property Language: RawUTF8 index 3 read fLanguage write fLanguage;
|
||||
property Description: RawUTF8 index 120 read fDescription write fDescription;
|
||||
property Copyright: RawUTF8 index 80 read fCopyright write fCopyright;
|
||||
property About: RawUTF8 read fAbout write fAbout;
|
||||
end;
|
||||
|
||||
TSQLRecordTimeStamped = class(TSQLRecord)
|
||||
private
|
||||
fCreatedAt: TCreateTime;
|
||||
fModifiedAt: TModTime;
|
||||
published
|
||||
property CreatedAt: TCreateTime read fCreatedAt write fCreatedAt;
|
||||
property ModifiedAt: TModTime read fModifiedAt write fModifiedAt;
|
||||
end;
|
||||
|
||||
TSQLSomeone = class(TSQLRecordTimeStamped)
|
||||
private
|
||||
fFirstName: RawUTF8;
|
||||
fFamilyName: RawUTF8;
|
||||
fBirthDate: TDateTime;
|
||||
fEmail: RawUTF8;
|
||||
fVerified: boolean;
|
||||
fHashedPassword: RawUTF8;
|
||||
fLogonName: RawUTF8;
|
||||
public
|
||||
procedure SetPlainPassword(const PlainPassword: RawUTF8);
|
||||
function CheckPlainPassword(const PlainPassword: RawUTF8): boolean;
|
||||
function Name: RawUTF8;
|
||||
published
|
||||
property LogonName: RawUTF8 index 30 read fLogonName write fLogonName stored AS_UNIQUE;
|
||||
property FirstName: RawUTF8 index 50 read fFirstName write fFirstName;
|
||||
property FamilyName: RawUTF8 index 50 read fFamilyName write fFamilyName;
|
||||
property BirthDate: TDateTime read fBirthDate write fBirthDate;
|
||||
property Email: RawUTF8 index 40 read fEmail write fEmail;
|
||||
property HashedPassword: RawUTF8 index 64 read fHashedPassword write fHashedPassword;
|
||||
property Verified: boolean read fVerified write fVerified;
|
||||
end;
|
||||
|
||||
TSQLAuthorRight = (canComment, canPost, canDelete, canAdministrate);
|
||||
TSQLAuthorRights = set of TSQLAuthorRight;
|
||||
|
||||
TSQLAuthor = class(TSQLSomeone)
|
||||
private
|
||||
fRights: TSQLAuthorRights;
|
||||
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;
|
||||
fContentHtml: boolean;
|
||||
published
|
||||
property Title: RawUTF8 index 120 read fTitle write fTitle;
|
||||
property Content: RawUTF8 read fContent write fContent;
|
||||
property ContentHtml: boolean read fContentHtml write fContentHtml;
|
||||
property Author: TSQLAuthor read fAuthor write fAuthor;
|
||||
property AuthorName: RawUTF8 index 50 read fAuthorName write fAuthorName;
|
||||
end;
|
||||
|
||||
TSQLTags = object
|
||||
Lock: IAutoLocker;
|
||||
Lookup: array of record
|
||||
Ident: RawUTF8;
|
||||
Occurence: integer;
|
||||
end;
|
||||
OrderID: TIntegerDynArray;
|
||||
procedure Init(aRest: TSQLRest);
|
||||
function Get(tagID: integer): RawUTF8;
|
||||
procedure SaveOccurence(aRest: TSQLRest);
|
||||
procedure SortTagsByIdent(var Tags: TIntegerDynArray);
|
||||
function GetAsDocVariantArray: Variant;
|
||||
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 SetPublishedMonth(FromTime: TTimeLog);
|
||||
// note: caller should call Tags.SaveOccurence() to update the DB
|
||||
procedure TagsAddOrdered(aTagID: Integer; var aTags: TSQLTags);
|
||||
published
|
||||
property PublishedMonth: Integer read fPublishedMonth write fPublishedMonth;
|
||||
property Abstract: RawUTF8 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;
|
||||
|
||||
TSQLArticleSearch = class(TSQLRecordFTS4Porter)
|
||||
private
|
||||
fContent: RawUTF8;
|
||||
fTitle: RawUTF8;
|
||||
fAbstract: RawUTF8;
|
||||
published
|
||||
property Title: RawUTF8 read fTitle write fTitle;
|
||||
property Abstract: RawUTF8 read fAbstract write fAbstract;
|
||||
property Content: RawUTF8 read fContent write fContent;
|
||||
end;
|
||||
|
||||
TSQLComment = class(TSQLContent)
|
||||
private
|
||||
fArticle: TSQLArticle;
|
||||
published
|
||||
property Article: TSQLArticle read fArticle write fArticle;
|
||||
end;
|
||||
|
||||
TSQLTag = class(TSQLRecord)
|
||||
private
|
||||
fIdent: RawUTF8;
|
||||
fOccurence: integer;
|
||||
fCreatedAt: TCreateTime;
|
||||
published
|
||||
property Ident: RawUTF8 index 80 read fIdent write fIdent;
|
||||
property Occurence: Integer read fOccurence write fOccurence;
|
||||
property CreatedAt: TCreateTime read fCreatedAt write fCreatedAt;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function CreateModel: TSQLModel;
|
||||
|
||||
procedure DotClearFlatImport(Rest: TSQLRest; const aFlatFile: RawUTF8;
|
||||
var aTagsLookup: TSQLTags; const aDotClearRoot: RawUTF8;
|
||||
const aStaticFolder: TFileName);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SynCrtSock; // for DotClearFlatImport() below
|
||||
|
||||
function CreateModel: TSQLModel;
|
||||
begin
|
||||
result := TSQLModel.Create([TSQLBlogInfo,TSQLAuthor,
|
||||
TSQLTag,TSQLArticle,TSQLComment,TSQLArticleSearch],'blog');
|
||||
TSQLArticle.AddFilterNotVoidText(['Title','Content']);
|
||||
TSQLComment.AddFilterNotVoidText(['Title','Content']);
|
||||
TSQLTag.AddFilterNotVoidText(['Ident']);
|
||||
result.Props[TSQLArticleSearch].FTS4WithoutContent(TSQLArticle);
|
||||
end;
|
||||
|
||||
|
||||
{ TSQLSomeone }
|
||||
|
||||
const
|
||||
SALT = 'mORMot';
|
||||
|
||||
function TSQLSomeone.CheckPlainPassword(const PlainPassword: RawUTF8): boolean;
|
||||
begin
|
||||
result := fHashedPassword=SHA256(SALT+LogonName+PlainPassword);
|
||||
end;
|
||||
|
||||
function TSQLSomeone.Name: RawUTF8;
|
||||
begin
|
||||
result := FirstName+' '+FamilyName;
|
||||
end;
|
||||
|
||||
procedure TSQLSomeone.SetPlainPassword(const PlainPassword: RawUTF8);
|
||||
begin
|
||||
fHashedPassword := SHA256(SALT+LogonName+PlainPassword);
|
||||
end;
|
||||
|
||||
|
||||
{ TSQLAuthor }
|
||||
|
||||
class procedure TSQLAuthor.InitializeTable(Server: TSQLRestServer;
|
||||
const FieldName: RawUTF8; Options: TSQLInitializeTableOptions);
|
||||
var Auth: TSQLAuthor;
|
||||
begin
|
||||
inherited InitializeTable(Server,FieldName,Options);
|
||||
if FieldName='' then begin // new table -> create default Author
|
||||
Auth := TSQLAuthor.Create;
|
||||
try
|
||||
Auth.LogonName := 'synopse';
|
||||
Auth.SetPlainPassword('synopse');
|
||||
Auth.FamilyName := 'Synopse';
|
||||
Auth.Verified := true;
|
||||
Auth.Rights := [Low(TSQLAuthorRight)..High(TSQLAuthorRight)];
|
||||
Server.Add(Auth,true);
|
||||
finally
|
||||
Auth.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TSQLArticle }
|
||||
|
||||
class function TSQLArticle.CurrentPublishedMonth: Integer;
|
||||
var Y,M,D: word;
|
||||
begin
|
||||
DecodeDate(NowUTC,Y,M,D);
|
||||
result := integer(Y)*12+integer(M)-1;
|
||||
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.SetPublishedMonth(FromTime: TTimeLog);
|
||||
begin
|
||||
fPublishedMonth := TTimeLogBits(FromTime).Year*12+TTimeLogBits(FromTime).Month-1;
|
||||
end;
|
||||
|
||||
procedure TSQLArticle.TagsAddOrdered(aTagID: Integer; var aTags: TSQLTags);
|
||||
begin
|
||||
if (aTagID<length(aTags.Lookup)) and
|
||||
AddInteger(fTags,aTagID,true) then
|
||||
with aTags.Lock.ProtectMethod do begin
|
||||
inc(aTags.Lookup[aTagID-1].Occurence);
|
||||
aTags.SortTagsByIdent(fTags);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TSQLTags }
|
||||
|
||||
function TSQLTags.Get(tagID: integer): RawUTF8;
|
||||
begin
|
||||
if (tagID>0) and (tagID<=Length(Lookup)) then
|
||||
result := Lookup[tagID-1].Ident else
|
||||
result := '';
|
||||
end;
|
||||
|
||||
function TSQLTags.GetAsDocVariantArray: Variant;
|
||||
var i,ndx: Integer;
|
||||
begin
|
||||
TDocVariant.NewFast(result);
|
||||
with Lock.ProtectMethod do
|
||||
for i := 0 to length(OrderID)-1 do begin
|
||||
ndx := OrderID[i]-1;
|
||||
with Lookup[ndx] do
|
||||
if Occurence>0 then
|
||||
TDocVariantData(result).AddItem(
|
||||
_ObjFast(['tagID',ndx+1,'ident',Ident,'occurence',Occurence]));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLTags.Init(aRest: TSQLRest);
|
||||
var tag: TSQLTag;
|
||||
ID,count,maxID: integer;
|
||||
begin
|
||||
Finalize(Lookup);
|
||||
if Lock=nil then
|
||||
Lock := TAutoLocker.Create;
|
||||
with Lock.ProtectMethod, TAutoFree.One(tag,TSQLTag.CreateAndFillPrepare(
|
||||
aRest,'order by Ident','RowID,Ident,Occurence')) do begin
|
||||
count := tag.FillTable.RowCount;
|
||||
if count=0 then
|
||||
exit;
|
||||
SetLength(OrderID,count);
|
||||
count := 0;
|
||||
maxID := 0;
|
||||
while tag.FillOne do begin
|
||||
ID := tag.ID;
|
||||
OrderID[count] := ID;
|
||||
inc(count);
|
||||
if ID>maxID then
|
||||
maxID := ID;
|
||||
end;
|
||||
SetLength(Lookup,maxID);
|
||||
tag.FillRewind;
|
||||
while tag.FillOne do
|
||||
with Lookup[tag.ID-1] do begin
|
||||
Ident := tag.Ident;
|
||||
Occurence := tag.Occurence;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLTags.SaveOccurence(aRest: TSQLRest);
|
||||
var tag: TSQLTag;
|
||||
batch: TSQLRestBatch;
|
||||
begin
|
||||
with TAutoFree.Several([
|
||||
@tag,TSQLTag.CreateAndFillPrepare(aRest,'','RowID,Occurence'),
|
||||
@batch,TSQLRestBatch.Create(aRest,TSQLTag,1000)]), Lock.ProtectMethod do begin
|
||||
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;
|
||||
end;
|
||||
aRest.BatchSend(batch);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLTags.SortTagsByIdent(var Tags: TIntegerDynArray);
|
||||
var new: TIntegerDynArray;
|
||||
i,n: integer;
|
||||
begin // Lock.ProtectMethod made by caller
|
||||
n := length(Tags);
|
||||
if n=1 then
|
||||
exit;
|
||||
SetLength(new,n);
|
||||
QuickSortInteger(pointer(Tags),0,n-1);
|
||||
n := 0;
|
||||
for i := 0 to length(OrderID)-1 do
|
||||
if FastFindIntegerSorted(Tags,OrderID[i])>=0 then begin
|
||||
new[n] := OrderID[i];
|
||||
inc(n);
|
||||
end;
|
||||
assert(n=length(Tags));
|
||||
Tags := new;
|
||||
end;
|
||||
|
||||
type
|
||||
/// used to store a DotClear flat export data section
|
||||
TDotClearTable = class(TSQLTable)
|
||||
protected
|
||||
fText: RawUTF8;
|
||||
fFields: TRawUTF8DynArray;
|
||||
fJSONResults: array of PUTF8Char;
|
||||
fName: RawUTF8;
|
||||
public
|
||||
/// compute a section content
|
||||
constructor Create(var Text: PUTF8Char);
|
||||
/// parse a DotClear flat export text file, and create a list of sections
|
||||
// - you can later on use aList.GetObjectByName('post') as TDotClearTable
|
||||
// to access a given section
|
||||
class function Parse(const aFlatExport: RawUTF8): TRawUTF8List;
|
||||
/// the name of the section, e.g. 'category' or 'post'
|
||||
property Name: RawUTF8 read fName;
|
||||
end;
|
||||
|
||||
constructor TDotClearTable.Create(var Text: PUTF8Char);
|
||||
var P,D: PUTF8Char;
|
||||
f,r: integer;
|
||||
begin
|
||||
fName := GetNextItem(Text,' ');
|
||||
CSVToRawUTF8DynArray(Pointer(GetNextItem(Text,']')),fFields);
|
||||
fFieldCount := length(fFields);
|
||||
Text := GotoNextLine(Text);
|
||||
P := pointer(Text);
|
||||
while (Text<>nil) and (Text^='"') do begin
|
||||
Text := GotoNextLine(Text);
|
||||
inc(fRowCount);
|
||||
end;
|
||||
if Text=nil then
|
||||
fText := P else
|
||||
SetString(fText,PAnsiChar(P),Text-P);
|
||||
SetLength(fJSONResults,fFieldCount*(fRowCount+1));
|
||||
fResults := pointer(fJSONResults);
|
||||
for f := 0 to fFieldCount-1 do begin
|
||||
fResults[f] := pointer(fFields[f]);
|
||||
SetFieldType(f,sftUTF8Text);
|
||||
end;
|
||||
for r := 1 to fRowCount do begin
|
||||
assert(P^='"');
|
||||
inc(P);
|
||||
for f := 0 to fFieldCount-1 do begin
|
||||
fResults[r*fFieldCount+f] := P;
|
||||
D := P;
|
||||
while P^<>'"' do
|
||||
if P^=#0 then
|
||||
exit else begin
|
||||
if P^='\' then begin
|
||||
inc(P);
|
||||
case P^ of
|
||||
'r': D^ := #13;
|
||||
'n': D^ := #10;
|
||||
'\': D^ := '\';
|
||||
'"': D^ := '"';
|
||||
else begin
|
||||
D^ := '\';
|
||||
inc(D);
|
||||
D^ := P^;
|
||||
end;
|
||||
end;
|
||||
end else
|
||||
D^ := P^;
|
||||
inc(P);
|
||||
inc(D);
|
||||
end;
|
||||
D^ := #0;
|
||||
inc(P);
|
||||
if (P[0]=',')and(P[1]='"') then
|
||||
inc(P,2);
|
||||
end;
|
||||
P := GotoNextLine(P);
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TDotClearTable.Parse(const aFlatExport: RawUTF8): TRawUTF8List;
|
||||
var P: PUTF8Char;
|
||||
T: TDotClearTable;
|
||||
begin
|
||||
result := TRawUTF8List.Create(true);
|
||||
P := pointer(aFlatExport);
|
||||
repeat
|
||||
while (P<>nil) and (P^<>'[') do
|
||||
P := GotoNextLine(P);
|
||||
if P=nil then
|
||||
exit;
|
||||
inc(P);
|
||||
T := TDotClearTable.Create(P);
|
||||
result.AddObject(T.Name,T);
|
||||
//FileFromString(T.GetODSDocument,TFileName(T.Name)+'.ods');
|
||||
until P=nil;
|
||||
end;
|
||||
|
||||
procedure DotClearFlatImport(Rest: TSQLRest; const aFlatFile: RawUTF8;
|
||||
var aTagsLookup: TSQLTags; const aDotClearRoot: RawUTF8;
|
||||
const aStaticFolder: TFileName);
|
||||
var T,tagTable,postTable: TDotClearTable;
|
||||
data,urls: TRawUTF8List;
|
||||
info: TSQLBlogInfo;
|
||||
article: TSQLArticle;
|
||||
comment: TSQLComment;
|
||||
tag: TSQLTag;
|
||||
tags: TRawUTF8DynArray;
|
||||
tagID: TIDDynArray;
|
||||
tagsCount: integer;
|
||||
batch: TSQLRestBatch;
|
||||
PublicFolder: TFileName;
|
||||
notfound: TRawUTF8DynArray;
|
||||
r,ndx,post_url,meta_id,meta_type,tag_post_id,postID,post_id: integer;
|
||||
|
||||
function FixLinks(P: PUTF8Char): RawUTF8;
|
||||
var B,H: PUTF8Char;
|
||||
url,urlnoparam: RawUTF8;
|
||||
i,urlLen,status: integer;
|
||||
pic: RawByteString;
|
||||
FN: TFileName;
|
||||
tag: (href, src);
|
||||
tmp: TTextWriterStackBuffer;
|
||||
|
||||
procedure GetUrl(H: PUTF8Char);
|
||||
var i: integer;
|
||||
begin
|
||||
url := GetNextItem(H,'"');
|
||||
urlLen := length(url);
|
||||
url := UrlDecode(url);
|
||||
i := PosExChar('?',url);
|
||||
if i>0 then
|
||||
urlnoparam := copy(url,1,i-1) else
|
||||
urlnoparam := url;
|
||||
end;
|
||||
|
||||
begin
|
||||
tag := href;
|
||||
with TTextWriter.CreateOwnedStream(tmp) do
|
||||
try
|
||||
B := P;
|
||||
while P<>nil do begin
|
||||
while P^<>' ' do
|
||||
if P^=#0 then
|
||||
break else
|
||||
inc(P);
|
||||
if P^=#0 then
|
||||
break;
|
||||
inc(P);
|
||||
H := P; // makes compiler happy
|
||||
if IdemPChar(P,'HREF="') then begin
|
||||
tag := href;
|
||||
inc(H,6);
|
||||
end else
|
||||
if IdemPChar(P,'SRC="') then begin
|
||||
tag := src;
|
||||
inc(H,5);
|
||||
end else
|
||||
continue;
|
||||
AddNoJSONEscape(B,H-B);
|
||||
P := H;
|
||||
if IdemPChar(P,'HTTP://SYNOPSE.INFO') then begin
|
||||
AddShort('https://synopse.info');
|
||||
inc(P,19);
|
||||
end else if P^='/' then begin
|
||||
if IdemPChar(P+1,'POST/') then begin
|
||||
GetUrl(P+6);
|
||||
i := urls.IndexOf(urlnoparam);
|
||||
if i>=0 then begin
|
||||
AddShort('articleView?id=');
|
||||
Add(i+1);
|
||||
inc(P,urlLen+6);
|
||||
end else
|
||||
AddString(aDotClearRoot);
|
||||
end else
|
||||
if IdemPChar(P+1,'PUBLIC/') then begin
|
||||
if PublicFolder<>'' then begin
|
||||
GetUrl(P+8);
|
||||
FN := PublicFolder+UTF8ToString(StringReplaceChars(url,'/',PathDelim));
|
||||
EnsureDirectoryExists(ExtractFilePath(FN));
|
||||
if not FileExists(FN) then
|
||||
FileFromString(HttpGet(
|
||||
aDotClearRoot+'/public/'+url,nil,{forceNotSocket=}true),FN);
|
||||
AddShort('.static/public/'); // will append 'fullfilename">...'
|
||||
inc(P,8);
|
||||
end else
|
||||
AddString(aDotClearRoot);
|
||||
end;
|
||||
end else if (tag=src) and IdemPChar(P,'HTTP') then begin
|
||||
GetUrl(P);
|
||||
if IdemFileExts(pointer(urlnoparam),['.JP','.PNG','.GIF','.SVG'])>=0 then begin
|
||||
if FindRawUTF8(notfound,url)<0 then begin
|
||||
FN := 'ext-'+Ansi7ToString(MD5(url))+SysUtils.lowercase(ExtractFileExt(UTF8ToString(urlnoparam)));
|
||||
if not FileExists(PublicFolder+FN) then begin
|
||||
write(urlnoparam);
|
||||
pic := HttpGet(url,nil,{forceNotSocket=}true,@status);
|
||||
if (status<>200) or (pic='') or (PosExChar(#0,pic)=0) or
|
||||
IdemPChar(pointer(pic),'<!DOCTYPE') then begin
|
||||
if IdemPChar(pointer(url),'HTTP:') then begin
|
||||
pic := url;
|
||||
insert('s',pic,5);
|
||||
write(' https? ');
|
||||
pic := HttpGet(pic,nil,{forceNotSocket=}true,@status);
|
||||
if (status<>200) or (pic='') or (PosExChar(#0,pic)=0) or
|
||||
IdemPChar(pointer(pic),'<!DOCTYPE') then
|
||||
pic := '';
|
||||
end;
|
||||
end;
|
||||
if pic='' then begin
|
||||
AddRawUTF8(notfound,url);
|
||||
writeln(': KO (',status,')');
|
||||
end else begin
|
||||
writeln(': ',status,' = ',FN);
|
||||
FileFromString(pic,PublicFolder+FN);
|
||||
end;
|
||||
end;
|
||||
AddShort('.static/public/');
|
||||
AddNoJSONEscapeString(FN);
|
||||
inc(P,urlLen);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
B := P;
|
||||
end;
|
||||
AddNoJSONEscape(B);
|
||||
SetText(result);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
var auto1,auto2: IAutoFree; // mandatory only for FPC
|
||||
begin
|
||||
if aStaticFolder<>'' then begin
|
||||
PublicFolder := IncludeTrailingPathDelimiter(aStaticFolder)+'public'+PathDelim;
|
||||
EnsureDirectoryExists(PublicFolder);
|
||||
HTTP_DEFAULT_RESOLVETIMEOUT := 1000; // don't wait forever
|
||||
HTTP_DEFAULT_CONNECTTIMEOUT := 1000;
|
||||
HTTP_DEFAULT_RECEIVETIMEOUT := 2000;
|
||||
end;
|
||||
auto1 := TAutoFree.Several([
|
||||
@data,TDotClearTable.Parse(aFlatFile),
|
||||
@urls,TRawUTF8ListHashed.Create,
|
||||
@batch,TSQLRestBatch.Create(Rest,TSQLTag,5000)]);
|
||||
auto2 := TSQLRecord.AutoFree([ // avoid several try..finally
|
||||
@info,TSQLBlogInfo, @article,TSQLArticle, @comment,TSQLComment, @tag,TSQLTag]);
|
||||
T := data.GetObjectFrom('setting');
|
||||
Rest.Retrieve('',info);
|
||||
info.Copyright := VariantToUTF8(T.GetValue('setting_id','copyright_notice','setting_value'));
|
||||
if info.ID=0 then
|
||||
Rest.Add(info,true) else
|
||||
Rest.Update(info);
|
||||
tagTable := data.GetObjectFrom('meta');
|
||||
tagsCount := 0;
|
||||
meta_id := tagTable.FieldIndexExisting('meta_id');
|
||||
meta_type := tagTable.FieldIndexExisting('meta_type');
|
||||
for r := 1 to tagTable.RowCount do
|
||||
if tagTable.GetU(r,meta_type)='tag' then
|
||||
AddSortedRawUTF8(tags,tagsCount,tagTable.GetU(r,meta_id),nil,-1,@StrIComp);
|
||||
for r := 0 to tagsCount-1 do begin
|
||||
tag.Ident := tags[r];
|
||||
batch.Add(tag,true);
|
||||
end;
|
||||
Rest.BatchSend(batch,tagID);
|
||||
aTagsLookup.Init(Rest); // reload after initial fill
|
||||
batch.Reset(TSQLArticle,5000);
|
||||
tag_post_id := tagTable.FieldIndexExisting('post_id');
|
||||
T.SortFields(tag_post_id,true,nil,sftInteger);
|
||||
postTable := data.GetObjectFrom('post');
|
||||
postTable.SortFields('post_creadt',true,nil,sftDateTime);
|
||||
post_id := postTable.FieldIndexExisting('post_id');
|
||||
post_url := postTable.FieldIndexExisting('post_url');
|
||||
if postTable.Step(true) then
|
||||
repeat
|
||||
urls.Add(postTable.FieldBuffer(post_url));
|
||||
until not postTable.Step;
|
||||
article.Author := TSQLAuthor(1);
|
||||
article.AuthorName := 'synopse';
|
||||
article.ContentHtml := true;
|
||||
for r := 1 to postTable.RowCount do begin
|
||||
article.Title := postTable.GetU(r,'post_title');
|
||||
article.Abstract := FixLinks(postTable.Get(r,'post_excerpt_xhtml'));
|
||||
article.Content := FixLinks(postTable.Get(r,'post_content_xhtml'));
|
||||
if article.Abstract='' then begin
|
||||
article.Abstract := article.Content;
|
||||
article.Content := '';
|
||||
end;
|
||||
article.CreatedAt := Iso8601ToTimeLog(postTable.GetU(r,'post_creadt'));
|
||||
article.ModifiedAt := Iso8601ToTimeLog(postTable.GetU(r,'post_upddt'));
|
||||
article.SetPublishedMonth(article.CreatedAt);
|
||||
postID := postTable.GetAsInteger(r,post_id);
|
||||
article.Tags := nil;
|
||||
if tagTable.Step(true) then
|
||||
repeat
|
||||
if tagTable.FieldAsInteger(tag_post_id)=postID then begin
|
||||
ndx := FastFindPUTF8CharSorted(
|
||||
pointer(tags),high(tags),tagTable.FieldBuffer(meta_id),@StrIComp);
|
||||
if ndx>=0 then
|
||||
article.TagsAddOrdered(tagID[ndx],aTagsLookup);
|
||||
end;
|
||||
until not tagTable.Step;
|
||||
batch.Add(article,true,false,[],true);
|
||||
end;
|
||||
Rest.BatchSend(batch);
|
||||
aTagsLookup.SaveOccurence(Rest);
|
||||
writeln(#13#10'-- import finished!');
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
75
contrib/mORMot/SQLite3/Samples/30 - MVC Server/MVCServer.dpr
Normal file
75
contrib/mORMot/SQLite3/Samples/30 - MVC Server/MVCServer.dpr
Normal file
@@ -0,0 +1,75 @@
|
||||
/// MVC sample web application, publishing a simple BLOG
|
||||
program MVCServer;
|
||||
|
||||
{$ifdef Linux}
|
||||
{$ifdef FPC_CROSSCOMPILING}
|
||||
{$ifdef CPUARM}
|
||||
//if GUI, then uncomment
|
||||
//{$linklib GLESv2}
|
||||
{$endif}
|
||||
{$linklib libc_nonshared.a}
|
||||
{$endif}
|
||||
{$endif}
|
||||
|
||||
{$ifdef MSWINDOWS}
|
||||
{$APPTYPE CONSOLE}
|
||||
{$endif MSWINDOWS}
|
||||
|
||||
{$I Synopse.inc} // define HASINLINE WITHLOG ONLYUSEHTTPSOCKET
|
||||
|
||||
uses
|
||||
{$I SynDprUses.inc} // will enable FastMM4 prior to Delphi 2006
|
||||
SysUtils,
|
||||
SynCrtSock,
|
||||
SynCommons,
|
||||
SynTable,
|
||||
SynLog,
|
||||
mORMot,
|
||||
SynSQLite3,
|
||||
SynSQLite3Static,
|
||||
mORMotSQLite3,
|
||||
mORMotHttpServer,
|
||||
mORMotMVC,
|
||||
MVCModel in 'MVCModel.pas',
|
||||
MVCViewModel in 'MVCViewModel.pas';
|
||||
|
||||
var aModel: TSQLModel;
|
||||
aServer: TSQLRestServerDB;
|
||||
aApplication: TBlogApplication;
|
||||
aHTTPServer: TSQLHttpServer;
|
||||
begin
|
||||
//with TSQLLog.Family do Level := LOG_VERBOSE;
|
||||
aModel := CreateModel;
|
||||
try
|
||||
aServer := TSQLRestServerDB.Create(aModel,ChangeFileExt(ExeVersion.ProgramFileName,'.db'));
|
||||
try
|
||||
aServer.DB.Synchronous := smNormal;
|
||||
aServer.DB.LockingMode := lmExclusive;
|
||||
aServer.CreateMissingTables;
|
||||
aApplication := TBlogApplication.Create;
|
||||
try
|
||||
aApplication.Start(aServer);
|
||||
aHTTPServer := TSQLHttpServer.Create('8092',aServer
|
||||
{$ifndef ONLYUSEHTTPSOCKET},'+',useHttpApiRegisteringURI{$endif});
|
||||
try
|
||||
aHTTPServer.RootRedirectToURI('blog/default'); // redirect / to blog/default
|
||||
aServer.RootRedirectGet := 'blog/default'; // redirect blog to blog/default
|
||||
writeln('"MVC Blog Server" launched on port 8092 using ',aHttpServer.HttpServer.ClassName);
|
||||
writeln(#10'You can check http://localhost:8092/blog/mvc-info for information');
|
||||
writeln('or point to http://localhost:8092 to access the web app.');
|
||||
writeln(#10'Press [Enter] to close the server.'#10);
|
||||
readln;
|
||||
writeln('HTTP server shutdown...');
|
||||
finally
|
||||
aHTTPServer.Free;
|
||||
end;
|
||||
finally
|
||||
aApplication.Free;
|
||||
end;
|
||||
finally
|
||||
aServer.Free;
|
||||
end;
|
||||
finally
|
||||
aModel.Free;
|
||||
end;
|
||||
end.
|
||||
@@ -0,0 +1,102 @@
|
||||
/// MVC sample web application, publishing a simple BLOG and PostgreSQL as DB
|
||||
program MVCServerFirebird;
|
||||
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
|
||||
// please select one of the two! :)
|
||||
{$define USEZEOSFIREBIRD}
|
||||
{.$define USEFIREDACFIREBIRD}
|
||||
|
||||
uses
|
||||
{$I SynDprUses.inc} // will enable FastMM4 prior to Delphi 2006
|
||||
SynCrtSock,
|
||||
SynCommons,
|
||||
SynTable,
|
||||
SynLog,
|
||||
mORMot,
|
||||
SynSQLite3,
|
||||
SynSQLite3Static,
|
||||
mORMotSQLite3,
|
||||
mORMotHttpServer,
|
||||
mORMotMVC,
|
||||
SynDB,
|
||||
mORMotDB,
|
||||
{$ifdef USEZEOSFIREBIRD}
|
||||
SynDBZeos,
|
||||
{$endif}
|
||||
{$ifdef USEFIREDACFIREBIRD}
|
||||
SynDBFireDAC,
|
||||
{$ifdef ISDELPHIXE5} FireDAC.Phys.IB, {$else} uADPhysIB, {$endif}
|
||||
{$endif}
|
||||
MVCModel,
|
||||
MVCViewModel,
|
||||
SysUtils;
|
||||
|
||||
var aModel: TSQLModel;
|
||||
{$ifdef USEFIREDACFIREBIRD}
|
||||
aURI: RawUTF8;
|
||||
aDriver: TADPhysIBDriverLink;
|
||||
{$endif}
|
||||
aExternalDB: TSQLDBConnectionPropertiesThreadSafe;
|
||||
aServer: TSQLRestServerDB;
|
||||
aApplication: TBlogApplication;
|
||||
aHTTPServer: TSQLHttpServer;
|
||||
begin
|
||||
with TSQLLog.Family do
|
||||
Level := LOG_VERBOSE;
|
||||
aModel := CreateModel;
|
||||
try
|
||||
{$ifdef USEZEOSFIREBIRD}
|
||||
aExternalDB := TSQLDBZEOSConnectionProperties.Create(
|
||||
TSQLDBZEOSConnectionProperties.URI(dFIREBIRD,'',
|
||||
'..\15 - External DB performance\Firebird\fbembed.dll'),
|
||||
'MVCServerFirebird.fdb','sysdba','masterkey');
|
||||
aExternalDB.ThreadingMode := tmMainConnection; // as expected for FB embedded
|
||||
{$endif}
|
||||
{$ifdef USEFIREDACFIREBIRD}
|
||||
aDriver := TADPhysIBDriverLink.Create(nil);
|
||||
aDriver.VendorLib := '..\15 - External DB performance\Firebird\fbembed.dll';
|
||||
aURI := FIREDAC_PROVIDER[dFirebird];
|
||||
if not FileExists('MVCServerFirebird.fdb') then
|
||||
aURI := aURI+'?CreateDatabase=Yes';
|
||||
aExternalDB := TSQLDBFireDACConnectionProperties.Create(
|
||||
aURI,'MVCServerFirebird.fdb','sysdba','masterkey');
|
||||
{$endif}
|
||||
try
|
||||
VirtualTableExternalRegisterAll(aModel,aExternalDB,[regMapAutoKeywordFields]);
|
||||
aServer := TSQLRestServerDB.Create(aModel,SQLITE_MEMORY_DATABASE_NAME);
|
||||
try
|
||||
aServer.AcquireExecutionMode[execORMGet] := amBackgroundThread;
|
||||
aServer.AcquireExecutionMode[execORMWrite] := amBackgroundThread;
|
||||
aServer.CreateMissingTables;
|
||||
aApplication := TBlogApplication.Create;
|
||||
try
|
||||
aApplication.Start(aServer);
|
||||
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);
|
||||
writeln(#10'You can check http://localhost:8092/blog/mvc-info for information');
|
||||
writeln('or point to http://localhost:8092 to access the web app.');
|
||||
writeln(#10'Press [Enter] to close the server.'#10);
|
||||
readln;
|
||||
finally
|
||||
aHTTPServer.Free;
|
||||
end;
|
||||
finally
|
||||
aApplication.Free;
|
||||
end;
|
||||
finally
|
||||
aServer.Free;
|
||||
end;
|
||||
finally
|
||||
aExternalDB.Free;
|
||||
end;
|
||||
finally
|
||||
aModel.Free;
|
||||
end;
|
||||
{$ifdef USEFIREDACFIREBIRD}
|
||||
aDriver.Free;
|
||||
{$endif}
|
||||
end.
|
||||
@@ -0,0 +1,61 @@
|
||||
/// MVC sample web application, publishing a simple BLOG
|
||||
program MVCServerMongoDB;
|
||||
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
uses
|
||||
{$I SynDprUses.inc} // will enable FastMM4 prior to Delphi 2006
|
||||
SynCrtSock,
|
||||
SynCommons,
|
||||
SynLog,
|
||||
SynTable,
|
||||
mORMot,
|
||||
SynMongoDB,
|
||||
mORMotMongoDB,
|
||||
mORMotHttpServer,
|
||||
mORMotMVC,
|
||||
MVCModel,
|
||||
MVCViewModel,
|
||||
SysUtils;
|
||||
|
||||
var aModel: TSQLModel;
|
||||
aServer: TSQLRestServer;
|
||||
aMongoClient: TMongoClient;
|
||||
aApplication: TBlogApplication;
|
||||
aHTTPServer: TSQLHttpServer;
|
||||
begin
|
||||
aModel := CreateModel;
|
||||
try
|
||||
aServer := TSQLRestServer.Create(aModel);
|
||||
try
|
||||
aServer.LogFamily.Level := LOG_VERBOSE;
|
||||
aMongoClient := TMongoClient.Create('localhost');
|
||||
try
|
||||
StaticMongoDBRegisterAll(aServer,aMongoClient.Open('blog'));
|
||||
aApplication := TBlogApplication.Create;
|
||||
try
|
||||
aApplication.Start(aServer);
|
||||
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);
|
||||
writeln(#10'You can check http://localhost:8092/blog/mvc-info for information');
|
||||
writeln('or point to http://localhost:8092 to access the web app.');
|
||||
writeln(#10'Press [Enter] to close the server.'#10);
|
||||
readln;
|
||||
finally
|
||||
aHTTPServer.Free;
|
||||
end;
|
||||
finally
|
||||
aApplication.Free;
|
||||
end;
|
||||
finally
|
||||
aMongoClient.Free;
|
||||
end;
|
||||
finally
|
||||
aServer.Free;
|
||||
end;
|
||||
finally
|
||||
aModel.Free;
|
||||
end;
|
||||
end.
|
||||
@@ -0,0 +1,89 @@
|
||||
/// MVC sample web application, publishing a simple BLOG and PostgreSQL as DB
|
||||
program MVCServerPostgreSQL;
|
||||
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
|
||||
// please select one of the two! :)
|
||||
{$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
|
||||
|
||||
uses
|
||||
{$I SynDprUses.inc} // will enable FastMM4 prior to Delphi 2006
|
||||
SynCrtSock,
|
||||
SynCommons,
|
||||
SynTable,
|
||||
mORMot,
|
||||
SynSQLite3,
|
||||
SynSQLite3Static,
|
||||
mORMotSQLite3,
|
||||
mORMotHttpServer,
|
||||
mORMotMVC,
|
||||
SynDB,
|
||||
mORMotDB,
|
||||
{$ifdef USEZEOSPOSTGRESQL}
|
||||
SynDBZeos, // use at least R3435 testing-7.2 - see synopse.info/forum
|
||||
{$endif}
|
||||
{$ifdef USEFIREDACPOSTGRESQL}
|
||||
SynDBFireDAC,
|
||||
{$ifdef ISDELPHIXE5} FireDAC.Phys.PG, {$else} uADPhysPG, {$endif}
|
||||
{$endif}
|
||||
MVCModel,
|
||||
MVCViewModel,
|
||||
SysUtils;
|
||||
|
||||
var aModel: TSQLModel;
|
||||
aExternalDB: TSQLDBConnectionPropertiesThreadSafe;
|
||||
aServer: TSQLRestServerDB;
|
||||
aApplication: TBlogApplication;
|
||||
aHTTPServer: TSQLHttpServer;
|
||||
begin
|
||||
aModel := CreateModel;
|
||||
try
|
||||
{$ifdef USEZEOSPOSTGRESQL}
|
||||
aExternalDB := TSQLDBZEOSConnectionProperties.Create(
|
||||
TSQLDBZEOSConnectionProperties.URI(dPostgreSQL,'localhost:5433'),
|
||||
{$endif}
|
||||
{$ifdef USEFIREDACPOSTGRESQL}
|
||||
aExternalDB := TSQLDBFireDACConnectionProperties.Create(
|
||||
'PG?Server=localhost;Port=5433',
|
||||
{$endif}
|
||||
'postgres','postgres','postgresPassword');
|
||||
try
|
||||
aExternalDB.ThreadingMode := tmMainConnection; // force SINGLE connection
|
||||
VirtualTableExternalRegisterAll(aModel,aExternalDB,[regMapAutoKeywordFields]);
|
||||
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;
|
||||
aServer.CreateMissingTables;
|
||||
aApplication := TBlogApplication.Create;
|
||||
try
|
||||
aApplication.Start(aServer);
|
||||
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);
|
||||
writeln(#10'You can check http://localhost:8092/blog/mvc-info for information');
|
||||
writeln('or point to http://localhost:8092 to access the web app.');
|
||||
writeln(#10'Press [Enter] to close the server.'#10);
|
||||
readln;
|
||||
finally
|
||||
aHTTPServer.Free;
|
||||
end;
|
||||
finally
|
||||
aApplication.Free;
|
||||
end;
|
||||
finally
|
||||
aServer.Free;
|
||||
end;
|
||||
finally
|
||||
aExternalDB.Free;
|
||||
end;
|
||||
finally
|
||||
aModel.Free;
|
||||
end;
|
||||
end.
|
||||
491
contrib/mORMot/SQLite3/Samples/30 - MVC Server/MVCViewModel.pas
Normal file
491
contrib/mORMot/SQLite3/Samples/30 - MVC Server/MVCViewModel.pas
Normal file
@@ -0,0 +1,491 @@
|
||||
/// ViewModel/Control interfaces for the MVCServer BLOG sample
|
||||
unit MVCViewModel;
|
||||
|
||||
{$I Synopse.inc} // define HASINLINE WITHLOG ONLYUSEHTTPSOCKET
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Contnrs,
|
||||
Variants,
|
||||
SynCommons,
|
||||
SynLog,
|
||||
SynTests,
|
||||
mORMot,
|
||||
mORMotMVC,
|
||||
MVCModel;
|
||||
|
||||
type
|
||||
/// defines the main ViewModel/Controller commands of the BLOG web site
|
||||
// - typical URI are:
|
||||
// ! blog/main/articleView?id=12 -> view one article
|
||||
// ! blog/main/authorView?id=12 -> information about one author
|
||||
// ! blog/main/login?name=...&plainpassword=... -> log as author
|
||||
// ! blog/main/articlecommit -> article edition commit (ID=0 for new)
|
||||
IBlogApplication = interface(IMVCApplication)
|
||||
['{73B27C06-9DB9-45A2-BEDD-2013CFB609D0}']
|
||||
procedure ArticleView(ID: TID;
|
||||
var WithComments: boolean; Direction: integer; var Scope: variant;
|
||||
out Article: TSQLArticle; out Author: variant;
|
||||
out Comments: TObjectList);
|
||||
procedure AuthorView(
|
||||
var ID: TID; out Author: TSQLAuthor; out Articles: variant);
|
||||
function Login(
|
||||
const LogonName,PlainPassword: RawUTF8): TMVCAction;
|
||||
function Logout: TMVCAction;
|
||||
function ArticleComment(ID: TID; const Title,Comment: RawUTF8): TMVCAction;
|
||||
function ArticleMatch(const Match: RawUTF8): TMVCAction;
|
||||
procedure ArticleEdit(var ID: TID; const Title,Content: RawUTF8;
|
||||
const ValidationError: variant;
|
||||
out Article: TSQLArticle);
|
||||
function ArticleCommit(
|
||||
ID: TID; const Title,Content: RawUTF8): TMVCAction;
|
||||
end;
|
||||
|
||||
/// session information which will be stored on client side within a cookie
|
||||
// - TMVCSessionWithCookies is able to store any record on the client side,
|
||||
// as optimized base64 encoded binary data, without any storage on the server
|
||||
// - before Delphi 2010, TTextWriter.RegisterCustomJSONSerializerFromText() is
|
||||
// called in initialization block below, to allow proper JSON serialization
|
||||
// as needed for fields injection into the Mustache rendering data context
|
||||
TCookieData = packed record
|
||||
AuthorName: RawUTF8;
|
||||
AuthorID: cardinal;
|
||||
AuthorRights: TSQLAuthorRights;
|
||||
end;
|
||||
|
||||
/// implements the ViewModel/Controller of this BLOG web site
|
||||
TBlogApplication = class(TMVCApplication,IBlogApplication)
|
||||
protected
|
||||
fBlogMainInfo: variant;
|
||||
fTagsLookup: TSQLTags;
|
||||
fDefaultData: ILockedDocVariant;
|
||||
fDefaultLastID: TID;
|
||||
fHasFTS: boolean;
|
||||
procedure ComputeMinimalData; virtual;
|
||||
procedure FlushAnyCache; override;
|
||||
procedure GetViewInfo(MethodIndex: integer; out info: variant); override;
|
||||
function GetLoggedAuthorID(Right: TSQLAuthorRight; ContentToFillAuthor: TSQLContent): TID;
|
||||
procedure MonthToText(const Value: variant; out result: variant);
|
||||
procedure TagToText(const Value: variant; out result: variant);
|
||||
public
|
||||
procedure Start(aServer: TSQLRestServer); reintroduce;
|
||||
public
|
||||
procedure Default(var Scope: variant);
|
||||
procedure ArticleView(ID: TID;
|
||||
var WithComments: boolean; Direction: integer; var Scope: variant;
|
||||
out Article: TSQLArticle; out Author: variant;
|
||||
out Comments: TObjectList);
|
||||
procedure AuthorView(
|
||||
var ID: TID; out Author: TSQLAuthor; out Articles: variant);
|
||||
function Login(const LogonName,PlainPassword: RawUTF8): TMVCAction;
|
||||
function Logout: TMVCAction;
|
||||
function ArticleComment(ID: TID; const Title,Comment: RawUTF8): TMVCAction;
|
||||
function ArticleMatch(const Match: RawUTF8): TMVCAction;
|
||||
procedure ArticleEdit(var ID: TID; const Title,Content: RawUTF8;
|
||||
const ValidationError: variant;
|
||||
out Article: TSQLArticle);
|
||||
function ArticleCommit(ID: TID; const Title,Content: RawUTF8): TMVCAction;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
resourcestring
|
||||
sErrorInvalidLogin = 'Wrong logging information';
|
||||
sErrorNeedValidAuthorSession = 'You need to be logged as a valid Author to perform this action';
|
||||
sErrorWriting = 'An error occured during saving the information to the database';
|
||||
|
||||
|
||||
{ TBlogApplication }
|
||||
|
||||
procedure TBlogApplication.Start(aServer: TSQLRestServer);
|
||||
begin
|
||||
fDefaultData := TLockedDocVariant.Create;
|
||||
inherited Start(aServer,TypeInfo(IBlogApplication));
|
||||
fHasFTS := aServer.StaticVirtualTable[TSQLArticle]=nil;
|
||||
fTagsLookup.Init(RestModel);
|
||||
// publish IBlogApplication using Mustache Views (TMVCRunOnRestServer default)
|
||||
fMainRunner := TMVCRunOnRestServer.Create(Self).
|
||||
SetCache('Default',cacheRootIfNoSession,15).
|
||||
SetCache('ArticleView',cacheWithParametersIfNoSession,60).
|
||||
SetCache('AuthorView',cacheWithParametersIgnoringSession,60);
|
||||
with TMVCRunOnRestServer(fMainRunner) do begin
|
||||
PublishOptions := PublishOptions - [cacheStatic];
|
||||
StaticCacheControlMaxAge := 60*30; // 30 minutes
|
||||
end;
|
||||
(TMVCRunOnRestServer(fMainRunner).Views as TMVCViewsMustache).
|
||||
RegisterExpressionHelpers(['MonthToText'],[MonthToText]).
|
||||
RegisterExpressionHelpers(['TagToText'],[TagToText]);
|
||||
ComputeMinimalData;
|
||||
aServer.Cache.SetCache(TSQLAuthor);
|
||||
aServer.Cache.SetCache(TSQLArticle);
|
||||
aServer.Cache.SetCache(TSQLComment);
|
||||
aServer.Cache.SetTimeOut(TSQLArticle,60000);
|
||||
aServer.Cache.SetTimeOut(TSQLComment,60000);
|
||||
with TSQLBlogInfo.Create(RestModel,'') do
|
||||
try
|
||||
fBlogMainInfo := GetSimpleFieldsAsDocVariant(false);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
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
|
||||
if VariantToInteger(Value,tag) then
|
||||
RawUTF8ToVariant(fTagsLookup.Get(tag),result) else
|
||||
SetVariantNull(result);
|
||||
end;
|
||||
|
||||
const
|
||||
// just try with 100000 - and let your WordPress blog engine start to cry...
|
||||
// note that it includes FullText indexation if you use SQLite3 as database!
|
||||
FAKEDATA_ARTICLESCOUNT = 10000;
|
||||
|
||||
procedure TBlogApplication.ComputeMinimalData;
|
||||
var info: TSQLBlogInfo;
|
||||
article: TSQLArticle;
|
||||
comment: TSQLComment;
|
||||
tag: TSQLTag;
|
||||
batch: TSQLRestBatch;
|
||||
n,t: integer;
|
||||
articles,tags,comments: TIDDynArray;
|
||||
tmp: RawUTF8;
|
||||
auto: IAutoFree; // mandatory only for FPC
|
||||
begin
|
||||
auto := TSQLRecord.AutoFree([ // avoid several try..finally
|
||||
@info,TSQLBlogInfo, @article,TSQLArticle, @comment,TSQLComment, @tag,TSQLTag]);
|
||||
if not RestModel.Retrieve('',info) then begin // retrieve first item
|
||||
tmp := StringFromFile('/home/ab/Downloads/2020-06-16-a8003957c2ae6bde5be6ea279c9c9ce4-backup.txt');
|
||||
info.Language := 'en';
|
||||
if tmp<>'' then begin
|
||||
info.Title := 'Synopse Blog';
|
||||
info.Description := 'Articles, announcements, news, updates and more '+
|
||||
'about our Open Source projects';
|
||||
info.About := 'Latest information about Synopse Open Source librairies, '+
|
||||
'mainly the mORMot ORM/SOA/MVC framework, and SynPDF.';
|
||||
end else begin
|
||||
info.Title := 'mORMot BLOG';
|
||||
info.Description := 'Sample Blog Web Application using Synopse mORMot MVC';
|
||||
info.About := TSynTestCase.RandomTextParagraph(10,'!');
|
||||
end;
|
||||
info.About := info.About+#13#10'Website powered by mORMot MVC '+
|
||||
SYNOPSE_FRAMEWORK_VERSION+', compiled with '+GetDelphiCompilerVersion+
|
||||
', running on '+ToText(OSVersion32)+'.';
|
||||
info.Copyright := '©'+ToUTF8(CurrentYear)+'<a href=https://synopse.info>Synopse Informatique</a>';
|
||||
RestModel.Add(info,true);
|
||||
end;
|
||||
if RestModel.TableHasRows(TSQLArticle) then
|
||||
exit;
|
||||
if tmp<>'' then begin
|
||||
DotClearFlatImport(RestModel,tmp,fTagsLookup,'http://blog.synopse.info',
|
||||
(TMVCRunOnRestServer(fMainRunner).Views as TMVCViewsMustache).ViewStaticFolder);
|
||||
exit;
|
||||
end;
|
||||
SetLength(tags,32);
|
||||
for n := 1 to length(tags) do begin
|
||||
tag.Ident := 'Tag'+UInt32ToUtf8(n);
|
||||
tag.IDValue := n*2; // force test TSQLTags layout
|
||||
tags[n-1] := RestModel.Add(tag,true,true);
|
||||
end;
|
||||
fTagsLookup.Init(RestModel); // reload after initial fill
|
||||
batch := TSQLRestBatch.Create(RestModel,TSQLArticle,20000);
|
||||
try
|
||||
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,'.','https://synopse.info');
|
||||
article.Tags := nil;
|
||||
for t := 1 to Random(6) do
|
||||
article.TagsAddOrdered(tags[random(length(tags))],fTagsLookup);
|
||||
batch.Add(article,true);
|
||||
end;
|
||||
if RestModel.BatchSend(batch,articles)=HTTP_SUCCESS then begin
|
||||
fTagsLookup.SaveOccurence(RestModel);
|
||||
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;
|
||||
|
||||
function TBlogApplication.GetLoggedAuthorID(Right: TSQLAuthorRight;
|
||||
ContentToFillAuthor: TSQLContent): TID;
|
||||
var SessionInfo: TCookieData;
|
||||
author: TSQLAuthor;
|
||||
begin
|
||||
result := 0;
|
||||
if (CurrentSession.CheckAndRetrieve(@SessionInfo,TypeInfo(TCookieData))>0) and
|
||||
(Right in SessionInfo.AuthorRights) then
|
||||
with TSQLAuthor.AutoFree(author,RestModel,SessionInfo.AuthorID) do
|
||||
if Right in author.Rights then begin
|
||||
result := SessionInfo.AuthorID;
|
||||
if ContentToFillAuthor<>nil then begin
|
||||
ContentToFillAuthor.Author := pointer(result);
|
||||
ContentToFillAuthor.AuthorName := author.LogonName;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBlogApplication.GetViewInfo(MethodIndex: integer; out info: variant);
|
||||
var archives: variant; // needed to circumvent memory leak bug on FPC
|
||||
begin
|
||||
inherited GetViewInfo(MethodIndex,info);
|
||||
_ObjAddProps(['blog',fBlogMainInfo,
|
||||
'session',CurrentSession.CheckAndRetrieveInfo(TypeInfo(TCookieData))],info);
|
||||
if not fDefaultData.AddExistingProp('archives',info) then begin
|
||||
archives := RestModel.RetrieveDocVariantArray(
|
||||
TSQLArticle,'','group by PublishedMonth order by PublishedMonth desc limit 100',[],
|
||||
'distinct(PublishedMonth),max(RowID)+1 as FirstID');
|
||||
fDefaultData.AddNewProp('archives',archives,info);
|
||||
end;
|
||||
if not fDefaultData.AddExistingProp('tags',info) then
|
||||
fDefaultData.AddNewProp('tags',fTagsLookup.GetAsDocVariantArray,info);
|
||||
end;
|
||||
|
||||
procedure TBlogApplication.FlushAnyCache;
|
||||
begin
|
||||
inherited FlushAnyCache; // call fMainRunner.NotifyContentChanged
|
||||
fDefaultData.Clear;
|
||||
end;
|
||||
|
||||
|
||||
{ TBlogApplication - Commands }
|
||||
|
||||
const
|
||||
ARTICLE_FIELDS = 'RowID,Title,Tags,Abstract,ContentHtml,Author,AuthorName,CreatedAt';
|
||||
ARTICLE_DEFAULT_LIMIT = ' limit 20';
|
||||
ARTICLE_DEFAULT_ORDER: RawUTF8 = 'order by RowID desc'+ARTICLE_DEFAULT_LIMIT;
|
||||
|
||||
procedure TBlogApplication.Default(var Scope: variant);
|
||||
var scop: PDocVariantData;
|
||||
lastID: TID;
|
||||
tag: integer;
|
||||
whereClause,match: RawUTF8;
|
||||
articles: variant;
|
||||
rank: double;
|
||||
begin
|
||||
lastID := 0;
|
||||
tag := 0;
|
||||
rank := 0;
|
||||
scop := _Safe(Scope);
|
||||
if scop^.GetAsRawUTF8('match',match) and fHasFTS then begin
|
||||
if scop^.GetAsDouble('lastrank',rank) then
|
||||
whereClause := 'and rank<? ';
|
||||
whereClause := 'join (select docid,rank(matchinfo(ArticleSearch),1.0,0.7,0.5) as rank '+
|
||||
'from ArticleSearch where ArticleSearch match ? '+whereClause+
|
||||
'order by rank desc'+ARTICLE_DEFAULT_LIMIT+')as r on (r.docid=Article.id)';
|
||||
articles := RestModel.RetrieveDocVariantArray(TSQLArticle,'',whereClause,[match,rank],
|
||||
'id,title,tags,author,authorname,createdat,abstract,contenthtml,rank');
|
||||
with _Safe(articles)^ do
|
||||
if (Kind=dvArray) and (Count>0) then
|
||||
rank := Values[Count-1].rank else
|
||||
rank := 0;
|
||||
scope := _ObjFast(['Articles',articles,'lastrank',rank,'match',match]);
|
||||
exit;
|
||||
end else begin
|
||||
if scop^.GetAsInt64('lastID',Int64(lastID)) then
|
||||
whereClause := 'RowID<?' else
|
||||
whereClause := 'RowID>?'; // will search ID>0 so always true
|
||||
if scop^.GetAsInteger('tag',tag) and (tag>0) then
|
||||
// uses custom function to search in BLOB
|
||||
whereClause := whereClause+' and IntegerDynArrayContains(Tags,?)';
|
||||
end;
|
||||
SetVariantNull(Scope);
|
||||
if (lastID=0) and (tag=0) then begin // use simple cache if no parameters
|
||||
if not fDefaultData.AddExistingProp('Articles',Scope) then begin
|
||||
articles := RestModel.RetrieveDocVariantArray(TSQLArticle,'',
|
||||
ARTICLE_DEFAULT_ORDER,[],ARTICLE_FIELDS,nil,@fDefaultLastID);
|
||||
fDefaultData.AddNewProp('Articles',articles,Scope);
|
||||
end;
|
||||
lastID := fDefaultLastID;
|
||||
end else begin // use more complex request using lastID + tag parameters
|
||||
articles := RestModel.RetrieveDocVariantArray(TSQLArticle,'',
|
||||
whereClause+ARTICLE_DEFAULT_ORDER,[lastID,tag],ARTICLE_FIELDS,nil,@lastID);
|
||||
scope := _ObjFast(['Articles',articles]);
|
||||
end;
|
||||
if lastID>1 then
|
||||
_ObjAddProps(['lastID',lastID, 'tag',tag],Scope);
|
||||
end;
|
||||
|
||||
procedure TBlogApplication.ArticleView(ID: TID;
|
||||
var WithComments: boolean; Direction: integer; var Scope: variant;
|
||||
out Article: TSQLArticle; out Author: variant; out Comments: TObjectList);
|
||||
var newID: Int64;
|
||||
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(HTTP_NOTFOUND);
|
||||
end;
|
||||
|
||||
procedure TBlogApplication.AuthorView(var ID: TID; 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(HTTP_NOTFOUND);
|
||||
end;
|
||||
|
||||
function TBlogApplication.Login(const LogonName, PlainPassword: RawUTF8): TMVCAction;
|
||||
var Author: TSQLAuthor;
|
||||
SessionInfo: TCookieData;
|
||||
begin
|
||||
if CurrentSession.CheckAndRetrieve<>0 then begin
|
||||
GotoError(result,HTTP_BADREQUEST);
|
||||
exit;
|
||||
end;
|
||||
Author := TSQLAuthor.Create(RestModel,'LogonName=?',[LogonName]);
|
||||
try
|
||||
if (Author.ID<>0) and Author.CheckPlainPassword(PlainPassword) then begin
|
||||
SessionInfo.AuthorName := Author.LogonName;
|
||||
SessionInfo.AuthorID := Author.ID;
|
||||
SessionInfo.AuthorRights := Author.Rights;
|
||||
CurrentSession.Initialize(@SessionInfo,TypeInfo(TCookieData));
|
||||
GotoDefault(result);
|
||||
end else
|
||||
GotoError(result,sErrorInvalidLogin);
|
||||
finally
|
||||
Author.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TBlogApplication.Logout: TMVCAction;
|
||||
begin
|
||||
CurrentSession.Finalize;
|
||||
GotoDefault(result);
|
||||
end;
|
||||
|
||||
function TBlogApplication.ArticleComment(ID: TID;
|
||||
const Title,Comment: RawUTF8): TMVCAction;
|
||||
var comm: TSQLComment;
|
||||
AuthorID: TID;
|
||||
error: string;
|
||||
begin
|
||||
with TSQLComment.AutoFree(comm) do begin
|
||||
AuthorID := GetLoggedAuthorID(canComment,comm);
|
||||
if AuthorID=0 then begin
|
||||
GotoError(result,sErrorNeedValidAuthorSession);
|
||||
exit;
|
||||
end;
|
||||
if not RestModel.MemberExists(TSQLArticle,ID) then begin
|
||||
GotoError(result,HTTP_UNAVAILABLE);
|
||||
exit;
|
||||
end;
|
||||
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])],
|
||||
HTTP_BADREQUEST);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TBlogApplication.ArticleMatch(const Match: RawUTF8): TMVCAction;
|
||||
begin
|
||||
if Match='' then
|
||||
GotoError(result,HTTP_NOTMODIFIED) else
|
||||
GotoView(result,'Default',['scope',_ObjFast(['match',Match])]);
|
||||
end;
|
||||
|
||||
procedure TBlogApplication.ArticleEdit(var ID: TID;
|
||||
const Title,Content: RawUTF8; const ValidationError: variant;
|
||||
out Article: TSQLArticle);
|
||||
var AuthorID: PtrUInt;
|
||||
begin
|
||||
AuthorID := GetLoggedAuthorID(canPost,Article);
|
||||
if AuthorID=0 then
|
||||
raise EMVCApplication.CreateGotoError(sErrorNeedValidAuthorSession);
|
||||
if ID<>0 then
|
||||
if not RestModel.Retrieve(ID,Article) then
|
||||
raise EMVCApplication.CreateGotoError(HTTP_UNAVAILABLE) else
|
||||
if Article.Author<>pointer(AuthorID) then
|
||||
raise EMVCApplication.CreateGotoError(sErrorNeedValidAuthorSession);
|
||||
if Title<>'' then
|
||||
Article.Title := Title;
|
||||
if Content<>'' then
|
||||
Article.Content := Content;
|
||||
end;
|
||||
|
||||
function TBlogApplication.ArticleCommit(ID: TID; const Title,Content: RawUTF8): TMVCAction;
|
||||
var Article: TSQLArticle;
|
||||
AuthorID: TID;
|
||||
error: string;
|
||||
begin
|
||||
with TSQLArticle.AutoFree(Article,RestModel,ID) do begin
|
||||
AuthorID := GetLoggedAuthorID(canPost,Article);
|
||||
if AuthorID=0 then begin
|
||||
GotoError(result,sErrorNeedValidAuthorSession);
|
||||
exit;
|
||||
end;
|
||||
FlushAnyCache;
|
||||
Article.Title := Title;
|
||||
Article.Content := Content;
|
||||
if not Article.FilterAndValidate(RestModel,error) then
|
||||
GotoView(result,'ArticleEdit',
|
||||
['ValidationError',error,'ID',ID,
|
||||
'Title',Article.Title,'Content',Article.Content],HTTP_BADREQUEST) else
|
||||
if Article.ID=0 then begin
|
||||
Article.PublishedMonth := TSQLArticle.CurrentPublishedMonth;
|
||||
if RestModel.Add(Article,true)<>0 then
|
||||
GotoView(result,'ArticleView',['ID',Article.ID],HTTP_SUCCESS) else
|
||||
GotoError(result,sErrorWriting);
|
||||
end else
|
||||
RestModel.Update(Article);
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$ifndef DELPHI2010}
|
||||
// manual definition mandatory only if Delphi 2010 RTTI is not available
|
||||
TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(TypeInfo(TSQLAuthorRights));
|
||||
TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TCookieData),
|
||||
'AuthorName RawUTF8 AuthorID cardinal AuthorRights TSQLAuthorRights');
|
||||
{$endif}
|
||||
end.
|
||||
@@ -0,0 +1,167 @@
|
||||
/*
|
||||
* Globals
|
||||
*/
|
||||
|
||||
body {
|
||||
font-family: Georgia, "Times New Roman", Times, serif;
|
||||
color: #555;
|
||||
}
|
||||
|
||||
h1, .h1,
|
||||
h2, .h2,
|
||||
h3, .h3,
|
||||
h4, .h4,
|
||||
h5, .h5,
|
||||
h6, .h6 {
|
||||
margin-top: 0;
|
||||
font-family: "Helvetica Neue", Helvetica, Arial, sans-serif;
|
||||
font-weight: normal;
|
||||
color: #333;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Override Bootstrap's default container.
|
||||
*/
|
||||
|
||||
@media (min-width: 1200px) {
|
||||
.container {
|
||||
width: 970px;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Masthead for nav
|
||||
*/
|
||||
|
||||
.blog-masthead {
|
||||
background-color: #428bca;
|
||||
-webkit-box-shadow: inset 0 -2px 5px rgba(0,0,0,.1);
|
||||
box-shadow: inset 0 -2px 5px rgba(0,0,0,.1);
|
||||
}
|
||||
|
||||
/* Nav links */
|
||||
.blog-nav-item {
|
||||
position: relative;
|
||||
display: inline-block;
|
||||
padding: 10px;
|
||||
font-weight: 500;
|
||||
color: #cdddeb;
|
||||
}
|
||||
.blog-nav-item:hover,
|
||||
.blog-nav-item:focus {
|
||||
color: #fff;
|
||||
text-decoration: none;
|
||||
}
|
||||
|
||||
/* Active state gets a caret at the bottom */
|
||||
.blog-nav .active {
|
||||
color: #fff;
|
||||
}
|
||||
.blog-nav .active:after {
|
||||
position: absolute;
|
||||
bottom: 0;
|
||||
left: 50%;
|
||||
width: 0;
|
||||
height: 0;
|
||||
margin-left: -5px;
|
||||
vertical-align: middle;
|
||||
content: " ";
|
||||
border-right: 5px solid transparent;
|
||||
border-bottom: 5px solid;
|
||||
border-left: 5px solid transparent;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Blog name and description
|
||||
*/
|
||||
|
||||
.blog-header {
|
||||
padding-top: 20px;
|
||||
padding-bottom: 20px;
|
||||
}
|
||||
.blog-title {
|
||||
margin-top: 40px;
|
||||
margin-bottom: 0;
|
||||
font-size: 60px;
|
||||
font-weight: normal;
|
||||
}
|
||||
.blog-description {
|
||||
font-size: 20px;
|
||||
color: #999;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Main column and sidebar layout
|
||||
*/
|
||||
|
||||
.blog-main {
|
||||
font-size: 18px;
|
||||
line-height: 1.5;
|
||||
}
|
||||
|
||||
/* Sidebar modules for boxing content */
|
||||
.sidebar-module {
|
||||
padding: 15px;
|
||||
margin: 0 -15px 15px;
|
||||
}
|
||||
.sidebar-module-inset {
|
||||
padding: 15px;
|
||||
background-color: #f5f5f5;
|
||||
border-radius: 4px;
|
||||
}
|
||||
.sidebar-module-inset p:last-child,
|
||||
.sidebar-module-inset ul:last-child,
|
||||
.sidebar-module-inset ol:last-child {
|
||||
margin-bottom: 0;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/* Pagination */
|
||||
.pager {
|
||||
margin-bottom: 60px;
|
||||
text-align: left;
|
||||
}
|
||||
.pager > li > a {
|
||||
width: 140px;
|
||||
padding: 10px 20px;
|
||||
text-align: center;
|
||||
border-radius: 30px;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Blog posts
|
||||
*/
|
||||
|
||||
.blog-post {
|
||||
margin-bottom: 60px;
|
||||
}
|
||||
.blog-post-title {
|
||||
margin-bottom: 5px;
|
||||
font-size: 40px;
|
||||
}
|
||||
.blog-post-meta {
|
||||
margin-bottom: 20px;
|
||||
color: #999;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Footer
|
||||
*/
|
||||
|
||||
.blog-footer {
|
||||
padding: 40px 0;
|
||||
color: #999;
|
||||
text-align: center;
|
||||
background-color: #f9f9f9;
|
||||
border-top: 1px solid #e5e5e5;
|
||||
}
|
||||
.blog-footer p:last-child {
|
||||
margin-bottom: 0;
|
||||
}
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 510 B |
@@ -0,0 +1,7 @@
|
||||
{{! void template created for the IBlogApplication.ArticleEdit View:
|
||||
defined as
|
||||
procedure ArticleEdit(const ID: integer; const Title: RawUTF8; const Content: RawUTF8; out Article: TSQLArticle);
|
||||
with the following data context:
|
||||
* Main: variant
|
||||
* Article: TSQLArticle
|
||||
}}
|
||||
@@ -0,0 +1,51 @@
|
||||
{{>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="row">
|
||||
<div class="col-sm-8 blog-main">
|
||||
{{#article}}
|
||||
{{#ContentHtml}}{{{abstract}}}{{/ContentHtml}}{{^ContentHtml}}{{{WikiToHtml abstract}}}{{/ContentHtml}}
|
||||
<hr>
|
||||
{{#ContentHtml}}{{{content}}}{{/ContentHtml}}{{^ContentHtml}}{{{WikiToHtml content}}}{{/ContentHtml}}
|
||||
{{/article}}
|
||||
<hr>
|
||||
<ul class="pager">
|
||||
<li class="previous"><a href="ArticleView?id={{Article.ID}}&withComments={{withComments}}&direction=1">← Previous</a></li>
|
||||
<li class="next"><a href="ArticleView?id={{Article.ID}}&withComments={{withComments}}&direction=2">Next →</a></li>
|
||||
</ul>
|
||||
<a name="comments"></a>
|
||||
{{#WithComments}}
|
||||
{{#Comments}}
|
||||
<blockquote>
|
||||
<p><strong>{{Title}}</strong></p>
|
||||
<p>{{#ContentHtml}}{{{Content}}}{{/ContentHtml}}{{^ContentHtml}}{{{WikiToHtml Content}}}{{/ContentHtml}}</p>
|
||||
<footer>Commented on {{TimeLogToText CreatedAt}} by <a href="authorView?id={{Author}}">{{AuthorName}}</a></<footer>
|
||||
</blockquote>
|
||||
<hr>
|
||||
{{/Comments}}
|
||||
{{^Comments}}<blockquote>No comment yet.</blockquote>{{/Comments}}
|
||||
<p><a href="ArticleView?id={{Article.ID}}#comments" class="btn btn-primary btn-sm">Hide Comments</a></p>
|
||||
{{#main.session.AuthorRights.Comment}}
|
||||
<a name="addComment"></a>
|
||||
<form class="form-horizontal" action="ArticleComment#addComment" method="post">
|
||||
<div class="form-group">
|
||||
{{#Scope}}<div class="alert alert-danger">{{CommentError}}</div>{{/Scope}}
|
||||
<input type="hidden" name="id" value={{Article.ID}}>
|
||||
<input type="text" class="form-control" name="title" placeholder="Title" value="{{Scope.CommentTitle}}">
|
||||
<textarea class="form-control" name="comment" rows="7" placeholder="Enter a new comment here">{{Scope.CommentContent}}</textarea>
|
||||
<button type="submit" class="btn btn-primary btn-sm">Add Comment</a>
|
||||
</div>
|
||||
</form>
|
||||
{{/main.session.AuthorRights.Comment}}
|
||||
</p>
|
||||
{{/WithComments}}
|
||||
{{^WithComments}}
|
||||
<p><a href="ArticleView?id={{Article.ID}}&withComments=true#comments" class="btn btn-primary btn-sm">Show Comments</a></p>
|
||||
{{/WithComments}}
|
||||
{{>footer}}
|
||||
@@ -0,0 +1,15 @@
|
||||
{{>header}}
|
||||
{{>masthead}}
|
||||
<div class="blog-header">
|
||||
<h1 class="blog-title">User {{Author.LogonName}}</h1>
|
||||
<div class="lead blog-description">{{Author.FirstName}} {{Author.FamilyName}}
|
||||
</div>
|
||||
</div>
|
||||
<div class="row">
|
||||
<div class="col-sm-8 panel">
|
||||
<div class="panel-heading">Information about <strong>{{Author.LogonName}}</strong></div>
|
||||
<div class="panel-body">
|
||||
{{{TSQLAuthor.HtmlTable Author}}}
|
||||
</div>
|
||||
{{>articlerow}}
|
||||
{{>footer}}
|
||||
@@ -0,0 +1,18 @@
|
||||
{{>header}}
|
||||
{{>masthead}}
|
||||
<div class="blog-header">
|
||||
<h1 class="blog-title">{{main.blog.title}}</h1>
|
||||
<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}}
|
||||
{{#lastrank}}
|
||||
<p><a href="default?scope={lastrank:{{.}},match:{{{JSONQuoteURI match}}}}" class="btn btn-primary btn-sm">Previous Articles</a></p>
|
||||
{{/lastrank}}
|
||||
{{/Scope}}
|
||||
{{>footer}}
|
||||
@@ -0,0 +1,15 @@
|
||||
{{>header}}
|
||||
{{>masthead}}
|
||||
<div class="blog-header">
|
||||
<h1 class="blog-title">Error Page</h1>
|
||||
</div>
|
||||
<div class="blog-main">
|
||||
<p>{{#errorCode}}Low-level <b>#{{errorCode}}</b>{{/errorCode}} Error occurred with the following message:</p>
|
||||
<pre>{{msg}}</pre>
|
||||
{{#exception}}
|
||||
<p>The following Exception did occur:</p>
|
||||
<pre>{{exception}}</pre>
|
||||
{{/exception}}
|
||||
<p>Error context:</p><pre>{{originalErrorContext}}</pre>
|
||||
</div>
|
||||
{{>footer}}
|
||||
@@ -0,0 +1,16 @@
|
||||
{{#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>
|
||||
{{#ContentHtml}}{{{Abstract}}}{{/ContentHtml}}{{^ContentHtml}}{{{WikiToHtml Abstract}}}{{/ContentHtml}}
|
||||
<p><a href=articleView?id={{id}} class="label label-primary">Read More</a></p>
|
||||
</div>
|
||||
{{/articles}}
|
||||
{{^articles}}
|
||||
<div class="blog-post">
|
||||
<p>There is no more article corresponding to this research criteria.</p>
|
||||
</div>
|
||||
{{/articles}}
|
||||
@@ -0,0 +1,29 @@
|
||||
</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">
|
||||
{{#main.archives}}
|
||||
<li><a href="default?scope={lastID:{{FirstID}}}">{{MonthToText PublishedMonth}}</a></li>
|
||||
{{/main.archives}}
|
||||
</ol>
|
||||
</div>
|
||||
<div class="sidebar-module">
|
||||
<h4>Tags</h4>
|
||||
{{#main.tags}}
|
||||
<a href="default?scope={tag:{{tagID}}}" class="btn btn-info btn-xs">{{ident}} <span class="badge">{{occurence}}</span></a>
|
||||
{{/main.tags}}
|
||||
</div>
|
||||
</div>
|
||||
</div><!-- container -->
|
||||
<div class="blog-footer">
|
||||
<p>Proudly using the Open Source <a href="http://mormot.net">mORMot ORM/SOA/MVC Framework</a>.<br>
|
||||
<small>{{{main.blog.copyright}}} - page generated in [[GENERATION_TIME_TAG]]</small></p>
|
||||
<p><a href="#">Back to top</a></p>
|
||||
</div>
|
||||
</body>
|
||||
</html>
|
||||
@@ -0,0 +1,14 @@
|
||||
<!DOCTYPE html>
|
||||
<html lang="{{main.blog.language}}">
|
||||
<head>
|
||||
<meta charset="utf-8">
|
||||
<meta http-equiv="X-UA-Compatible" content="IE=edge">
|
||||
<meta name="ROBOTS" content="INDEX, FOLLOW" />
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
<meta name="description" content="{{main.blog.description}}">
|
||||
<meta name="copyright" content="{{{main.blog.copyright}}}" />
|
||||
<meta name="author" content="{{#Author}}{{FirstName}}{{FamilyName}}{{/Author}}">
|
||||
<link rel="icon" href=".static/blog.ico">
|
||||
<title>{{pageTitle}}{{^pageTitle}}{{main.blog.title}} {{pageName}}{{/pageTitle}}</title>
|
||||
<link href="https://maxcdn.bootstrapcdn.com/bootstrap/3.2.0/css/bootstrap.min.css" rel="stylesheet">
|
||||
<link href=".static/blog.css" rel="stylesheet">
|
||||
@@ -0,0 +1,47 @@
|
||||
</head>
|
||||
<body>
|
||||
<div class="blog-masthead">
|
||||
<div class="navbar navbar-default navbar-fixed-top">
|
||||
<div class="container">
|
||||
<div class="navbar-header">
|
||||
<button class="navbar-toggle" type="button" data-toggle="collapse" data-target="#navbar-main">
|
||||
<span class="icon-bar"></span>
|
||||
<span class="icon-bar"></span>
|
||||
<span class="icon-bar"></span>
|
||||
</button>
|
||||
<div class="navbar-left">
|
||||
<a class="navbar-brand" href="default">{{main.blog.title}}</a>
|
||||
</div>
|
||||
<div class="navbar-form navbar-right">
|
||||
<form action="articleMatch" method="post">
|
||||
<div class="form-group">
|
||||
<input type="text" class="form-control" name="match" placeholder="Search Expression">
|
||||
</div>
|
||||
</form>
|
||||
</div>
|
||||
</div>
|
||||
<center>
|
||||
<div class="navbar-collapse collapse" id="navbar-main">
|
||||
{{#main.session}}
|
||||
<div class="navbar-right">
|
||||
<form class="navbar-form" action="logout">
|
||||
<span class="navbar-text">Signed in as <a href=AuthorView?id={{AuthorID}}>{{AuthorName}}</a></span>
|
||||
<button class="btn" type="submit">Logout</button>
|
||||
</form>
|
||||
</div>
|
||||
{{/main.session}}
|
||||
{{^main.session}}
|
||||
<form class="navbar-form navbar-right" action="login" method="post">
|
||||
<div class="form-group">
|
||||
<input type="text" class="form-control" name="LogonName" placeholder="Username">
|
||||
<input type="password" class="form-control" name="PlainPassword" placeholder="Password">
|
||||
</div>
|
||||
<button type="submit" class="btn btn-default">Sign In</button>
|
||||
</form>
|
||||
{{/main.session}}
|
||||
</div>
|
||||
</center>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="container">
|
||||
Reference in New Issue
Block a user