; ============================================================================ ; DataModel Module - Database and Content Management ; ============================================================================ Module DataModel EnableExplicit UseSQLiteDatabase() ; -- Private Structures -- Structure PublishedArticle Extends Article DefaultName.s EndStructure Structure Template language.s[General::#LanguageCount] EndStructure ; -- Language Configuration -- ; WARNING: Changing languages on an existing DB will break relationships! Language("en") = 1 Language("fr") = 2 ; -- Constants -- #DBFile = "blog.db" #FieldSeparator = Chr(2) #RecordSeparator = Chr(1) #ArticlePerPage = 6 ; -- Private Variables -- Global TemplateArticle.Template Global TemplateIndex.Template Global TemplateBrowse.Template Global TemplateTags.Template Global TemplateLargeCard.Template Global TemplateSmallCard.Template Global TemplateRSS.Template Global TemplateRSSItem.s ; -- Private Procedure Declarations -- Declare LoadAdmin(Path.s) Declare LoadMimeTypes() Declare.s LoadThemeFile(FilePath.s) Declare.s Base64ToString(Base64.s) Declare CalculateReadingTime(Content.s) Declare BuildArticle(Title.s, Content.s, Blurb.s, Image.s, URL.s, language.i) Declare.s BuildCard(Title.s, Blurb.s, Image.s, Date.i, Tags.s, URL.s, Language.i, ReadingTime.i, Large.i) Declare BuildSiteStructure() ; ======================================================================== ; Initialization ; ======================================================================== Procedure InitializeDatabase() If FileSize(#DBFile) > 0 ProcedureReturn EndIf PrintN("[DataModel] Creating new database...") CreateFile(0, #DBFile) CloseFile(0) If OpenDatabase(0, #DBFile, "", "") DatabaseUpdate(0, "CREATE TABLE ArticleID (id INTEGER NOT NULL UNIQUE, default_title TEXT NOT NULL, date INTEGER NOT NULL, tags INTEGER, draft INTEGER, PRIMARY KEY(id AUTOINCREMENT));") DatabaseUpdate(0, "CREATE TABLE Articles (id INTEGER NOT NULL, language_id INTEGER NOT NULL, title TEXT, blurb TEXT, image TEXT, content TEXT, reading_time INTEGER, bluesky_post TEXT);") DatabaseUpdate(0, "CREATE TABLE Data (id INTEGER NOT NULL UNIQUE, name TEXT NOT NULL, binary BLOB NOT NULL, PRIMARY KEY(id AUTOINCREMENT));") DatabaseUpdate(0, "CREATE TABLE TagID (id INTEGER NOT NULL UNIQUE, default_name TEXT NOT NULL, color TEXT, PRIMARY KEY(id AUTOINCREMENT));") DatabaseUpdate(0, "CREATE TABLE Tags (tag_id INTEGER, language_id INTEGER, name TEXT);") CloseDatabase(0) EndIf EndProcedure Procedure LoadThemeTemplates() TemplateRSSItem = LoadThemeFile("theme/rss_item.xml") ; English templates TemplateArticle\language[0] = LoadThemeFile("theme/article.html") TemplateIndex\language[0] = LoadThemeFile("theme/index.html") TemplateBrowse\language[0] = LoadThemeFile("theme/browse.html") TemplateLargeCard\language[0] = LoadThemeFile("theme/card_large.html") TemplateSmallCard\language[0] = LoadThemeFile("theme/card_small.html") TemplateTags\language[0] = LoadThemeFile("theme/tag.html") TemplateRSS\language[0] = LoadThemeFile("theme/rss.xml") ; French templates TemplateArticle\language[1] = LoadThemeFile("theme/article.html") TemplateIndex\language[1] = LoadThemeFile("theme/index.html") TemplateBrowse\language[1] = LoadThemeFile("theme/browse.html") TemplateLargeCard\language[1] = LoadThemeFile("theme/card_large.html") TemplateSmallCard\language[1] = LoadThemeFile("theme/card_small.html") TemplateTags\language[1] = LoadThemeFile("theme/tag.html") TemplateRSS\language[1] = LoadThemeFile("theme/rss.xml") EndProcedure Procedure LoadBinariesIntoMemory() If Not DatabaseQuery(0, "SELECT name, binary, id FROM Data") ProcedureReturn EndIf While NextDatabaseRow(0) Protected Key.s = GetDatabaseString(0, 0) AddMapElement(Binaries(), Key) Binaries()\size = DatabaseColumnSize(0, 1) Binaries()\data = AllocateMemory(Binaries()\size, #PB_Memory_NoClear) GetDatabaseBlob(0, 1, Binaries()\data, Binaries()\size) Binaries()\mime = MIMETypes(GetExtensionPart(Key)) Binaries()\ID = GetDatabaseLong(0, 2) Wend FinishDatabaseQuery(0) EndProcedure Procedure LoadTagsIntoMemory() If Not DatabaseQuery(0, "SELECT id, default_name, color FROM TagID ORDER BY id") ProcedureReturn EndIf While NextDatabaseRow(0) AddElement(Tags()) Tags()\ID = GetDatabaseLong(0, 0) Tags()\DefaultName = GetDatabaseString(0, 1) Tags()\Color = GetDatabaseString(0, 2) Wend FinishDatabaseQuery(0) ; Load localized names and compute binary IDs ForEach Tags() Tags()\BinaryID = Pow(2, ListIndex(Tags())) ForEach Language() SetDatabaseLong(0, 0, Tags()\ID) SetDatabaseLong(0, 1, Language()) If DatabaseQuery(0, "SELECT name FROM Tags WHERE tag_id = ? AND language_id = ?") NextDatabaseRow(0) Tags()\Name[Language() - 1] = GetDatabaseString(0, 0) FinishDatabaseQuery(0) EndIf Next Next EndProcedure Procedure LoadArticlesIntoMemory() If Not DatabaseQuery(0, "SELECT default_title, id, draft, tags, date FROM ArticleID") ProcedureReturn EndIf While NextDatabaseRow(0) AddMapElement(Articles(), GetDatabaseString(0, 0)) Articles()\ID = GetDatabaseLong(0, 1) Articles()\Draft = GetDatabaseLong(0, 2) Articles()\Tags = GetDatabaseLong(0, 3) Articles()\Date = GetDatabaseLong(0, 4) Wend FinishDatabaseQuery(0) ; Build article HTML for each language ForEach Articles() ForEach Language() SetDatabaseLong(0, 0, Articles()\ID) SetDatabaseLong(0, 1, Language()) If DatabaseQuery(0, "SELECT title, content, blurb, image FROM Articles WHERE id = ? AND language_id = ?") NextDatabaseRow(0) Articles()\language[Language() - 1]\data = BuildArticle(GetDatabaseString(0, 0), GetDatabaseString(0, 1), GetDatabaseString(0, 2), GetDatabaseString(0, 3), MapKey(Articles()), Language() - 1) Articles()\language[Language() - 1]\size = MemorySize(Articles()\language[Language() - 1]\data) FinishDatabaseQuery(0) EndIf Next Next EndProcedure Procedure OpenRuntimeDatabase() If Not OpenDatabase(0, #DBFile, "", "") PrintN("[Error] Could not open database.") ProcedureReturn #False EndIf LoadBinariesIntoMemory() LoadTagsIntoMemory() LoadArticlesIntoMemory() ProcedureReturn #True EndProcedure Procedure Init() PrintN("[DataModel] Initializing...") LoadMimeTypes() LoadAdmin("admin") InitializeDatabase() LoadThemeTemplates() OpenRuntimeDatabase() BuildSiteStructure() EndProcedure ; ======================================================================== ; Utility Functions ; ======================================================================== Procedure CalculateReadingTime(Content.s) Protected WordCount.i, i, InWord.b = #False Protected Len = Len(Content), Char.s Protected Result ; Count words (simple whitespace-based counting) For i = 1 To Len Char = Mid(Content, i, 1) If Char = " " Or Char = Chr(10) Or Char = Chr(13) Or Char = Chr(9) InWord = #False ElseIf Not InWord WordCount + 1 InWord = #True EndIf Next Result = Round(WordCount / 250, #PB_Round_Up) ; 250 words per minute is the upper limit of average reading speed. If Result < 1 Result = 1 EndIf ; Calculate reading time in minutes (minimum 1 minute) ProcedureReturn Result EndProcedure Procedure.s MakeUUID() Protected i, GUID.s For i = 0 To 15 GUID + RSet(Hex(Random(255), #PB_Byte), 2, "0") Next ProcedureReturn GUID EndProcedure Procedure.s Base64ToString(Base64.s) Protected *Data, Result.s, Len Len = (StringByteLength(Base64) * 4) / 5 If Len *Data = AllocateMemory(Len) Base64Decoder(Base64, *Data, Len) Result = PeekS(*Data, -1, #PB_UTF8) FreeMemory(*Data) EndIf ProcedureReturn Result EndProcedure Procedure.s LoadThemeFile(FilePath.s) Protected File, Size, *Buffer, Result.s Size = FileSize(FilePath) If Size <= 0 PrintN("[Error] Theme file not found or empty: " + FilePath) ProcedureReturn "" EndIf File = ReadFile(#PB_Any, FilePath) If Not File PrintN("[Error] Could not read theme file: " + FilePath) ProcedureReturn "" EndIf *Buffer = AllocateMemory(Size + 2) ReadData(File, *Buffer, Size) CloseFile(File) Result = PeekS(*Buffer, Size, #PB_UTF8 | #PB_ByteLength) FreeMemory(*Buffer) ProcedureReturn Result EndProcedure Procedure LoadMimeTypes() Protected.s Ext, Type Restore MimeData Read.s Ext While Ext <> "END" Read.s Type MIMETypes(Ext) = Type Read.s Ext Wend EndProcedure Procedure LoadAdmin(Path.s) Protected Size, File, FullPath.s, Dir, EntryName.s Path = ReplaceString(Path, "\", "/") If Right(Path, 1) <> "/" Path + "/" EndIf Dir = ExamineDirectory(#PB_Any, Path, "*.*") If Not Dir ProcedureReturn EndIf While NextDirectoryEntry(Dir) EntryName = DirectoryEntryName(Dir) If EntryName = "." Or EntryName = ".." Continue EndIf FullPath = Path + EntryName Size = FileSize(FullPath) If Size = -2 ; Directory LoadAdmin(FullPath) ElseIf FindMapElement(MIMETypes(), GetExtensionPart(EntryName)) AddMapElement(AdminBinaries(), "/" + FullPath, #PB_Map_NoElementCheck) AdminBinaries()\size = Size AdminBinaries()\data = AllocateMemory(Size, #PB_Memory_NoClear) AdminBinaries()\mime = MIMETypes(GetExtensionPart(EntryName)) File = ReadFile(#PB_Any, FullPath) If File ReadData(File, AdminBinaries()\data, Size) CloseFile(File) EndIf EndIf Wend FinishDirectory(Dir) EndProcedure ; ======================================================================== ; Article Operations ; ======================================================================== Procedure.s CreateArticle() Protected Result.s, ID, Title.s, *Article, Size, Date, Counter ; Generate unique default name Title = "new_article" While FindMapElement(Articles(), Title) Counter + 1 Title = "new_article_" + Str(Counter) Wend SetDatabaseString(0, 0, Title) Date = Date() SetDatabaseLong(0, 1, Date) If Not DatabaseUpdate(0, "INSERT INTO ArticleID (default_title, date, draft) values (?, ?, 1);") ProcedureReturn "" EndIf If Not DatabaseQuery(0, "SELECT id, default_title, draft, tags FROM ArticleID ORDER BY id DESC LIMIT 1") ProcedureReturn "" EndIf NextDatabaseRow(0) ID = GetDatabaseLong(0, 0) Title = GetDatabaseString(0, 1) Result = Str(ID) + #FieldSeparator Result + Title + #FieldSeparator Result + Str(GetDatabaseLong(0, 2)) + #FieldSeparator Result + Str(GetDatabaseLong(0, 3)) + #FieldSeparator Result + Str(Date) + #RecordSeparator FinishDatabaseQuery(0) AddMapElement(Articles(), Title) Articles()\ID = ID Articles()\Date = Date ; Create empty content for each language ForEach Language() Articles()\language[Language() - 1]\data = BuildArticle("", "", "", "", Title,Language() - 1) Articles()\language[Language() - 1]\size = Size SetDatabaseLong(0, 0, ID) SetDatabaseLong(0, 1, Language()) SetDatabaseLong(0, 2, 1) ; Default 1 minute reading time DatabaseUpdate(0, "INSERT INTO Articles (id, language_id, reading_time) values (?, ?, ?);") Next ProcedureReturn Result EndProcedure Procedure.s GetArticle(ID) Protected Result.s SetDatabaseLong(0, 0, ID) If DatabaseQuery(0, "SELECT title, image, blurb, content FROM Articles WHERE id = ? ORDER BY language_id ASC") While NextDatabaseRow(0) Result + GetDatabaseString(0, 0) + #FieldSeparator Result + GetDatabaseString(0, 1) + #FieldSeparator Result + GetDatabaseString(0, 2) + #FieldSeparator Result + GetDatabaseString(0, 3) + #RecordSeparator Wend FinishDatabaseQuery(0) EndIf ProcedureReturn Result EndProcedure Procedure.s ListArticles() Protected Result.s If DatabaseQuery(0, "SELECT id, default_title, draft, tags, date FROM ArticleID ORDER BY id ASC") While NextDatabaseRow(0) Result + Str(GetDatabaseLong(0, 0)) + #FieldSeparator Result + GetDatabaseString(0, 1) + #FieldSeparator Result + Str(GetDatabaseLong(0, 2)) + #FieldSeparator Result + Str(GetDatabaseLong(0, 3)) + #FieldSeparator Result + Str(GetDatabaseLong(0, 4)) + #RecordSeparator Wend FinishDatabaseQuery(0) EndIf ProcedureReturn Result EndProcedure Procedure UpdateArticle(TextBundle.s) Protected Entry.s, Loop, Count, ID Protected Draft, Title.s, Content.s, ReadingTime.i, Image.s, Blurb.s Protected Rebuild.b, BlueSkyUpdate.b, BlueSkyPost.s, BlueSkyPostID.s, BlobRef.s, BlueSkyMessage.s Count = CountString(TextBundle, #RecordSeparator) Entry = StringField(TextBundle, 1, #RecordSeparator) ID = Val(StringField(Entry, 1, #FieldSeparator)) Title = StringField(Entry, 2, #FieldSeparator) Draft = Val(StringField(Entry, 3, #FieldSeparator)) ; Find existing article ForEach Articles() If Articles()\ID = ID Break EndIf Next If Articles()\Draft = #False Or Draft <> Articles()\Draft Rebuild = #True EndIf If Draft = #False And Articles()\Draft = #True BlueSkyUpdate = #True EndIf ; Free old content ForEach Language() FreeMemory(Articles()\language[Language() - 1]\data) Next ; Handle title change (map key change) If Title <> MapKey(Articles()) DeleteMapElement(Articles()) AddMapElement(Articles(), Title) Articles()\ID = ID EndIf ; Update metadata Articles()\Draft = Draft Articles()\Tags = Val(StringField(Entry, 4, #FieldSeparator)) Articles()\Date = Val(StringField(Entry, 5, #FieldSeparator)) ; Update database SetDatabaseString(0, 0, Title) SetDatabaseLong(0, 1, Articles()\Draft) SetDatabaseLong(0, 2, Articles()\Tags) SetDatabaseLong(0, 3, Articles()\Date) SetDatabaseLong(0, 4, ID) DatabaseUpdate(0, "UPDATE ArticleID SET default_title = ?, draft = ?, tags = ?, date = ? WHERE id = ?") ; Update each language's content For Loop = 2 To Count Entry = StringField(TextBundle, Loop, #RecordSeparator) Title = Base64ToString(StringField(Entry, 1, #FieldSeparator)) Image = Base64ToString(StringField(Entry, 2, #FieldSeparator)) Blurb = Base64ToString(StringField(Entry, 3, #FieldSeparator)) Content = Base64ToString(StringField(Entry, 4, #FieldSeparator)) ReadingTime = CalculateReadingTime(Content) SetDatabaseString(0, 0, Title) SetDatabaseString(0, 1, Image) SetDatabaseString(0, 2, Blurb) SetDatabaseString(0, 3, Content) SetDatabaseLong(0, 4, ReadingTime) SetDatabaseLong(0, 5, ID) SetDatabaseLong(0, 6, Loop - 1) DatabaseUpdate(0, "UPDATE Articles SET title = ?, image = ?, blurb = ?, content = ?, reading_time = ? WHERE id = ? AND language_id = ?") Articles()\language[Loop - 2]\data = BuildArticle(Title, Content, Blurb, Image, MapKey(Articles()), Loop - 2) Articles()\language[Loop - 2]\size = MemorySize(Articles()\language[Loop - 2]\data) Next If BlueSkyUpdate Loop = 0 ForEach Language() BlueSkyPost = "" If General::BlueSky(Loop)\Enabled SetDatabaseLong(0, 0, ID) SetDatabaseLong(0, 1, Language()) If DatabaseQuery(0, "SELECT title, image FROM Articles WHERE id = ? AND language_id = ?") If NextDatabaseRow(0) Title = GetDatabaseString(0, 0) Image = GetDatabaseString(0, 1) BlueSkyPost = GetDatabaseString(0, 2) EndIf FinishDatabaseQuery(0) EndIf If BlueSkyPost = "" BlobRef = "" If Image And FindMapElement(Binaries(), Image) BlobRef = BlueskyAPI::UploadBlob(General::@BlueSky(Loop)\Session, Binaries()\data, Binaries()\size, Binaries()\mime) EndIf BlueSkyMessage = General::BlueSky(Loop)\Message BlueSkyMessage = ReplaceString(BlueSkyMessage, "SH:TITLE", Title) BlueSkyMessage = ReplaceString(BlueSkyMessage, "SH:URL", General::#Address + "article?" + MapKey(Articles())) BlueSkyPostID = BlueskyAPI::CreatePost(General::@BlueSky(Loop)\Session, BlueSkyMessage, MapKey(Language()), BlobRef) If BlueSkyPostID SetDatabaseString(0, 0, BlueskyAPI::GetPostURL(General::BlueSky(Loop)\Handle, BlueSkyPostID)) SetDatabaseLong(0, 1, ID) SetDatabaseLong(0, 2, Language()) DatabaseUpdate(0, "UPDATE Articles SET bluesky_post = ? WHERE id = ? AND language_id = ?") EndIf EndIf EndIf Loop + 1 Next EndIf If Rebuild BuildSiteStructure() EndIf ProcedureReturn #True EndProcedure Procedure.s PreviewArticle(TextBundle.s) Protected Title.s, Content.s Title = Base64ToString(StringField(TextBundle, 1, #FieldSeparator)) Content = Base64ToString(StringField(TextBundle, 2, #FieldSeparator)) FreeMemory(*PreviewData) *PreviewData = BuildArticle(Title, Content, "", "", "", 0) PreviewSize = MemorySize(*PreviewData) PreviewUUID = MakeUUID() ProcedureReturn PreviewUUID EndProcedure Procedure DeleteArticle(ID) Protected Rebuild.b ; Delete from Articles table (content) SetDatabaseLong(0, 0, ID) DatabaseUpdate(0, "DELETE FROM Articles WHERE id = ?") ; Delete from ArticleID table (metadata) SetDatabaseLong(0, 0, ID) If Not DatabaseUpdate(0, "DELETE FROM ArticleID WHERE id = ?") ProcedureReturn #False EndIf ; Remove from memory cache ForEach Articles() If Articles()\ID = ID If Articles()\Draft = #False Rebuild = #True EndIf ; Free article content memory for each language ForEach Language() If Articles()\language[Language() - 1]\data FreeMemory(Articles()\language[Language() - 1]\data) EndIf Next DeleteMapElement(Articles()) Break EndIf Next If Rebuild BuildSiteStructure() EndIf ProcedureReturn #True EndProcedure ; ======================================================================== ; File Operations ; ======================================================================== Procedure.s ListFiles() Protected Result.s If DatabaseQuery(0, "SELECT id, name FROM Data ORDER BY id ASC") While NextDatabaseRow(0) Result + Str(GetDatabaseLong(0, 0)) + #FieldSeparator Result + GetDatabaseString(0, 1) + #RecordSeparator Wend FinishDatabaseQuery(0) EndIf ProcedureReturn Result EndProcedure Procedure.s NewFile(Name.s, Base64File.s) Protected Result.s, *Data, Size Size = StringByteLength(Base64File) If Not Size ProcedureReturn "" EndIf *Data = AllocateMemory(Size) Size = Base64Decoder(Base64File, *Data, Size) SetDatabaseString(0, 0, Name) SetDatabaseBlob(0, 1, *Data, Size) If Not DatabaseUpdate(0, "INSERT INTO Data (name, binary) values (?, ?);") FreeMemory(*Data) ProcedureReturn "" EndIf ; Add to memory cache AddMapElement(Binaries(), Name) Binaries()\size = Size Binaries()\data = AllocateMemory(Binaries()\size, #PB_Memory_NoClear) CopyMemory(*Data, Binaries()\data, Binaries()\size) Binaries()\mime = MIMETypes(GetExtensionPart(Name)) ; Get the assigned ID DatabaseQuery(0, "SELECT id, name FROM Data ORDER BY id DESC LIMIT 1") NextDatabaseRow(0) Binaries()\ID = GetDatabaseLong(0, 0) Result = Str(Binaries()\ID) + #FieldSeparator + GetDatabaseString(0, 1) FinishDatabaseQuery(0) FreeMemory(*Data) ProcedureReturn Result EndProcedure Procedure DeleteAFile(ID) SetDatabaseLong(0, 0, ID) If Not DatabaseUpdate(0, "DELETE FROM Data WHERE id = ?") ProcedureReturn #False EndIf ; Remove from memory cache ForEach Binaries() If Binaries()\ID = ID FreeMemory(Binaries()\data) DeleteMapElement(Binaries()) Break EndIf Next ProcedureReturn #True EndProcedure ; ======================================================================== ; Tag Operations ; ======================================================================== Procedure.s ListTags() Protected Result.s If DatabaseQuery(0, "SELECT id, default_name, color FROM TagID ORDER BY id ASC") While NextDatabaseRow(0) Result + Str(GetDatabaseLong(0, 0)) + #FieldSeparator Result + GetDatabaseString(0, 1) + #FieldSeparator Result + GetDatabaseString(0, 2) + #RecordSeparator Wend FinishDatabaseQuery(0) EndIf ProcedureReturn Result EndProcedure Procedure.s CreateTag() Protected Result.s, ID, DefaultName.s, Counter = 0 DefaultName = "new_tag" ForEach Tags() If Tags()\DefaultName = DefaultName Counter + 1 DefaultName = "new_tag_" + Str(Counter) ResetList(Tags()) ; Restart check with new name EndIf Next SetDatabaseString(0, 0, DefaultName) SetDatabaseString(0, 1, "#000000") If Not DatabaseUpdate(0, "INSERT INTO TagID (default_name, color) values (?, ?);") ProcedureReturn "" EndIf If Not DatabaseQuery(0, "SELECT id, default_name, color FROM TagID ORDER BY id DESC LIMIT 1") ProcedureReturn "" EndIf NextDatabaseRow(0) ID = GetDatabaseLong(0, 0) Result = Str(ID) + #FieldSeparator Result + GetDatabaseString(0, 1) + #FieldSeparator Result + GetDatabaseString(0, 2) + #RecordSeparator FinishDatabaseQuery(0) AddElement(Tags()) Tags()\ID = ID Tags()\DefaultName = "new_tag" Tags()\Color = "#000000" ; Create language entries ForEach Language() SetDatabaseLong(0, 0, ID) SetDatabaseLong(0, 1, Language()) SetDatabaseString(0, 2, "") DatabaseUpdate(0, "INSERT INTO Tags (tag_id, language_id, name) values (?, ?, ?);") Next ProcedureReturn Result EndProcedure Procedure.s GetTag(ID) Protected Result.s ; Get tag metadata SetDatabaseLong(0, 0, ID) If DatabaseQuery(0, "SELECT default_name, color FROM TagID WHERE id = ?") If NextDatabaseRow(0) Result + GetDatabaseString(0, 0) + #FieldSeparator Result + GetDatabaseString(0, 1) + #RecordSeparator EndIf FinishDatabaseQuery(0) EndIf ; Get localized names ForEach Language() SetDatabaseLong(0, 0, ID) SetDatabaseLong(0, 1, Language()) If DatabaseQuery(0, "SELECT name FROM Tags WHERE tag_id = ? AND language_id = ?") If NextDatabaseRow(0) Result + GetDatabaseString(0, 0) + #RecordSeparator Else Result + #RecordSeparator EndIf FinishDatabaseQuery(0) EndIf Next ProcedureReturn Result EndProcedure Procedure UpdateTag(TextBundle.s) Protected Entry.s, Loop, Count, ID Protected DefaultName.s, Color.s, LocalizedName.s Count = CountString(TextBundle, #RecordSeparator) Entry = StringField(TextBundle, 1, #RecordSeparator) ID = Val(StringField(Entry, 1, #FieldSeparator)) DefaultName = StringField(Entry, 2, #FieldSeparator) Color = StringField(Entry, 3, #FieldSeparator) ; Find and update local data ForEach Tags() If Tags()\ID = ID Tags()\DefaultName = DefaultName Tags()\Color = Color Break EndIf Next ; Update TagID table SetDatabaseString(0, 0, DefaultName) SetDatabaseString(0, 1, Color) SetDatabaseLong(0, 2, ID) DatabaseUpdate(0, "UPDATE TagID SET default_name = ?, color = ? WHERE id = ?") ; Update localized names For Loop = 2 To Count Entry = StringField(TextBundle, Loop, #RecordSeparator) LocalizedName = Base64ToString(Entry) SetDatabaseString(0, 0, LocalizedName) SetDatabaseLong(0, 1, ID) SetDatabaseLong(0, 2, Loop - 1) DatabaseUpdate(0, "UPDATE Tags SET name = ? WHERE tag_id = ? AND language_id = ?") Tags()\Name[Loop - 2] = LocalizedName Next BuildSiteStructure() ProcedureReturn #True EndProcedure ; ======================================================================== ; Miscellaneous ; ======================================================================== Procedure.s ListLanguages() Protected Result.s ForEach Language() Result + MapKey(Language()) + #RecordSeparator Next ProcedureReturn Result EndProcedure ; ======================================================================== ; Page Building ; ======================================================================== Procedure BuildArticle(Title.s, Content.s, Blurb.s, Image.s, URL.s, language.i) Protected *Memory, Article.s, Size Article = ReplaceString(TemplateArticle\language[language], "SH:TITLE", Title) Article = ReplaceString(Article, "SH:CONTENT", Content) Article = ReplaceString(Article, "SH:BLURB", Blurb) Article = ReplaceString(Article, "SH:IMAGE", Image) Article = ReplaceString(Article, "SH:URL", URL) Size = StringByteLength(Article, #PB_UTF8) *Memory = AllocateMemory(Size) PokeS(*Memory, Article, Size, #PB_UTF8 | #PB_String_NoZero) ProcedureReturn *Memory EndProcedure Procedure.s BuildCard(Title.s, Blurb.s, Image.s, Date.i, Tags.s, URL.s, Language.i, ReadingTime.i, Large.i) Protected Card.s, ReadingTimeText.s, FormatedDate.s ; Format reading time text If language = 0 ; English If ReadingTime = 1 ReadingTimeText = "1 minute read" Else ReadingTimeText = Str(ReadingTime) + " minutes read" EndIf FormatedDate = FormatDate("%mm/%dd/%yyyy", Date) Else ; French If ReadingTime = 1 ReadingTimeText = "1 minute de lecture" Else ReadingTimeText = Str(ReadingTime) + " minutes de lecture" EndIf FormatedDate = FormatDate("%dd/%mm/%yyyy", Date) EndIf If Large Card = TemplateLargeCard\language[Language] Else Card = TemplateSmallCard\language[Language] EndIf Card = ReplaceString(Card, "SH:TITLE", Title) Card = ReplaceString(Card, "SH:URL", URL) Card = ReplaceString(Card, "SH:IMAGE", Image) Card = ReplaceString(Card, "SH:BLURB", Blurb) Card = ReplaceString(Card, "SH:DATE", FormatedDate) Card = ReplaceString(Card, "SH:TAGS", Tags) Card = ReplaceString(Card, "SH:READTIME", ReadingTimeText) ProcedureReturn Card EndProcedure Procedure.s BuildPage(PageTemplate.s, WorkingLanguage, List PublishedArticles.PublishedArticle()) Protected i, Position, Card.s Protected Title.s, Blurb.s, Image.s, Date.s, ReadTime, TagString.s ResetList(PublishedArticles()) For i = 1 To #ArticlePerPage If Not NextElement(PublishedArticles()) PageTemplate = RemoveString(PageTemplate, "SH:CARDLARGE") PageTemplate = RemoveString(PageTemplate, "SH:CARDSMALL") Break EndIf ; Build the article tags links TagString = "" PushListPosition(Tags()) ForEach Tags() If PublishedArticles()\Tags & Tags()\BinaryID TagString = TagString + ~"" + Tags()\Name[WorkingLanguage] + " " EndIf Next PopListPosition(Tags()) ; Fetch article content for this language SetDatabaseLong(0, 0, PublishedArticles()\ID) SetDatabaseLong(0, 1, Language()) If DatabaseQuery(0, "SELECT title, image, blurb, reading_time FROM Articles WHERE id = ? AND language_id = ?") NextDatabaseRow(0) Title = GetDatabaseString(0, 0) Image = GetDatabaseString(0, 1) Blurb = GetDatabaseString(0, 2) ReadTime = GetDatabaseLong(0, 3) FinishDatabaseQuery(0) EndIf Position = FindString(PageTemplate, "SH:CARD") If Mid(PageTemplate, Position + 7, 5) = "LARGE" Card = BuildCard(Title, Blurb, Image, PublishedArticles()\Date, TagString, PublishedArticles()\DefaultName, WorkingLanguage, ReadTime, #True) PageTemplate = ReplaceString(PageTemplate, "SH:CARDLARGE", Card, #PB_String_CaseSensitive, 0, 1) Else Card = BuildCard(Title, Blurb, Image, PublishedArticles()\Date, TagString, PublishedArticles()\DefaultName, WorkingLanguage, ReadTime, #False) PageTemplate = ReplaceString(PageTemplate, "SH:CARDSMALL", Card, #PB_String_CaseSensitive, 0, 1) EndIf Next ProcedureReturn PageTemplate EndProcedure Procedure.s BuildRSSFeed(WorkingLanguage, List PublishedArticles.PublishedArticle()) Protected RSS.s, Items.s, Item.s Protected Title.s, Blurb.s, PubDate.s, LangCode.s Protected i, MaxItems = 20 ; Limit RSS to 20 most recent articles RSS = TemplateRSS\language[WorkingLanguage] ; Build RSS items ResetList(PublishedArticles()) For i = 1 To MaxItems If Not NextElement(PublishedArticles()) Break EndIf ; Fetch article content for this language SetDatabaseLong(0, 0, PublishedArticles()\ID) SetDatabaseLong(0, 1, WorkingLanguage + 1) If DatabaseQuery(0, "SELECT title, blurb FROM Articles WHERE id = ? AND language_id = ?") NextDatabaseRow(0) Title = GetDatabaseString(0, 0) Blurb = GetDatabaseString(0, 1) FinishDatabaseQuery(0) EndIf ; Format date as RFC 822 (required for RSS) Select DayOfWeek(PublishedArticles()\Date) Case 0 PubDate = "Sun, " Case 1 PubDate = "Mon, " Case 2 PubDate = "Tue, " Case 3 PubDate = "Wed, " Case 4 PubDate = "Thu, " Case 5 PubDate = "Fri, " Case 6 PubDate = "Sat, " EndSelect PubDate + FormatDate("%dd %mm %yyyy %hh:%ii:%ss +0000", PublishedArticles()\Date) Item = TemplateRSSItem Item = ReplaceString(Item, "SH:TITLE", Title) Item = ReplaceString(Item, "SH:LINK", General::#Address + "article?" + PublishedArticles()\DefaultName) Item = ReplaceString(Item, "SH:GUID", General::#Address + "article?" + PublishedArticles()\DefaultName) Item = ReplaceString(Item, "SH:PUBDATE", PubDate) Item = ReplaceString(Item, "SH:DESCRIPTION", Blurb) Items + Item + #CRLF$ Next RSS = ReplaceString(RSS, "SH:ITEMS", Items) ProcedureReturn RSS EndProcedure Procedure BuildSiteStructure() Protected NewList PublishedArticles.PublishedArticle(), NewList PublishedArticlesByTag.PublishedArticle() Protected i, Page.s Protected WorkingLanguage ; Free the existing pages ForEach StructurePages() For i = 1 To General::#LanguageCount FreeMemory(StructurePages()\language[i - 1]\data) Next Next ClearMap(StructurePages()) ; Collect published articles ForEach Articles() If Articles()\Draft = #False AddElement(PublishedArticles()) PublishedArticles()\DefaultName = MapKey(Articles()) PublishedArticles()\ID = Articles()\ID PublishedArticles()\Tags = Articles()\Tags PublishedArticles()\Date = Articles()\Date EndIf Next ; Sort by date (newest first) SortStructuredList(PublishedArticles(), #PB_Sort_Descending, OffsetOf(PublishedArticle\Date), #PB_Integer) ; Build index page for each language AddMapElement(StructurePages(), "index") ForEach Language() WorkingLanguage = Language() - 1 Page = TemplateIndex\language[WorkingLanguage] Page = BuildPage(Page, WorkingLanguage, PublishedArticles()) StructurePages()\language[WorkingLanguage]\size = StringByteLength(Page, #PB_UTF8) StructurePages()\language[WorkingLanguage]\data = AllocateMemory(StructurePages()\language[WorkingLanguage]\size) PokeS(StructurePages()\language[WorkingLanguage]\data, Page, StructurePages()\language[WorkingLanguage]\size, #PB_UTF8 | #PB_String_NoZero) Next ; TODO: Build history browsing pages ; Tag pages ForEach Tags() ClearList(PublishedArticlesByTag()) ForEach PublishedArticles() If PublishedArticles()\Tags & Tags()\BinaryID AddElement(PublishedArticlesByTag()) PublishedArticlesByTag()\DefaultName = PublishedArticles()\DefaultName PublishedArticlesByTag()\ID = PublishedArticles()\ID PublishedArticlesByTag()\Tags = PublishedArticles()\Tags PublishedArticlesByTag()\Date = PublishedArticles()\Date EndIf Next AddMapElement(StructurePages(), "tag?"+Tags()\DefaultName) ForEach Language() WorkingLanguage = Language() - 1 Page = TemplateTags\language[WorkingLanguage] Page = ReplaceString(Page, "SH:TAG", Tags()\Name[WorkingLanguage]) Page = BuildPage(Page, WorkingLanguage, PublishedArticlesByTag()) StructurePages()\language[WorkingLanguage]\size = StringByteLength(Page, #PB_UTF8) StructurePages()\language[WorkingLanguage]\data = AllocateMemory(StructurePages()\language[WorkingLanguage]\size) PokeS(StructurePages()\language[WorkingLanguage]\data, Page, StructurePages()\language[WorkingLanguage]\size, #PB_UTF8 | #PB_String_NoZero) Next Next ; ; RSS Feed AddMapElement(StructurePages(), "rss") ForEach Language() WorkingLanguage = Language() - 1 Page = BuildRSSFeed(WorkingLanguage, PublishedArticles()) StructurePages()\language[WorkingLanguage]\size = StringByteLength(Page, #PB_UTF8) StructurePages()\language[WorkingLanguage]\data = AllocateMemory(StructurePages()\language[WorkingLanguage]\size + 2) PokeS(StructurePages()\language[WorkingLanguage]\data, Page, StructurePages()\language[WorkingLanguage]\size, #PB_UTF8 | #PB_String_NoZero) Next EndProcedure ; ======================================================================== ; MIME Type Data ; ======================================================================== DataSection MimeData: Data.s "aac", "audio/aac" Data.s "abw", "application/x-abiword" Data.s "apng", "image/apng" Data.s "avi", "video/x-msvideo" Data.s "bin", "application/octet-stream" Data.s "bmp", "image/bmp" Data.s "css", "text/css" Data.s "csv", "text/csv" Data.s "doc", "application/msword" Data.s "gif", "image/gif" Data.s "htm", "text/html" Data.s "html", "text/html" Data.s "ico", "image/x-icon" Data.s "jpeg", "image/jpeg" Data.s "jpg", "image/jpeg" Data.s "js", "text/javascript" Data.s "json", "application/json" Data.s "mp3", "audio/mpeg" Data.s "mp4", "video/mp4" Data.s "mpeg", "video/mpeg" Data.s "otf", "font/otf" Data.s "png", "image/png" Data.s "pdf", "application/pdf" Data.s "php", "application/x-httpd-php" Data.s "svg", "image/svg+xml" Data.s "txt", "text/plain" Data.s "wav", "audio/wav" Data.s "webm", "video/webm" Data.s "webp", "image/webp" Data.s "woff", "font/woff" Data.s "woff2", "font/woff2" Data.s "xml", "application/xml" Data.s "zip", "application/zip" Data.s "END" EndDataSection EndModule ; IDE Options = PureBasic 6.30 beta 5 (Linux - x64) ; CursorPosition = 90 ; FirstLine = 44 ; Folding = FAAAA5 ; EnableXP ; DPIAware