#!/usr/bin/perl
#
# Copyright 2014-2019 - Giovanni Simoni
#
# This file is part of PFT.
#
# PFT is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free
# Software Foundation, either version 3 of the License, or (at your
# option) any later version.
#
# PFT 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 PFT.  If not, see <http://www.gnu.org/licenses/>.

=encoding utf8

=head1 NAME

pft make - Build the PFT website

=head1 SYNOPSIS

B<pft make>

=head1 DESCRIPTION

This command builds all content within the C<ROOT/content> directory into
HTML form.

The content will be first organized into an internal graph representation,
so that each entry knows which other entries refer to it.  Each node of the
graph is then mapped on a HTML template, and and saved in the C<ROOT/build>
directory.  During this process unresolved links are notified to the user
via standard error.

=head2 Templates and expansions

HTML templates must be stored in the C<ROOT/templates> directory.

The template engine in use is C<Template::Alloy>.  In a nutshell, it allows
to expand simple code blocks within a HTML (or text) skeleton, as for
example in:

    <title>[% site.title %]</title>

Loops and conditionals are also supported.  See the C<Template::Alloy> user
manual for learning the supported mini-language.

A bunch of pre-defined, templates are installed by default during the
initialization process (see L<pft-init(1)>).

=head2 The output website

The output encoding depends on a configuration key in C<pft.yaml> (see
L<pft-init(1)>). The template is expected to define the encoding in a proper
way, that is by making use of the C<[% site.encoding %]> key in the HTML
header:

    <head>
    <meta http-equiv="content-type"
          content="text/html; charset=[% site.encoding %]">
    ...
    </head>

The result of a build is a collection of HTML pages.  Since C<a href> links
are relative, the generated site will work fine even if moved or copied
remotely on another system (see L<pft-pub(1)>).

=head2 Injected data

The B<pft make> command will populate the C<ROOT/build> directory.

Additional static data to inject in the resulting website can be placed in
the C<ROOT/inject> directory.  This meets the common requirement of placing
additional files in the root directory of online websites (typical case
being the C<.htaccess> file of Apache).

The L<pft-make(1)> command will first attempt to hard-link the injected files,
from C<ROOT/inject> to C<ROOT/build>.  If this fails (e.g. because
hard-links are not supported by the filesystem) soft-links are attempted.
If nothing else succeeds, B<pft make> will make a copy of each injected
file.

=head1 OPTIONS

=over

=item B<--help>

Show this guide.

=back

=head1 EXIT STATUS

=over

=item

1 in case of option parsing failure.

=item

2 if it was impossible to construct the filesystem tree.

=item

3 in case of corrupt configuration.

=back

=head1 SEE ALSO

L<pft(1)>, L<pft-init(1)>

=cut

use strict;
use warnings;
use utf8;
use v5.16;

use feature qw/say state/;

use Carp;
use Digest::MD5;
use Encode::Locale;
use Encode;
use HTML::Escape qw/escape_html/;
use POSIX qw/strftime/;
use Template::Alloy;

use File::Spec;
use File::Basename qw/dirname basename/;
use File::Path qw/make_path/;

use PFT::Text;
use PFT::Tree;
use PFT::Util;

use App::PFT;
use App::PFT::Util qw/ln/;

use Pod::Usage;
use Getopt::Long;
Getopt::Long::Configure qw/bundling/;

GetOptions(
    'help|h!'       => sub {
        pod2usage
            -exitval => 1,
            -verbose => 2,
            -input => App::PFT::help_of 'make',
    },
) or exit 1;

my $tree = eval{ PFT::Tree->new } || do {
    say STDERR $@ =~ s/ at.*$//rs;
    exit 2
};

my $conf = eval{ $tree->conf } || do {
    say STDERR 'Configuration error: ', $@ =~ s/ at.*$//rs;
    exit 3;
};

my $template = Template::Alloy->new(
    INCLUDE_PATH => $tree->dir_templates,
    ENCODING => $conf->{site}{encoding},
);
my $dir_build = $tree->dir_build;
my $map = $tree->content_map;

my $hasher = Digest::MD5->new;

