view release on metacpan or  search on metacpan

bin/pft-pub  view on Meta::CPAN

This installation method will clear the target directory before
reconstructing it: any data contained in such directory will be lost.
Consider using the C<ROOT/inject> directory for auxiliary files (see
L<pft(1)>).

=item rsync+ssh

Copy the C<ROOT/build> directory via L<rsync(1)> onto a remote server, using
L<ssh(1)> as transport protocol.

=back

=head1 OPTIONS

=over

=item B<--list-required-conf>

List available publishing methods and the expected parameters in the
configuration file.

The output is compatible with the option specification of L<pft-init(1)>.

=item B<--help> | B<-h>

Show this help

=back

=head1 SEE ALSO

L<pft-init(1)>

=cut

use PFT::Tree;
use PFT::Conf;

use Pod::Usage;

use Encode::Locale;
use Encode;

use File::Path qw/make_path remove_tree/;
use File::Copy::Recursive;

use Carp;

use App::PFT;
use Getopt::Long;
Getopt::Long::Configure 'bundling';

my %methods = (
    'rsync+ssh' => \&rsync_ssh,
    'install'   => \&install,
);

GetOptions(
    'list-required-conf' => sub {
        for my $mname (sort keys %methods) {
            say STDOUT '--publish-method="'. $mname, '" requires configuration:';
            say STDOUT "\t--publish-$_" foreach $methods{$mname}->();
        }
        exit 0;
    },
    'help|h' => sub {
        pod2usage
            -exitval => 1,
            -verbose => 2,
            -input => App::PFT::help_of 'pub',
    }
) or exit 1;

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

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

my $method = $methods{$conf->{publish}{method}} || do {
    say STDERR 'Unknown method ', $conf->{publish}{method};
    exit 5;
};

$method->($tree);
exit 0;

sub check {
    foreach (@_) {
        unless(defined $conf->{publish}{$_}) {
            say STDERR 'Cannot use publish.', $_,
                ': missing publish.', $_, ' in ',
                $PFT::Conf::CONF_NAME;
            exit 6
        }
    }
}

sub rsync_ssh {
    my $tree = shift;

    defined $tree || return qw/user host path/;
    check qw/user host path/;

    my $src = File::Spec->catfile($tree->dir_build, '');
    my $publish = $conf->{publish};
    my $dst = "$publish->{user}\@$publish->{host}:$publish->{path}";
    my $port = $publish->{port} || 22;

    local $, = "\n\t";
    say STDERR 'Sending with RSync', "from $src", "to $dst";

    system('rsync',
        '-e', "ssh -p $port",
        '--recursive',
        '--verbose',
        '--copy-links',
        '--times',
        '--delete',
        '--human-readable',
        '--progress',
        $src, $dst,
    );
}

sub install {
    my $tree = shift;

    defined $tree || return qw/path/;
    check qw/path/;

    my $dst = File::Spec->rel2abs($conf->{publish}{path}, $tree->dir_base);

    remove_tree $dst, { verbose => 0 };
    make_path $dst, { verbose => 0 };

    local $File::Copy::Recursive::CopyLink = 0;
    File::Copy::Recursive::rcopy_glob(
        encode(locale => File::Spec->catfile($tree->dir_build, '*')),
        encode(locale => $dst),
    );
}