#!/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;
use UUID::Tiny qw(:std);

my %conf = (
    'uuid-ns' => 'd0a083bf-d36c-43ff-bcb8-a32a9ae4a030', # random UUID.
    '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} ||= {
        # From input file:
        'subject' => undef,
        'tags' => undef,
        'body' => undef,
        'id' => undef,
        'from' => undef,
        'date' => undef,
        # Internal:
        '_date' => undef,
        '_rendered' => 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);

    $cur = entry_makelang($entry => '*');
    unless (defined $cur->{'id'}) {
        my $data = $info->{'entryname'};
        foreach my $info (map{$cur->{$_}}(qw(subject from date tags body))) {
            next unless defined $info;
            $data .= ':'.$info;
        }
        $cur->{'id'} = create_uuid_as_string(UUID_SHA1, $conf{'uuid-ns'}, $data);
    }
}

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});

        render_entrylist($filename => $language => $cur);
    }
}

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