Script to generate tag, category and post archives for a Gemini gemlog in place from the post files themselves, rather than building from an external site.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

481 lines
13 KiB

#!/usr/bin/perl -w
##############################################
# gemloginplace.pl by Kelson Vibber
# Version 0.4
# gemini://hyperborea.org
# https://kvibber.com
#
# Takes a collection of gemlog files and builds time,
# tag and category archives in place. Intended to be as
# simple as possible, though it's been drifting from
# that goal.
##############################################
use Cwd;
use strict;
use List::Util "min";
#use Sort::Naturally;
# Get files in current folder
opendir(DIR, cwd());
my @FILES = sort(readdir(DIR));
closedir(DIR);
my %CONFIG;
# Read config options if they exist.
if (-e "gemloginplace.config") {
logLine ('info', "Reading gemloginplace.config");
open configFile, "gemloginplace.config";
my @lines = <configFile>;
foreach my $configLine(@lines) {
if ($configLine =~ /^\s*([A-Za-z0-9_]+)\s*:\s*(.*)\s*$/) {
logLine('debug', "config item $1 => $2");
$CONFIG{$1}=$2;
}
}
close configFile;
} else {
logLine ('info', "No gemloginplace.config found, using default labels and paths.");
}
if (!exists $CONFIG{'LATEST_HEADING'}) {
$CONFIG{'LATEST_HEADING'} = '## Latest Posts';
}
if (!exists $CONFIG{'LATEST_MAX'}) {
$CONFIG{'LATEST_MAX'} = 8;
}
my @latestPostsOld;
my @indexHead;
my @indexTail;
# Read index.gmi to get:
# - site name
# - old list of latest posts
# - the rest of the file in case the list needs to be updated.
if (-e "index.gmi") {
open inFile, "index.gmi" || die("Cannot find index.gmi!\n");
my @lines = <inFile>;
close inFile;
# Find the previous list of latest posts in the index. Look for the header,
# then a continous list of links, then stop when we find another type of line.
my $latestPostsState = "NOT_STARTED";
foreach my $line (@lines) {
# The first first-level heading becomes the title.
if ($line =~ /^# (.*)$/ && !exists($CONFIG{'SITENAME'}) ) {
$CONFIG{'SITENAME'} = $1;
}
if ($latestPostsState eq 'NOT_STARTED') {
push @indexHead, $line;
if ($line =~ /^$CONFIG{'LATEST_HEADING'}/) {
$latestPostsState = 'LOOKING';
next;
}
}
if ($latestPostsState eq 'LOOKING') {
if ( $line =~ /^=> /) {
$latestPostsState = 'COLLECTING';
} else {
push @indexHead, $line;
}
}
if ($latestPostsState eq 'COLLECTING') {
if ($line =~ /^=> /) {
push @latestPostsOld, $line;
next;
} else {
$latestPostsState = 'DONE';
}
}
if ($latestPostsState eq 'DONE') {
push @indexTail, $line;
}
}
}
logLine('debug','Latest posts found in index');
foreach my $post (@latestPostsOld) {
logLine('debug',$post);
}
# Default configuration. TODO: Clean this up.
if (!exists $CONFIG{'SITENAME'}) {
$CONFIG{'SITENAME'} = "Gemlog";
}
if (!exists $CONFIG{'HOME'}) {
$CONFIG{'HOME'} = "Back to $CONFIG{'SITENAME'}";
}
if (!exists $CONFIG{'ALLOW_WRITING_TO_POSTS'}) {
$CONFIG{'ALLOW_WRITING_TO_POSTS'} = 0;
}
if (!exists $CONFIG{'TAG_FOLDER'}) {
$CONFIG{'TAG_FOLDER'} = 'tag';
}
if (!exists $CONFIG{'CATEGORY_FOLDER'}) {
$CONFIG{'CATEGORY_FOLDER'} = 'category';
}
if (!exists $CONFIG{'CATEGORY_INDEX'}) {
$CONFIG{'CATEGORY_INDEX'} = 'categories.gmi';
}
if (!exists $CONFIG{'TAG_INDEX'}) {
$CONFIG{'TAG_INDEX'} = 'tags.gmi';
}
if (!exists $CONFIG{'POST_INDEX'}) {
$CONFIG{'POST_INDEX'} = 'posts.gmi';
}
if (!exists $CONFIG{'PREVIOUS_LABEL'}) {
$CONFIG{'PREVIOUS_LABEL'} = 'Previous';
}
if (!exists $CONFIG{'NEXT_LABEL'}) {
$CONFIG{'NEXT_LABEL'} = 'Next';
}
if (!exists $CONFIG{'POST_INDEX_TITLE'}) {
$CONFIG{'POST_INDEX_TITLE'} = "All Posts at $CONFIG{'SITENAME'}";
}
if (!exists $CONFIG{'CATEGORY_INDEX_TITLE'}) {
$CONFIG{'CATEGORY_INDEX_TITLE'} = "Categories at $CONFIG{'SITENAME'}";
}
if (!exists $CONFIG{'TAG_INDEX_TITLE'}) {
$CONFIG{'TAG_INDEX_TITLE'} = "Tags at $CONFIG{'SITENAME'}";
}
if (!exists $CONFIG{'TAG_PAGE_TITLE'}) {
$CONFIG{'TAG_PAGE_TITLE'} = "Posts Tagged ___ - $CONFIG{'SITENAME'}";
}
if ($CONFIG{'TAG_PAGE_TITLE'} !~ /_/) {
$CONFIG{'TAG_PAGE_TITLE'} .= ' _';
}
if (!exists $CONFIG{'CATEGORY_PAGE_TITLE'}) {
$CONFIG{'CATEGORY_PAGE_TITLE'} = "___ Category - $CONFIG{'SITENAME'}";
}
if ($CONFIG{'CATEGORY_PAGE_TITLE'} !~ /_/) {
$CONFIG{'CATEGORY_PAGE_TITLE'} .= ' _';
}
if (!exists $CONFIG{'DEBUG'}) {
$CONFIG{'DEBUG'} = 0;
}
if (scalar(@ARGV) && $ARGV[0] eq '--update-nav') {
$CONFIG{'ALLOW_WRITING_TO_POSTS'} = 1;
}
if (scalar(@ARGV) && $ARGV[0] eq '--update-nav-dry-run') {
$CONFIG{'UPDATE_NAV_DRY_RUN'} = 1;
} else {
$CONFIG{'UPDATE_NAV_DRY_RUN'} = 0;
}
my %tags;
my %categories;
my %tagPosts;
my %categoryPosts;
my %posts;
my %navLinks;
my $prev = "./";
# Read each post, building a representation of the files, titles, tags and categories
foreach my $file(@FILES) {
# Only look at files with the pattern 2021-01-01-whatever-else.gmi
if ($file !~ /^(\d\d\d\d\-\d\d-\d\d)-(.*)\.gmi$/) {
next
}
my $date = $1;
my $title = '';
my $oldPrev = '';
my $oldNext = '';
logLine('debug', "Indexing $file");
open inFile, $file || die("Cannot find $file!\n");
my @lines = <inFile>;
close inFile;
my @postTags;
my @postCategories;
foreach my $line (@lines) {
# The first first-level heading becomes the title.
if ($line =~ /^# (.*)$/ && $title eq '') {
$title = $1;
}
my $tagFolder = $CONFIG{'TAG_FOLDER'};
if ($line =~ /^=>\s$tagFolder\/([^\s\.]*\.gmi)\s+(.*)$/) {
push(@postTags, $1);
if (!exists $tags{$1}) {
$tags{$1} = $2;
}
if (!exists $tagPosts{$1}) {
$tagPosts{$1} = [ $file ];
} else {
push @{ $tagPosts{$1} }, $file;
}
}
my $catFolder = $CONFIG{'CATEGORY_FOLDER'};
if ($line =~ /^=>\s$catFolder\/([^\s\.]*\.gmi)\s+(.*)$/) {
push(@postCategories, $1);
if (!exists $categories{$1}) {
$categories{$1} = $2;
}
if (!exists $categoryPosts{$1}) {
$categoryPosts{$1} = [ $file ];
} else {
push @{ $categoryPosts{$1} }, $file;
}
}
my $prevLabel = $CONFIG{'PREVIOUS_LABEL'};
if ($line =~ /^=>\s([^ ]+)\s+$prevLabel(: .*)?$/) {
$oldPrev = $line;
chomp($oldPrev);
}
my $nextLabel = $CONFIG{'NEXT_LABEL'};
if ($line =~ /^=>\s([^ ]+)\s+$nextLabel(: .*)?$/) {
$oldNext = $line;
chomp($oldNext);
}
}
if ($title eq '') {
$posts{$file} = $file;
} else {
$posts{$file} = "$date $title";
}
%{$navLinks{$file}} = (
'title' => $title,
'oldPrev' => $oldPrev,
'oldNext' => $oldNext,
'newNext' => ''
);
if (exists $navLinks{$prev}) {
my $prevTitle = $navLinks{$prev}{'title'};
$navLinks{$file}{'newPrev'} = "=> $prev $CONFIG{PREVIOUS_LABEL}: $prevTitle";
$navLinks{$prev}{'newNext'} = "=> $file $CONFIG{NEXT_LABEL}: $title";
} else {
$navLinks{$file}{'newPrev'} = "=> $prev $CONFIG{PREVIOUS_LABEL}: " . ${CONFIG}{'HOME'};
}
$prev = $file;
logLine('debug', " $title --- " .
join(', ', @postCategories) .
"\n tags: " . join(', ', @postTags) );
if ($oldPrev) {
logLine('debug', " oldPrev: $oldPrev");
}
if ($oldNext) {
logLine('debug', " oldNext: $oldNext");
}
}
# Write the main index pages
logLine ('info', "Generating main index pages for posts ($CONFIG{'POST_INDEX'}), categories ($CONFIG{'CATEGORY_INDEX'}), and tags ($CONFIG{'TAG_INDEX'})");
writeIndex(
$CONFIG{'POST_INDEX'},
$CONFIG{'POST_INDEX_TITLE'},
'',
'./',
$CONFIG{'HOME'},
%posts
);
writeIndex(
$CONFIG{'CATEGORY_INDEX'},
$CONFIG{'CATEGORY_INDEX_TITLE'},
"$CONFIG{'CATEGORY_FOLDER'}/",
'./',
$CONFIG{'HOME'},
%categories
);
writeIndex(
$CONFIG{'TAG_INDEX'},
$CONFIG{'TAG_INDEX_TITLE'},
"$CONFIG{'TAG_FOLDER'}/",
'./',
$CONFIG{'HOME'},
%tags);
# Create folders if they don't exist
if (scalar(keys %categories) > 0 && ! -d $CONFIG{'CATEGORY_FOLDER'}) {
logLine ('info', "Creating category folder: $CONFIG{'CATEGORY_FOLDER'}/");
mkdir $CONFIG{'CATEGORY_FOLDER'};
}
if (scalar(keys %tags) > 0 && ! -d $CONFIG{'TAG_FOLDER'}) {
logLine ('info', "Creating tag folder: $CONFIG{'TAG_FOLDER'}/");
mkdir $CONFIG{'TAG_FOLDER'};
}
# TODO generalize these since they're almost the same
logLine ('info', "Generating category pages in $CONFIG{'CATEGORY_FOLDER'}/");
foreach my $category (keys %categories) {
logLine('debug', "Category $categories{$category} ($category) has...");
my %localPosts;
foreach my $postFile (@{ $categoryPosts{$category}}) {
logLine('debug', " $postFile");
$localPosts{$postFile} = $posts{$postFile};
}
my $title = $CONFIG{'CATEGORY_PAGE_TITLE'};
$title =~ s/(_+)/$categories{$category}/;
writeIndex(
"$CONFIG{'CATEGORY_FOLDER'}/$category",
$title,
'../',
'../',
$CONFIG{'HOME'},
%localPosts
);
}
logLine ('info', "Generating tag pages in $CONFIG{'TAG_FOLDER'}/");
foreach my $tag (keys %tags) {
logLine('debug', "Tag $tags{$tag} ($tag) has...");
my %localPosts;
foreach my $postFile (@{ $tagPosts{$tag}}) {
logLine('debug', " $postFile");
$localPosts{$postFile} = $posts{$postFile};
}
my $title = $CONFIG{'TAG_PAGE_TITLE'};
$title =~ s/(_+)/${tags{$tag}}/;
writeIndex(
"$CONFIG{'TAG_FOLDER'}/$tag",
$title,
'../',
'../',
$CONFIG{'HOME'},
%localPosts
);
}
# Go through navigation links and find the ones that need to be updated
foreach my $post (sort keys %navLinks) {
my $oldPrev = $navLinks{$post}{'oldPrev'};
my $newPrev = $navLinks{$post}{'newPrev'};
my $oldNext = $navLinks{$post}{'oldNext'};
my $newNext = $navLinks{$post}{'newNext'} || "=> ./ Next";
my $changes = 0;
if ($oldPrev and ($oldPrev ne $newPrev)) {
$changes = 1;
}
if ($oldNext and ($oldNext ne $newNext)) {
$changes = 1;
}
if ($changes) {
if ($CONFIG{'ALLOW_WRITING_TO_POSTS'} eq 1 or $CONFIG{'UPDATE_NAV_DRY_RUN'} eq 1) {
open inFile, $post || die("Cannot find $post!\n");
my @lines = <inFile>;
close inFile;
foreach my $line (@lines) {
if ($oldPrev and ($oldPrev ne $newPrev) and (index ($line, $oldPrev) > -1) ) {
$line = "$newPrev\n";
logLine ('debug', " update $post: was $oldPrev");
logLine ('debug', " update $post: now $newPrev");
}
if ($oldNext and ($oldNext ne $newNext) and (index ($line, $oldNext) > -1) ) {
$line = "$newNext\n";
logLine ('debug', " update $post: was $oldNext");
logLine ('debug', " update $post: now $newNext");
}
}
logLine ('info', "Updating $post with next/previous changes.");
if ($CONFIG{'ALLOW_WRITING_TO_POSTS'} eq 1) {
open outFile, ">$post.new" || die("Cannot open $post.new for writing!\n");
foreach my $line (@lines) {
print outFile $line;
}
close outFile;
my $differences = `diff -y --suppress-common-lines $post $post.new | wc -l`;
chomp $differences;
if ($differences <= 2) {
unlink $post;
rename ("$post.new", $post) || die "Failed to rename $post.new!\n";
} else {
logLine ('warn', "Navigation changes in $post.new changed $differences lines. Not updating in case we broke it.");
}
}
} else {
logLine ('info', "$post has next/previous changes. Run with --update-nav to update it.");
}
}
}
# Get the new list of latest posts
my $latestLength = min($CONFIG{'LATEST_MAX'}, scalar(keys %posts) ) - 1;
my @latestPostsNew;
my $latestPostsChanged = 0;
logLine('debug','Latest posts');
# Sort by reverse date (filename) and take the first N posts
foreach my $postFile ((reverse sort(keys %posts))[0..$latestLength]) {
# Build the Gemtext link and add it to the new list.
my $line = "=> $postFile $posts{$postFile}\n";
push @latestPostsNew, $line;
# If the corresponding item in the old list is different, or we've run out of items
# in the old list, then the list has changed.
if (scalar @latestPostsOld < 1 || $line ne shift(@latestPostsOld)) {
$latestPostsChanged = 1;
}
}
# If the latest posts list has changed, and updating is enabled, write a new index.gmi file.
if ($latestPostsChanged) {
if ($CONFIG{'ALLOW_WRITING_TO_POSTS'} eq 1 or $CONFIG{'UPDATE_NAV_DRY_RUN'} eq 1) {
logLine ('info', "Updating index with latest posts.");
if ($CONFIG{'ALLOW_WRITING_TO_POSTS'} eq 1) {
open outFile, ">index.new" || die("Cannot open index.new for writing!\n");
foreach my $line (@indexHead) {
print outFile $line;
}
foreach my $line (@latestPostsNew) {
print outFile $line;
}
foreach my $line (@indexTail) {
print outFile $line;
}
close outFile;
unlink 'index.gmi';
rename ('index.new', 'index.gmi') || die "Failed to rename index.new!\n";
}
} else {
logLine ('info', "List of latest posts has changed. Run with --update-nav to update index.gmi.");
}
}
# Write the index page for a tag, category, or just everything.
sub writeIndex {
my ($file, $title, $prefix, $homeLink, $homeLabel, %posts) = @_;
# Build archive page
open outFile, ">$file" || die("Cannot open $file for writing!\n");
print outFile "# $title\n\n";
my $lastYear = '';
my @list = sort (keys %posts);
if ($list[0] =~ /^(\d\d\d\d)-/) {
@list = reverse @list;
}
foreach my $postFile (@list) {
if ($postFile =~ /^(\d\d\d\d)-/) {
my $year = $1;
if ($lastYear ne $year) {
$lastYear = $year;
print outFile "\n## $year\n\n";
}
}
print outFile "=> $prefix$postFile $posts{$postFile}\n";
}
print outFile "\n=> $homeLink $homeLabel\n";
close outFile;
}
# Report info to standard error, and report debug to standard error only if debug logging is enabled
sub logLine {
my ($level, $message) = @_;
if ( ! ($level eq 'debug' && ! $CONFIG{'DEBUG'})) {
print STDERR "$message\n";
}
}