diff options
| -rwxr-xr-x | webgen-blog | 488 |
1 files changed, 488 insertions, 0 deletions
diff --git a/webgen-blog b/webgen-blog new file mode 100755 index 0000000..92f96fa --- /dev/null +++ b/webgen-blog @@ -0,0 +1,488 @@ +#!/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, + 'input' => undef, +); + +my %meta = ( + 'tags' => { + }, + 'files' => { + 'entry' => {}, + 'tags' => {}, + 'template' => {}, + }, + 'template' => {}, + 'languages' => {'*' => 1}, +); + +my %entry; + +while (my $arg = shift(@ARGV)) { + if ($arg eq '--tpl') { + $conf{substr($arg, 2)} = shift(@ARGV) or die sprintf('Argument %s needs option', $arg); + } else { + die 'Unknown arg: '.$arg; + } +} + +die 'Unknown template directory' unless defined $conf{'tpl'}; + +$conf{'input'} ||= 'BLOG'; + +chdir($conf{'tpl'}) or die $!; + +proc_input($conf{'input'}); +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/\&/&/gm; + $value =~ s/</</gm; + $value =~ s/>/>/gm; + $value =~ s/"/"/gm; + $value =~ s/\$/$/gm; + return $value; + } elsif ($type eq 'limitedhtml') { + $value = render_var($value => 'html'); + $value =~ s/\<(\/?(?:b|i|u|s))\>/<$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 |