use database directory instead of database file

This commit is contained in:
Nathan McCarty 2025-02-02 17:57:27 -05:00
parent fc04245162
commit 3b0e34e66e
7 changed files with 80 additions and 51 deletions

1
.gitignore vendored
View file

@ -1,3 +1,4 @@
.env/ .env/
.direnv/ .direnv/
**/.precomp/ **/.precomp/
test-db/

46
blog
View file

@ -10,36 +10,28 @@ my %*SUB-MAIN-OPTS =
:bundling, :bundling,
; ;
my IO::Path:D $blog-dir = $*PROGRAM.parent; #| The directory this script is located in
#= The directory this script is located in my IO::Path:D $default-blog-dir = $*PROGRAM.parent;
#| Load the database from the provided file #| Default database directory
sub load-db(IO::Path $file --> DB::PostDB:D) { my IO::Path:D $default-db-dir =
my $result = DB::PostDB.from-json: $file.slurp; do if %*ENV<BLOG_TEST> {
if $result ~~ DB::PostDB:D { $default-blog-dir.add('test-db/')
return $result;
} else { } else {
die "Error parsing $file as databse: $result"; $default-blog-dir.add('db/')
} };
}
#| Write the databse to the provided file
sub write-db(IO::Path $file, DB::PostDB $db) {
my $output = $db.to-json;
$file.spurt: $output;
}
#| Initalize the database #| Initalize the database
multi MAIN( multi MAIN(
"db", "db",
"init", "init",
#| The path of the database file #| The path of the database file
IO::Path(Str) :$db-file = $blog-dir.add("db.json"), IO::Path(Str) :$db-dir = $default-db-dir,
#| Overwrite an already existing database file #| Overwrite an already existing database file
Bool :$force Bool :$force
) { ) {
die "Database file already exists, use --force to overwrite: {$db-file.Str}" die "Database folder already exists, use --force to overwrite: {$db-dir.Str}"
if $db-file.e && !$force; if $db-dir.e && !$force;
print "Blog Title: "; print "Blog Title: ";
my $title = get; my $title = get;
@ -50,11 +42,7 @@ multi MAIN(
my $db = DB::PostDB.init: $meta; my $db = DB::PostDB.init: $meta;
if $force { $db.write: $db-dir;
$db-file.spurt: $db.to-json, :create-only;
} else {
$db-file.spurt: $db.to-json;
}
} }
#| Ensure that the database loads, erroring otherwise #| Ensure that the database loads, erroring otherwise
@ -62,9 +50,9 @@ multi MAIN(
"db", "db",
"verify", "verify",
#| The path of the database file #| The path of the database file
IO::Path(Str) :$db = $blog-dir.add("db.json"), IO::Path(Str) :$db-dir = $default-db-dir,
) { ) {
load-db $db; read-db $db-dir;
say "Database OK"; say "Database OK";
} }
@ -76,13 +64,13 @@ multi MAIN(
#| The path to the markdown file #| The path to the markdown file
IO::Path(Str) $source, IO::Path(Str) $source,
#| The path of the database file #| The path of the database file
IO::Path(Str) :$db-file = $blog-dir.add("db.json"), IO::Path(Str) :$db-dir = $default-db-dir,
#| The date/time the post should be recorded as posted at #| The date/time the post should be recorded as posted at
DateTime(Str) :$posted-at = DateTime.now, DateTime(Str) :$posted-at = DateTime.now,
#| Should the post be hidden from the archive? #| Should the post be hidden from the archive?
Bool :$hidden = False, Bool :$hidden = False,
) { ) {
my $db = load-db $db-file; my $db = read-db $db-dir;
my $id = my $id =
$db.insert-post: $db.insert-post:
MarkdownPost.new( MarkdownPost.new(
@ -90,7 +78,7 @@ multi MAIN(
posted-at => $posted-at, posted-at => $posted-at,
hidden => $hidden, hidden => $hidden,
); );
write-db $db-file, $db; $db.write: $db-dir;
say 'Post inserted with id ', $id; say 'Post inserted with id ', $id;
say 'Post has slugs: ', $db.posts{$id}.all-slugs; say 'Post has slugs: ', $db.posts{$id}.all-slugs;
} }

View file

