Update: Renamed webgen-blog -> webgenp-blog to enable that plugin

1 files changed, 499 insertions, 0 deletions

diff --git a/webgenp-blog b/webgenp-blog
new file mode 100755
index 0000000..ffc42b6
--- /dev/null
+++ b/webgenp-blog
@@ -0,0 +1,499 @@
+#!/usr/bin/perl
+
+#      Copyright (C) Philipp 'ph3-der-loewe' Schafft - 2017
+#
+#  This file is part of webgen,
+#  a small template engine for easy management of small websites.
+#
+#  This file is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License version 3
+#  as published by the Free Software Foundation.
+#
+#  webgen is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this software; see the file COPYING.  If not, write to
+#  the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+#  Boston, MA 02110-1301, USA.
+
+# This is the Blog plugin for webgen.
+
+use strict;
+use warnings;
+
+use DateTime::Format::ISO8601;
+use DateTime;
+
+my %conf = (
+    'tpl' => undef,
+    'mode' => 'generate',
+    'input' => '.',
+    'output' => '.',
+    'kv' => {},
+);
+
+my %meta = (
+    'tags' => {
+    },
+    'files' => {
+        'entry' => {},
+        'tags'  => {},
+        'template' => {},
+    },
+    'template' => {},
+    'languages' => {'*' => 1},
+);
+
+my %entry;
+
+#    "webgenp-$_plugin" --tpl . --mode "$_mode" --input "$_input" --output "$_output" "$@"
+
+while (my $arg = shift(@ARGV)) {
+    if ($arg eq '--tpl' || $arg eq '--mode' || $arg eq '--input' || $arg eq '--output') {
+        $conf{substr($arg, 2)} = shift(@ARGV) or die sprintf('Argument %s needs option', $arg);
+    } elsif ($arg eq '--kv') {
+        my ($key, $value) = (shift(@ARGV), shift(@ARGV));
+        die sprintf('Argument %s needs to options', $arg) unless defined($key) && defined($value);
+        $conf{'kv'}->{$key} = $value;
+    } else {
+        die 'Unknown arg: '.$arg;
+    }
+}
+
+die sprintf('Unsupported mode %s', $conf{'mode'}) unless $conf{'mode'} eq 'generate';
+die sprintf('Unsupported input %s', $conf{'input'}) unless $conf{'input'} eq '.';
+die sprintf('Unsupported output %s', $conf{'output'}) unless $conf{'output'} eq '.';
+
+die 'Unknown template directory' unless defined $conf{'tpl'};
+
+chdir($conf{'tpl'}) or die $!;
+
+proc_input('BLOG');
+proc_templates('.');
+
+foreach my $type (keys %{$meta{'files'}}) {
+    foreach my $filename (keys %{$meta{'files'}->{$type}}) {
+        read_file($filename, $meta{'files'}->{$type}->{$filename});
+    }
+}
+
+foreach my $entryname (keys %entry) {
+    render_entry($entryname => $entry{$entryname});
+}
+
+render_digest();
+
+#use Data::Dumper;
+#print Dumper({'meta' => \%meta, 'entry' => \%entry});
+
+sub proc_input {
+    my ($input) = @_;
+    opendir(my $dir, $input) or die $!;
+    while (my $file = readdir($dir)) {
+        my $info = {
+            'type'      => undef,
+            'language'  => '*',
+        };
+
+        if (substr($file, 0, 1) eq '.') {
+            next;
+        } elsif ($file eq '#tags' ) {
+            $info->{'type'} = 'tags';
+        } elsif ($file =~ /^#tags\.([^\.]+)$/ ) {
+            $info->{'language'} = $1;
+            $info->{'type'} = 'tags';
+        } elsif ($file =~ /^(.*)\.blog$/ ) {
+            $info->{'entryname'} = $1;
+            $info->{'type'} = 'entry';
+        } else {
+            warn sprintf('ignoring file "%s" of unknown type', $file);
+            next;
+        }
+
+        $meta{'files'}->{$info->{'type'}}->{$input.'/'.$file} = $info;
+    }
+    closedir($dir);
+}
+
+sub proc_templates {
+    my ($input) = @_;
+    opendir(my $dir, $input) or die $!;
+    while (my $file = readdir($dir)) {
+        my $info = {
+            'type'      => 'template',
+            'language'  => '*',
+            'templatename' => undef,
+        };
+
+    if ($file =~ /^(-blog-.*)\.(.+)$/) {
+        $info->{'templatename'} = $1;
+        $info->{'language'} = $2;
+    } elsif ($file =~ /^-blog-.*$/) {
+        $info->{'templatename'} = $file;
+    } else {
+        next;
+    }
+
+        $meta{'files'}->{$info->{'type'}}->{$input.'/'.$file} = $info;
+    }
+    closedir($dir);
+}
+
+sub read_file {
+    my ($filename, $info) = @_;
+    my $func = {
+        'tags' => \&read_file_tags,
+        'entry' => \&read_file_entry,
+        'template' => \&read_file_template,
+    }->{$info->{'type'}};
+
+    die 'Bad file type' unless defined $func;
+
+    return $func->($filename => $info);
+}
+
+sub read_file_tags {
+    my ($filename, $info) = @_;
+    my $language = $info->{'language'};
+    my $tags = $meta{'tags'};
+
+    open(my $in, '<', $filename) or die $!;
+    while (my $line = <$in>) {
+        $line =~ s/\r?\n$//;
+        if ($line eq '') {
+            next;
+        } elsif ($line =~ /\!language\s+(\S+)$/) {
+            $language = $1;
+            $meta{'languages'}->{$language} = 1;
+        } elsif ($line =~ /^('\S+)\s+(\S+)$/) {
+            $tags->{$1} ||= {};
+            $tags->{$1}->{$language} = $2;
+        } elsif ($line =~ /^(\S+)\s+(\S+)$/) {
+            $tags->{'\''.$1} ||= {};
+            $tags->{'\''.$1}->{$language} = $2;
+        } elsif ($line =~ /^('\S+)$/) {
+            $tags->{$1} ||= {};
+        } elsif ($line =~ /^(\S+)$/) {
+            $tags->{'\''.$1} ||= {};
+        } else {
+            die 'Bad syntax';
+        }
+    }
+    close($in);
+}
+
+sub entry_makelang {
+    my ($entry, $language) = @_;
+
+    $entry->{$language} ||= {
+        'subject' => undef,
+        'tags' => undef,
+        'body' => undef,
+        'id' => undef,
+    };
+
+    return $entry->{$language};
+}
+
+sub read_block {
+    my ($in) = @_;
+    my @block;
+
+    while (my $line = <$in>) {
+        $line =~ s/\r?\n$//;
+        last if $line eq '}';
+        push(@block, $line);
+    }
+
+    return join("\n", @block);
+}
+
+sub __file2meta {
+    my ($cur, $file) = @_;
+    my ($s_dev, $s_ino, $s_mode, $s_nlink, $s_uid, $s_gid, $s_rdev, $s_size, $s_atime, $s_mtime, $s_ctime, $s_blksize, $s_blocks) = stat($file);
+    my ($u_name, $u_passwd, $u_uid, $u_gid, $u_quota, $u_comment, $u_gcos, $u_dir, $u_shell, $u_expire) = getpwuid($s_uid);
+
+    $u_gcos =~ s/,.*$//;
+
+    $u_gcos ||= $u_name;
+
+    $cur->{'_date'}   = $s_mtime;
+    $cur->{'from'}  ||= $u_gcos;
+}
+
+sub read_file_entry {
+    my ($filename, $info) = @_;
+    my $language = $info->{'language'};
+    my $entry;
+    my $cur;
+
+    $entry{$info->{'entryname'}} ||= {};
+    $entry = $entry{$info->{'entryname'}};
+
+    $cur = entry_makelang($entry => $language);
+
+    open(my $in, '<', $filename) or die $!;
+
+    __file2meta(entry_makelang($entry => '*') => $in);
+
+    while (my $line = <$in>) {
+        $line =~ s/\r?\n$//;
+        if ($line eq '') {
+            next;
+        } elsif ($line =~ /\!language\s+(\S+)$/) {
+            $language = $1;
+            $meta{'languages'}->{$language} = 1;
+            $cur = entry_makelang($entry => $language);
+        } elsif ($line =~ /^([a-z0-9-]+):\s+(.+)$/i) {
+            $cur->{lc $1} = $2;
+        } elsif ($line =~ /^([a-z0-9-]+)\s+\{$/i) {
+            $cur->{lc $1} = read_block($in);
+        } else {
+            die 'Bad syntax';
+        }
+    }
+    close($in);
+}
+
+sub read_file_template {
+    my ($filename, $info) = @_;
+    my $language = $info->{'language'};
+    my $entry;
+
+    $meta{'template'}->{$info->{'templatename'}} ||= {};
+    $entry = $meta{'template'}->{$info->{'templatename'}};
+
+    {
+        local $/ = undef;
+        open(my $in, '<', $filename) or die $!;
+        $entry->{$language} = <$in>;
+        close($in);
+    }
+}
+
+sub tags_resolve {
+    my ($str) = @_;
+    my @res;
+
+    outer:
+    foreach my $tag (split(/\s*,\s*/, $str)) {
+        my $len;
+
+        if (substr($tag, 0, 1) eq '\'') {
+            $meta{'tags'}->{$tag} ||= {};
+            push(@res, $tag);
+            next outer;
+        }
+
+        $tag =~ s/^\^//;
+        $tag = lc($tag);
+        $len = length($tag);
+
+        foreach my $c (keys %{$meta{'tags'}}) {
+            if (lc(substr($c, 0, $len + 1)) eq '\''.$tag) {
+                push(@res, $c);
+                next outer;
+            }
+        }
+
+        die sprintf('No match for tag "^%s"', $tag);;
+    }
+
+    return \@res;
+}
+
+sub _tagfilename {
+    my ($tag, $language) = @_;
+    $tag =~ s/^'//;
+    $tag =~ s/([^a-zA-Z9-9])/sprintf('_%x', ord($1))/eg;
+    return sprintf('~blog-tag-%s%s', $tag, $language eq '*' ? '' : '.'.$language);
+}
+
+sub _tagname {
+    my ($tag, $language) = @_;
+    my $name = $meta{'tags'}->{$tag} || {};
+    $name = $name->{$language} || $name->{'*'};
+    $name = substr($tag, 1) unless defined $name;
+    return $name;
+}
+
+sub render_var {
+    my ($value, $type, $language) = @_;
+
+    if ($type eq 'raw') {
+        return $value;
+    } elsif ($type eq 'html') {
+        $value =~ s/\&/&amp;/gm;
+        $value =~ s/</&lt;/gm;
+        $value =~ s/>/&gt;/gm;
+        $value =~ s/"/&quot;/gm;
+        $value =~ s/\$/&#36;/gm;
+        return $value;
+    } elsif ($type eq 'limitedhtml') {
+        $value = render_var($value => 'html');
+        $value =~ s/\&lt;(\/?(?:b|i|u|s))\&gt;/<$1>/g;
+        $value =~ s/\r?\n\r?\n/<\/p>\n<p>/g;
+        return '<p>'.$value.'</p>';
+    } elsif ($type eq 'tags') {
+        return join('', map{render_template('-blog-tag' => {'var' => {'filename' => _tagfilename($_, $language), 'name' => _tagname($_ => $language)}, 'language' => $language})}(@{$value}));
+    } elsif ($type eq 'months') {
+        return join('', map{render_template('-blog-month' => {'var' => {'filename' => $_->[0], 'name' => $_->[1]}, 'language' => $language})}(@{$value}));
+    } else {
+        die sprintf('Unknown var rendering mode %s', $type);
+    }
+}
+
+sub render_template {
+    my ($templatename, $para) = @_;
+    my $template = $meta{'template'}->{$templatename};
+    my $rendered = $template->{$para->{'language'} || '*'} || $template->{'*'};
+
+    $rendered =~ s/\(var:([a-z9-9]+):([^\)]+)\)/render_var($para->{'var'}->{$2}, $1, $para->{'language'} || '*')/ge;
+
+    return $rendered;
+}
+
+sub render_entry {
+    my ($entryname, $entry) = @_;
+    my $cur;
+    my $ldef = $entry->{'*'};
+    my %gdef = (
+        'tags' => [],
+    );
+
+    $ldef->{'id'} ||= $entryname;
+
+    foreach my $language (keys %{$meta{'languages'}}) {
+        my $filename;
+
+        $entry->{$language} ||= {};
+        $cur = $entry->{$language};
+
+        if ($language ne '*') {
+            foreach my $key (keys %{$ldef}) {
+                $cur->{$key} ||= $ldef->{$key};
+            }
+
+            if ($cur->{'id'} eq $ldef->{'id'}) {
+                $cur->{'id'} .= '-'.$language;
+            }
+        }
+
+        foreach my $key (keys %gdef) {
+            $cur->{$key} ||= $gdef{$key};
+        }
+
+        unless (defined $cur->{'body'}) {
+            warn sprintf('Entry %s has no body for language %s', $entryname, $language);
+            next;
+        }
+
+        unless (ref($cur->{'tags'})) {
+            $cur->{'tags'} = tags_resolve($cur->{'tags'});
+        }
+
+        if (defined($cur->{'date'})) {
+            $cur->{'date'} =~ s/^(\d\d\d\d-\d\d-\d\d)\s+(\d\d:\d\d(?::\d\d)?)$/$1T$2/;
+            $cur->{'_date'} = DateTime::Format::ISO8601->parse_datetime($cur->{'date'})->epoch() or die 'Bad Date:-Format';
+        }
+
+        if ($cur->{'_date'}) {
+            $cur->{'date'} = DateTime->from_epoch('epoch' => $cur->{'_date'})->iso8601();
+            $cur->{'date'} =~ tr/T/ /;
+            $cur->{'date'} =~ s/\s+00:00:00$//;
+        }
+
+        $filename  = '~blog-entry-'.$entryname;
+        $filename .= '.'.$language unless $language eq '*';
+        $cur->{'filename'} = $filename;
+
+        $cur->{'_rendered'} = render_template('-blog-entry' => {'var' => $cur, 'language' => $language});
+
+        open(my $out, '>', $filename) or die $!;
+        print $out $cur->{'_rendered'};
+        close($out);
+    }
+}
+
+sub render_entrylist {
+    my ($filename, $language, @list) = @_;
+    my $subcontent = join("\n", map{$_->{'_rendered'}}(@list));
+
+    open(my $out, '>', $filename) or die $!;
+    print $out render_template('-blog-list' => {'var' => {'subcontent' => $subcontent}, 'language' => $language});
+    close($out);
+}
+
+sub min {
+    my $ret = $_[0];
+
+    foreach my $c (@_) {
+        $ret = $c if $c < $ret;
+    }
+
+    return $ret;
+}
+
+sub render_digest {
+    foreach my $language (keys %{$meta{'languages'}}) {
+        my @months;
+        my @entries;
+        my $suffix = $language eq '*' ? '' : '.'.$language;
+        my @sublist;
+        my ($tsa, $tsb);
+
+        foreach my $entry (values %entry) {
+            if (defined($entry->{$language}->{'_rendered'})) {
+                push(@entries, $entry->{$language});
+            } elsif (defined($entry->{'*'}->{'_rendered'})) {
+                push(@entries, $entry->{'*'});
+            }
+        }
+
+        @entries = sort{$b->{'_date'} <=> $a->{'_date'}}(@entries);
+
+        render_entrylist('~blog-recent'.$suffix => $language => @entries[0..min(15, $#entries)]);
+
+        foreach my $entry (@entries) {
+            $tsb = DateTime->from_epoch('epoch' => $entry->{'_date'});
+            $tsb = sprintf('%.4i-%.2i', $tsb->year(), $tsb->month());
+
+            if (@sublist) {
+                if ($tsa ne $tsb) {
+                    push(@months, ['~blog-'.$tsa.$suffix => $tsa]);
+                    render_entrylist('~blog-'.$tsa.$suffix => $language => @sublist);
+                    @sublist = ();
+                }
+            }
+
+            $tsa = $tsb;
+            push(@sublist, $entry);
+        }
+        push(@months, ['~blog-'.$tsa.$suffix => $tsa]);
+        render_entrylist('~blog-'.$tsa.$suffix => $language => @sublist);
+
+        foreach my $tag (keys %{$meta{'tags'}}) {
+            @sublist = ();
+            inner:
+            foreach my $entry (@entries) {
+                foreach my $c (@{$entry->{'tags'}}) {
+                    if ($tag eq $c) {
+                        push(@sublist, $entry);
+                        next inner;
+                    }
+                }
+            }
+
+            render_entrylist(_tagfilename($tag, $language) => $language => @sublist);
+        }
+
+        open(my $out, '>', '~blog-index'.$suffix) or die $!;
+        print $out render_template('-blog-index' => {'var' => {'tags' => [grep{/^'/}(keys %{$meta{'tags'}})], 'months' => \@months}, 'language' => $language});
+        close($out);
+    }
+}
+
+#ll