sub node_to_rel {
    my $node = shift;
    confess unless $node;
    my $hdr = $node->header;
    my $k = $node->content_type;

    die unless wantarray;

    if ($k =~ /::Blog$/) {(
        'blog',
        sprintf('%04d-%02d', $hdr->date->y, $hdr->date->m),
        sprintf('%02d-%s.html', $hdr->date->d, $hdr->slug),
    )} elsif ($k =~ /::Month$/) {(
        'blog',
        sprintf('%04d-%02d.html', $hdr->date->y, $hdr->date->m),
    )} elsif ($k =~ /::Page$/) {(
        'pages',
        $hdr->slug . '.html',
    )} elsif ($k =~ /::Tag$/) {(
        'tags',
        $hdr->slug . '.html',
    )} elsif ($k =~ /::Picture$/) {(
        'pics',
        $node->content->relpath
    )} elsif ($k =~ /::Attachment$/) {(
        'attachments',
        $node->content->relpath
    )} else { die $k };
}

sub node_to_root {
    # NOTE: you actually wantarray!
    my $k = shift->content_type;
    if ($k =~ /::Blog$/) {(
        '..', '..'
    )} elsif ($k =~ /::(?:Month|Page|Tag)$/) {(
        '..',
    )} else {
         die "Why going back from $k?"
    };
}

sub node_to_href {
    my($cur_node, $other_node) = @_;
    join('/', node_to_root($cur_node), node_to_rel($other_node));
}

sub node_to_date {
    my $d = shift->date;
    return undef unless defined $d;
    return $d->to_hash unless @_;
    return $d->repr(shift)
}

sub node_to_anchor {
    my($cur_node, $other_node) = @_;
    if (defined $other_node) {{
        href => node_to_href(@_),
        slug => $other_node->title,
        date => sub { node_to_date($other_node, @_) },
        is_self => !($cur_node <=> $other_node),
    }} else {
        undef
    }
}

sub nodes_to_anchors {
    my $cur_node = shift;
    return undef unless (@_);
    [map node_to_anchor($cur_node, $_), @_]
}

sub site_links {
    my $cur_node = shift;
    pages => sub {
        nodes_to_anchors($cur_node, $map->pages)
    },
    tags => sub {
        nodes_to_anchors($cur_node, $map->tags)
    },
    backlog => sub {
        # param is the number of recent entries depend on template.
        my $n = shift;
        if (!defined $n) {
            $map->blog_exists
        }
        elsif ($n > 0) {
            nodes_to_anchors($cur_node, $map->blog_recent($n))
        }
        else {
            ()
        }
    },
    months_backlog => sub {
        # param is the number of recent months depend on template.
        my $n = shift;
        if (!defined $n) {
            $map->blog_exists
        }
        elsif ($n > 0) {
            nodes_to_anchors($cur_node, $map->months_recent($n))
        }
        else {
            ()
        }
    },
}

my $home_node_slug = PFT::Header::slugify($conf->{site}{home});
my $home_node;

for my $node ($map->nodes) {
    my $content = $node->content;

    if ($content->isa('PFT::Content::Entry')) {
        compile_entry($node, $content)
    }
    elsif ($content->isa('PFT::Content::Blob')) {
        install_blob($node, $content)
    }
}

sub write_file {
    my($data, $path) = @_;

    my $dirname = dirname $path;
    my $enc = $conf->{site}{encoding};
    my $fh;

    make_path $dirname;

    my $temp = File::Spec->catfile($dirname, "." . basename $path);

    open($fh, ">:encoding($enc)", $temp) or croak "Opening $temp: $!";
    print $fh $data;
    close $fh;

    if (-e "$path") {
        # This branch enables an upload-time optimization: if the file
        # created file is exactly the same as the previous compilation (same
        # checksum) we keep the old one.  Rsync will not upload it again.
        my $digest_new = $hasher->add(encode($enc, $data))->hexdigest;

        open($fh, "<:raw", $path)
            or croak "Opening $path: $!";
        my $digest_old = $hasher->addfile($fh)->hexdigest;
        close $fh;

        if ($digest_new eq $digest_old) {
            # Unchanged! Leave the old one.
            unlink $temp;
            return;
        }
    }

    rename $temp => $path;
}