@ -12,29 +12,18 @@ use DB::MarkdownPost;
use DB::IdrisPost; use DB::IdrisPost;
use DB::PlaceholderPost; use DB::PlaceholderPost;
class Posts is json(
:dictionary()
:keyof(Int:D),
MarkdownPost:D,
IdrisPost:D,
PlaceholderPost:D,
)) {}
subset PostTypes where MarkdownPost:D | IdrisPost:D | PlaceholderPost:D; subset PostTypes where MarkdownPost:D | IdrisPost:D | PlaceholderPost:D;
#| The top level posts database #| The top level posts database
class PostDB is json(:pretty) { class PostDB {
#| The metadat for the blog #| The metadata for the blog
has BlogMeta:D $.meta is required; has BlogMeta:D $.meta is required;
#| A mapping from post ids to posts #| A mapping from post ids to posts
has %.posts is Posts; # has %.posts is Posts;
has %.posts{Int} of PostTypes = %();
#| The post id to use for placeholder posts #| The post id to use for placeholder posts
has Int $.placeholder-id = 0; has Int $.placeholder-id = 0;
method TWEAK() {
%!posts := Posts.new unless %!posts;
}
#| Get the next unused post ID #| Get the next unused post ID
method next-post-id(--> Int) { method next-post-id(--> Int) {
if %!posts.elems > 0 { if %!posts.elems > 0 {
@ -53,11 +42,57 @@ class PostDB is json(:pretty) {
#| Initialize a new database #| Initialize a new database
method init(BlogMeta:D $meta --> PostDB:D) { method init(BlogMeta:D $meta --> PostDB:D) {
my %posts is Posts = Posts.new; my %posts{Int} of PostTypes = %();
%posts{0} = PlaceholderPost.empty; %posts{0} = PlaceholderPost.empty;
PostDB.new( PostDB.new(
meta => $meta, meta => $meta,
posts => %posts, posts => %posts,
) )
} }
#| Write a database to a directory
method write(IO::Path:D $dir) {
my $posts-dir = $dir.add('posts/');
# Make sure directory structrue exists
mkdir $dir unless $dir.e;
mkdir $posts-dir unless $posts-dir.e;
# Write out metadata
# TODO: Track changes and only write changed files
$dir.add('meta.json').spurt: $!meta.to-json;
# Write out posts (ids are the filename)
for %!posts.kv -> $key, $value {
$posts-dir.add("$key.json").spurt: $value.to-json;
}
}
}
sub read-db(IO::Path:D $dir --> PostDB:D) is export {
my $posts-dir = $dir.add('posts/');
die "DB directory does not exist" unless $dir.e;
die "posts directory does not exist" unless $posts-dir.e;
# Read metadata
my $meta = BlogMeta.from-json: $dir.add('meta.json').slurp;
# Read posts
my %posts{Int} of PostTypes = %();
for dir $posts-dir -> $post {
my $id = $post.extension("").basename.Int;
# TODO: Dejankify this, maybe see if we can work with parsed, but
# unmarshalled json
given $post.slurp {
when /'"placeholder": true'/ {
%posts{$id} = PlaceholderPost.from-json: $_;
}
when /'"markdown": true'/ {
%posts{$id} = MarkdownPost.from-json: $_;
}
when /'"idris": true'/ {
%posts{$id} = IdrisPost.from-json: $_;
}
default {
die "Unsupported post type: $post";
}
}
}
# Build db structure
PostDB.new: meta => $meta, posts => %posts
} }

View file

@ -3,8 +3,13 @@ use v6.e.PREVIEW;
use JSON::Class:auth<zef:vrurg>; use JSON::Class:auth<zef:vrurg>;
# Top level metadata for the blog # Top level metadata for the blog
unit class BlogMeta is json(:pretty); #| The title of the blog unit class BlogMeta is json(:pretty);
#| The title of the blog
has Str:D $.title is required is rw;
has Str:D $.title is required;
#| The tagline of the blog #| The tagline of the blog
has Str:D $.tagline is required; has Str:D $.tagline is required is rw;
#| The id of the placeholder post
has Int:D $.placeholder-id is rw = 0;

View file

@ -7,7 +7,7 @@ use DB::Post;
#| A literate, markdown, idris post #| A literate, markdown, idris post
unit class IdrisPost does Post is json; unit class IdrisPost does Post is json(:pretty);
#| Marker for disambiguation between post types in json representation, the #| Marker for disambiguation between post types in json representation, the
#| cheaty way #| cheaty way

View file

@ -6,7 +6,7 @@ use JSON::Class:auth<zef:vrurg>;
use DB::Post; use DB::Post;
#| A plain markdown post #| A plain markdown post
unit class MarkdownPost does Post is json; unit class MarkdownPost does Post is json(:pretty);
#| Marker for disambiguation between post types in json representation, the #| Marker for disambiguation between post types in json representation, the
#| cheaty way #| cheaty way

View file

@ -6,7 +6,7 @@ use JSON::Class:auth<zef:vrurg>;
use DB::Post; use DB::Post;
#| An empty placeholder post #| An empty placeholder post
unit class PlaceholderPost does Post is json; unit class PlaceholderPost does Post is json(:pretty);
#| Marker for disambiguation between post types in json representation, the #| Marker for disambiguation between post types in json representation, the
#| cheaty way #| cheaty way