diff options
Diffstat (limited to 'webgen-blog')
| -rwxr-xr-x | webgen-blog | 499 |
1 files changed, 0 insertions, 499 deletions
diff --git a/webgen-blog b/webgen-blog deleted file mode 100755 index ffc42b6..0000000 --- a/webgen-blog +++ /dev/null @@ -1,499 +0,0 @@ -#!/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/\&/&/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 |