sub compile_entry {
    my($node, $content) = @_;

    my $hdr = $node->header;
    my $first = 1;
    foreach ($node->symbols_unres) {
        if ($first) {
            say STDERR "Unresolved links in $node:"
        }

        my($symbol, $reason) = @$_;
        say STDERR "- link: $symbol";
        say STDERR "  reason: $reason";

        undef $first;
    }

    my $is_home;
    if (!$node->virtual && $hdr->slug eq $home_node_slug) {
        die "There should be no doubles" if defined $home_node;
        $home_node = $node;
        $is_home ++;
    }

    if ($hdr->opts->{hide}) {
        print "Node $node will be hidden\n";
        return;
    }

    my %entry_info = (
        site => {
            root => join('/', node_to_root($node)),
            %{$conf->{site}},
        },
        content => {
            title       => $node->title,
            html        => $node->html(sub { node_to_href($node, shift) }),
            tags        => nodes_to_anchors($node, $node->tags),
            date        => sub { node_to_date($node, @_) },
            is_home     => $is_home,
            author      => $node->author,
            is_virtual  => $node->virtual,
        },
        links => {
            site_links($node),
            prev        => node_to_anchor($node, $node->prev),
            next        => node_to_anchor($node, $node->next),
            parent      => node_to_anchor($node, $node->month),
            children    => nodes_to_anchors($node, $node->children),
        }
    );

    my $out_data;
    $template->process(
        # Encoding alert!
        ($hdr->opts->{template} || $conf->{site}{template}),
        \%entry_info,
        \$out_data,
    ) || croak 'Template expansion issue: ', $template->error;

    my $out_path = File::Spec->catfile(
        $dir_build,
        map encode($conf->{site}{encoding}, $_) => node_to_rel($node)
    );

    write_file $out_data => $out_path;
}

sub install_blob {
    my($node, $content) = @_;

    my $out_path = File::Spec->catfile($dir_build, node_to_rel($node));

    ln encode(locale_fs => $content->path),
       encode($conf->{site}{encoding}, $out_path)
}

my $inject = $tree->dir_inject;
foreach (
    File::Spec->no_upwards(
        map substr($_, 1 + length $inject) => (
            PFT::Util::locale_glob(File::Spec->catfile($inject, '*')),
            PFT::Util::locale_glob(File::Spec->catfile($inject, '.*')),
        )
    )
) {
    my $orig = File::Spec->catfile($inject, $_);
    my $dst = File::Spec->catfile($dir_build, $_);
    ln encode(locale_fs => $orig),
       encode($conf->{site}{encoding}, $dst)
}

if (defined $home_node) {
    my $fn = File::Spec->catfile($dir_build, 'index.html');
    open my $f, ">:encoding($conf->{site}{encoding})", $fn
        or croak "Unable to open $fn: $!";
    my $href = join '/', node_to_rel($home_node);
    my $title = $home_node->title;
    print $f
        "<!--\n",
        "    This file is generated automatically. Do not edit, it will be\n",
        "    overwritten. It points browsers to $title\n",
        "-->\n",
        "<meta HTTP-EQUIV=\"REFRESH\" content=\"0; url=$href\">"
    ;
} else {
    print STDERR "Warning: I was not able to find any $home_node_slug page";
}

# feed (rss) generation
do {
    my $site_title  = $conf->{site}{title};
    my $site_url    = $conf->{site}{url};
    my $feed_path   = $conf->{site}{feed}{path} || "feed.rss";
    my $feed_url    = "$site_url/$feed_path";
    my $encoding    = $conf->{site}{encoding};
    my $description = $conf->{site}{feed}{description} || "News from $site_title";
    my $length      = $conf->{site}{feed}{length} || 10;

    my $outfile;
    do {
        my $path = catfile($dir_build, $feed_path);

        make_path encode(locale_fs => dirname($path));
        open($outfile, ">:encoding($encoding)", encode(locale_fs => $path))
            or die "opening $path $!";
    };

    print $outfile (<<"    END" =~ s/^    //mgr);
    <?xml version="1.0" encoding="$encoding"?>
    <rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">
     <channel>
      <title>$site_title</title>
      <link>$site_url</link>
      <generator>App::PFT</generator>
      <description>$description</description>
      <atom:link href="$feed_url" rel="self" type="application/rss+xml"/>
    END

    foreach my $node ($map->blog_recent($length)) {
        my $guid = $hasher->add(encode($encoding, $node->title))->hexdigest;
        my $pub_date = do {
            my($y, $m, $d) = @{$node->date};
            strftime("%a, %d %b %Y %H:%M:%S %z", 0, 0, 0, $d, $m - 1, $y - 1900)
        };

        my $content = escape_html $node->html(sub {
            join '/', $site_url, node_to_rel(@_)
        });

        say $outfile '<item>',
            ' <title>', $node->title, '</title>',
            ' <guid isPermaLink="false">', $guid, '</guid>',
            ' <pubDate>', $pub_date, '</pubDate>',
            ' <link>', join('/', $site_url, node_to_rel($node)), '</link>',
            ' <description>', $content, '</description>',
            '</item>';
    }

    print $outfile (<<"    END" =~ s/^    //mgr);
     </channel>
    </rss>
    END


    close $outfile;
};