view release on metacpan or  search on metacpan

bin/pft-make  view on Meta::CPAN

    </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-gen-rss(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 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;

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

    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)

bin/pft-make  view on Meta::CPAN

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 $md5 = Digest::MD5->new;
        $md5->add(encode($enc, $data));
        my $digest_new = $md5->hexdigest;

        open($fh, "<:raw", $path)
            or croak "Opening $path: $!";
        $md5->addfile($fh);
        close $fh;

        if ($digest_new eq $md5->hexdigest) {
            # 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));