LastLife/SelfHost
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
main
SelfHost/Server/includes/data.pbi
LastLife 48584a449b 1.0rc
2025-12-15 19:46:13 +01:00

1100 lines
34 KiB
Plaintext
Raw Permalink Blame History

; ============================================================================
; 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 + ~"<a href=\"tag?" + Tags()\DefaultName + ~"\" style=\"color:" + Tags()\Color + ~";\" class=\"article-tag\">" + Tags()\Name[WorkingLanguage] + "</a> "
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
Reference in New Issue View Git Blame Copy Permalink