#!/usr/bin/env perl
# vim: ts=8 sts=4 et sw=4 sr sta
use strict;
use warnings;
use Data::Dump qw( pp );
use Carp;
use Getopt::Long;
use Digest::MD5 qw(md5_hex);
use File::Basename;
use File::Copy;
use File::Rsync;
use File::Slurp qw(read_file write_file);
use File::stat;
use File::Temp qw/ tempfile /;
use LWP::UserAgent;
use Path::Class qw(dir);
use Pod::Usage;
use Readonly;
use Template;
use YAML;
# FTP modules
use Net::FTP;
use File::Find;
Readonly my $CONFIG_FILE => $ENV{HOME} . q{/.ttsite};
# function prototypes
sub main();
sub process_config();
sub get_config($$);
sub file_checksum($);
sub file_modified($$);
sub same_file($$);
sub ignore_file($$$);
sub template_file($$);
sub process_site($$);
sub process_directory($$$);
sub process_file($$$$);
sub remote_sync($$$);
sub read_line(;$);
sub directory_contents($);
sub relative_path_from_full($$);
my($site_config, %cli_option, $template);
# me likey worky
main();
sub main() {
my ($global,$cliopt) = process_config();
my $siteconf = get_config($global,$cliopt);
# only process files if we're NOT --rsync-only or --fsync-only
if (not ($cliopt->{'rsync-only'} or $cliopt->{'fsync-only'})) {
process_site( $siteconf, $cliopt );
}
else {
if ($cliopt->{verbose}) {
warn "Skipping template processing phase\n";
}
}
# if any of the rsync options are set, do a remote-sync
if (grep { /^rsync/ } keys(%{$cliopt})) {
print "Starting Remote Sync\n";
remote_sync( $cliopt, $siteconf->{output_dir}, $siteconf->{rsync} );
}
# if any of the ftp options are set, do an ftp-sync
if (grep { /^fsync/ } keys(%{$cliopt})) {
$cliopt->{'ftp-debug'}=1;
print "Starting fsync:\n";
do_ftpsync( $siteconf, $cliopt );
}
}
################################################################################
sub process_config() {
my $global;
my $cliopt; # load config from $CONFIG_FILE
eval {
$global = YAML::LoadFile($CONFIG_FILE);
};
if ($@) {
create_config();
}
$cliopt = {
site => $global->{default_site} || 'default',
verbose => 0,
};
# get over-riding options from cli
GetOptions (
$cliopt,
'dryrun',
'force',
'fsync+',
'fsync-only+',
'ftp',
'ftp-only',
'ftp-debug',
'help',
'quiet',
'rsync',
'rsync-only',
'showdestination',
'showpath',
'site=s',
'sites',
'verbose+',
);
if ($cliopt->{help}) {
pod2usage();
exit;
}
return ( $global, $cliopt );
}
sub create_config {
my ($input);
$input = read_line(
qq{$CONFIG_FILE doesn't exist. Would you like it to be created now? [Y/n] }
);
# only create the config file if the respose was Y, y or <nothing>
if ($input =~ m{\A([Yy]|\z)}) {
# don't overwrite an existing file
if (-e $CONFIG_FILE) {
warn qq{$CONFIG_FILE already exists\n};
exit;
}
# open a file for writing
open (CONFFILE, ">$CONFIG_FILE")
or die $!;
# write out a sample config file
while (my $line = <DATA>) {
print CONFFILE <DATA>;
}
close CONFFILE;
# double-check to make sure the file exists
if (not -e "$CONFIG_FILE") {
warn qq{failed to create $CONFIG_FILE\n};
exit;
}
warn qq{$CONFIG_FILE created\n};
}
# for some reason they didn't want to create the config file
else {
warn qq{$CONFIG_FILE was NOT created\n};
exit;
}
exit;
}
sub get_config($$) {
my ($global, $cliopt) = @_;
if ($cliopt->{sites}) {
my @site_list = keys %{ $global->{site} };
if (not @site_list) {
print "No sites defined\n";
} else {
print
'Defined site labels: '
. join(q{, }, sort @site_list)
. "\n"
;
}
exit;
}
# make sure site is valid
if (not exists $global->{site}{ $cliopt->{site} }) {
die "'$cliopt->{site}' is not a valid site label\n"
. " sites: " . join(',', keys %{$global->{site}}) . "\n";
}
if (not sane_site_config($global->{site}{ $cliopt->{site} })) {
warn qq{configuration problems for site section: $cliopt->{site}\n};
exit;
}
my $siteconf = $global->{site}{ $cliopt->{site} };
print Dumper($global) if ($cliopt->{verbose} > 3);
print Dumper($cliopt) if ($cliopt->{verbose} > 3);
print Dumper($siteconf) if ($cliopt->{verbose} > 3);
# set site config
return $siteconf;
}
# a quick check to raise any obvious errors with a given site-config
sub sane_site_config {
my $site_config = shift;
my $errors = 0;
# these entries should all exist (as top-level keys) in the site-config
foreach my $required_key (qw[
source_dir
includes_dir
output_dir
template_files
ignore_dirs
ignore_files
tags
rsync
]) {
if (not exists $site_config->{$required_key}) {
warn qq{** configuration option missing: $required_key\n};
$errors++;
}
}
# these directories should exist
foreach my $required_dir (qw[source_dir includes_dir output_dir]) {
# dir should exist
if (not -d $site_config->{$required_dir}) {
warn qq{** directory missing: $site_config->{$required_dir}\n};
$errors++;
}
}
return (not $errors);
}
sub file_checksum($) {
my $file = shift;
my ($md5);
# try to open the file
open(FILE,$file) or do {
warn "Can't open $file: $!";
return undef;
};
binmode(FILE);
$md5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
return $md5;
}
sub file_modified($$) {
my ($template_file, $templated_file) = @_;
my ($template_stat, $templated_stat);
# if the destination file doesn't exist, it's "modified"
if (not -e $templated_file) {
return 1;
}
# get stat info for each file
$template_stat = stat( $template_file) or die "no file: $!\n";
$templated_stat = stat($templated_file) or die "no file: $!\n";
# return true if the templated file is OLDER than the template itself
# i.e. the source has been altered since we last generated the final result
return ($templated_stat->mtime < $template_stat->mtime);
}
sub same_file($$) {
my ($file1, $file2) = @_;
if (! -f $file2 or ! -f $file2) {
return 0;
}
if (file_checksum($file1) eq file_checksum($file2)) {
return 1;
}
return 0;
}
sub ignore_file($$$) {
my ($cliopt,$config,$filename) = @_;
foreach my $ignore_me (@{ $config->{ignore_files} }) {
my $regex = qr/ $ignore_me /x;
if ($filename =~ $regex) {
warn "Ignoring '$filename'. Match on '$regex'. Ignoring.\n"
if ($cliopt->{verbose} > 1);
return 1;
}
}
return;
}
sub template_file($$) {
my ($config,$filename) = @_;
foreach my $ignore_me (@{ $config->{template_files} }) {
my $regex = qr/ $ignore_me /x;
if ($filename =~ $regex) {
return 1;
}
}
return;
}
sub relative_path_from_full($$) {
my ($config, $directory) = @_;
my ($relpath);
# get the relative path from the full srcdir path
$relpath = $directory;
# remove source_dir from directory path
$relpath =~ s:^$config->{source_dir}::;
# remove leading / (if any)
$relpath =~ s:^/::;
return $relpath;
}
sub directory_contents($) {
my $directory = shift;
my (@list);
# get a list of everything (except . and ..) in $directory
opendir(DIR, $directory)
or die("can't open '$directory': $!\n");
@list = grep { $_ !~ /^\.\.?$/ } readdir(DIR);
return @list;
}
sub item_name($$$$) {
my ($config, $cliopt, $directory, $item) = @_;
my ($filename);
# default case - just the item name
$filename = $item;
# if we want to see the relative path
if ($cliopt->{showpath}) {
# get the full path to the file
$filename = "$directory/$item";
# remove path to sourcedir
$filename =~ s{\A$config->{source_dir}/}{}xms;
}
return $filename;
}
sub show_destination($$$$) {
my ($config, $cliopt, $directory, $item) = @_;
my ($relpath);
# get the relative path for the directory
$relpath = relative_path_from_full($config, $directory);
if ($cliopt->{showdestination}) {
if ($relpath) {
warn(qq{ --> $config->{output_dir}/$relpath/$item\n});
}
# top-level files don't have a relpath and we'd prefer not to have '//' in the path
else {
warn(qq{ --> $config->{output_dir}/$item\n});
}
}
return;
}
sub process_file($$$$) {
my ($config, $cliopt, $directory, $item) = @_;
my ($relpath);
# get the relative path
$relpath = relative_path_from_full($config, $directory);
# set $section and $specific_section used later in the H::T filter
my $specific_section = $relpath || 'root';
$specific_section =~ s:/:_:;
my ($section) = ($relpath =~ /^([^\/]+)/);
$section = (defined $section) ? $section : 'root';
# push the section name into the vars to replace
my $site_vars = {
section => $section,
source_dir => $config->{source_dir},
%{ $config->{tags} }
};
# some files should be run through TT
if (template_file($config,$item)) {
# only create the template object once - it's stupid to create
# a new one for each file we template
if (not defined $template) {
my $tt_config = {
ABSOLUTE => 1,
EVAL_PERL => 0,
INCLUDE_PATH => "$config->{source_dir}:$config->{includes_dir}",
};
if (defined $config->{plugin_base}) {
$tt_config->{PLUGIN_BASE} = $config->{plugin_base};
}
$template = Template->new( $tt_config );
}
# if the template and the destination have the same timestamp, nothing's changed
# HOWEVER, we only care if we're not forcing the template-output to be regenerated
if (not $cliopt->{force}) {
if (not file_modified("$directory/$item", "$config->{output_dir}/$relpath/$item")) {
warn "unchanged: $item\n" if ($cliopt->{verbose});
return;
}
}
warn (q{Templating: } . item_name($config, $cliopt, $directory, $item) . qq{\n});
show_destination($config, $cliopt, $directory, $item);
$template->process("$directory/$item", $site_vars, "$config->{output_dir}/$relpath/$item")
or Carp::croak ("\n" . $template->error());
}
# others should be copied (if they've changed
else {
# only copy files if the MD5 hasn't changed
if (not same_file("$directory/$item", "$config->{output_dir}/$relpath/$item")) {
warn (q{Copying: } . item_name($config, $cliopt, $directory, $item) . qq{\n});
copy("$directory/$item", "$config->{output_dir}/$relpath/$item");
show_destination($config, $cliopt, $directory, $item);
}
}
}
sub process_directory($$$) {
my ($config, $cliopt, $directory) = @_;
my (@list, $relpath);
@list = directory_contents($directory);
$relpath = relative_path_from_full($config, $directory);
# loop through the list and act 'accordingly'
foreach my $item (@list) {
# process files
if ( -f "$directory/$item") {
# skip ignored files
if (ignore_file($cliopt,$config,$item)) {
next;
}
process_file($config, $cliopt, $directory, $item);
next;
}
# process directories
elsif ( -d "$directory/$item") {
# skip ignored dirs
if ( grep { /\A$item\z/ } @{ $config->{ignore_dirs} } ) {
warn "Ignoring '$directory/$item'\n" if ($cliopt->{verbose});
next;
}
my $outdir = "$config->{output_dir}/$relpath/$item";
# make sure the directory exists in the output tree
if (! -d $outdir) {
warn "'$outdir' does not exist\n";
if (not mkdir($outdir)) {
carp "couldn't create output directory: $!";
exit;
}
}
# process the subdirectory
process_directory($config, $cliopt, "$directory/$item");
next;
}
# not a file ... not a directory?
else {
warn "????: $directory/$item\n";
}
}
return;
}
sub process_site($$) {
my ($config, $cliopt) = @_;
my $directory = $config->{source_dir};
process_directory($config, $cliopt, $directory);
return;
}
sub remote_sync($$$) {
my ($cliopt,$local_dir, $rsync_data) = @_;
# we need a remote host and a path
foreach my $required (qw[ hostname path ]) {
if (not exists $rsync_data->{$required}) {
warn "missing rsync option '$required'. rsync aborted\n";
return;
}
}
my $syncer = File::Rsync->new(
{
verbose => 1,
recursive => 1,
compress => 1,
'dry-run' => 0,
}
);
if (not defined $syncer) {
die "can't create syncer";
}
$syncer->exec(
{
src => "$local_dir/",
dest => "$rsync_data->{hostname}:$rsync_data->{path}/",
}
);
if ($cliopt->{verbose}) {
print $syncer->out();
}
if ($syncer->err()) {
print $syncer->err();
}
return;
}
sub read_line(;$) {
my($message) = @_;
my ($term, $stdout, $input);
# try to use Term::ReadLine for input
eval {require Term::ReadLine};
# if we have errors, fallback to simpler input method
if ($@) {
print $message if (defined $message);
my $input = (<STDIN>); chomp $input;
$input =~ s/^\s+//; $input =~ s/\s+$//;
}
# otherwise, use Term::ReadLine for input
else {
$term = Term::ReadLine->new('Foo');
$stdout = $term->OUT || \*STDOUT;
$input = $term->readline($message);
}
return $input;
}
#sub file_type {
# my ($path) = @_;
#
# if (not -e $path) { return; }
# if (-f $path) { return 'f'; };
# if (-d $path) { return 'd'; };
# if (-l $path) { return 'l'; };
#
# return '?';
#}
sub ftp_client {
my ($config, $cliopt, $ftp) = @_;
$config->{ftp}{hostname} ||= 'localhost';
$config->{ftp}{passive} ||= 0;
$config->{ftp}{username} ||= 'anonymous';
$config->{ftp}{password} ||= 'coward';
# if we have an existing FTP object - use it
if (defined $ftp and ref($ftp) eq 'Net::FTP') {
warn qq{using existing FTP object} if ($cliopt->{verbose} > 3);
}
else {
if (not chdir($config->{output_dir})) {
die qq{could not chdir to: $config->{output_dir}\n};
}
warn qq{creating new FTP object} if ($cliopt->{verbose} > 1);
$ftp = Net::FTP->new(
$config->{ftp}{hostname},
Debug => ($cliopt->{'ftp-debug'} || 0),
Passive => $config->{ftp}{passive},
);
# make sure we've got a usable FTP object
if (not defined $ftp) {
warn(qq{Failed to connect to server [$config->{ftp}{hostname}]: $!\n});
return;
};
# try to login
if (not $ftp->login(
$config->{ftp}{username},
$config->{ftp}{password}
)
) {
warn(qq{Failed to login as $config->{ftp}{username}\n});
return;
}
# try to cwd, if required
if (defined $config->{ftp}{working_dir}) {
if (not $ftp->cwd( $config->{ftp}{working_dir} ) ) {
warn(qq{Cannot change directory to $config->{ftp}{working_dir}\n});
return;
}
}
# use binary transfer mode
if (not $ftp->binary()) {
warn(qq{Failed to set binary mode\n});
return;
}
}
return $ftp;
}
#sub ftp_remote_files {
# my ($config, $cliopt, $ftp, $path, $rrem) = @_;
# my $rdir = length($path) ? $ftp->dir($path) : $ftp->dir();
#
# unless ($rdir and @$rdir) {
# warn qq{just returning ...\n};
# return;
# }
#
# foreach my $f (@$rdir) {
# if ($f =~ m{^d.+\s\.\.?$/}) {
# warn(qq{Skipping remote path: $f\n});
# next;
# }
#
# my $n = (split(m{\s+}, $f, 9))[8];
# if (not defined $n) {
# warn(qq{Skipping remote path (split failed on): $f\n});
# next;
# }
#
# my $name;
# if ($path) {
# $name = $path .q{/};
# }
# $name .= $n;
#
# if (exists $rrem->{$name}) {
# next;
# }
#
# # no point fetching size and mtime for dirs
# my ($type, $mdtm, $size) = (undef, 0, 0);
# $type = substr($f, 0, 1);
# $type =~ s{-}{f};
# if ($type ne 'd') {
# $mdtm = ($ftp->mdtm($name) || 0);
# $size = ($ftp->size($name) || 0);
# }
#
# if ($cliopt->{verbose} > 1) {
# warn (
# qq{ftp: adding }
# . $name
# . q{ (}
# . $mdtm
# . q{, }
# . $size
# . q{, }
# . $type
# . qq{)\n}
# );
# }
#
# # store the details of the remote file
# $rrem->{$name} = {
# mdtm => $mdtm,
# size => $size,
# type => $type,
# };
#
# if ($type eq 'd') {
# # skip ignored dirs
# if ( grep { /\A$n\z/ } @{ $config->{ftp_ignore_dirs} } ) {
# warn "ftp: ignoring '$name'\n" if ($cliopt->{verbose});
# next;
# }
#
# if ($cliopt->{verbose}) {
# warn qq{ftp: descending into: $name\n};
# }
# ftp_remote_files($config, $cliopt, $ftp, $name, $rrem);
# }
# }
#
# return;
#}
#sub ftp_local_files {
# my ($config, $cliopt) = @_;
# my %loc = ();
#
# # we chdir() so paths are relative locally - so we can compare with remote
# if (not chdir($config->{output_dir})) {
# die qq{could not chdir to: $config->{output_dir}\n};
# }
#
#
# # scan local path to see what we have
# find(
# {
# no_chdir => 1,
# follow => 0, # no symlinks, please
# wanted => sub {
# if ($File::Find::name eq q{.}) {
# return;
# }
#
# my $item_name = basename($File::Find::dir);
# if ( grep { /\A${item_name}\z/ } @{ $config->{ftp_ignore_dirs} } ) {
# warn "local: ignoring '$File::Find::name'\n" if ($cliopt->{verbose} > 1);
# $File::Find::prune = 1;
# return;
# }
#
# # remove leading "./" from path/filename
# $File::Find::name =~ s{\A\./}{};
#
# my $stat = stat( $File::Find::name );
#
# my $r = $loc{$File::Find::name} = {
# mdtm => $stat->mtime,
# size => $stat->size,
# type => file_type($File::Find::name),
# };
#
# if ($cliopt->{verbose} > 2) {
# print q{local: adding }
# . $File::Find::name
# . q{ (}
# . $r->{mdtm}
# . q{, }
# . $r->{size}
# . q{, }
# . $r->{type}
# . qq{)\n}
# ;
# }
# }
# },
# #$config->{output_dir}
# q{.}
# );
#
# return \%loc;
#}
#sub upload_missing_files {
# my ($config, $cliopt, $ftp, $local, $remote) = @_;
#
# my @files = sort { length($a) <=> length($b) } keys %{$local};
#
# foreach my $l (@files) {
# #warn qq{checking for upload: $l};
#
# # warn about softlinks
# if ($local->{$l}{type} eq 'l') {
# warn(qq{symbolic link not supported: $l\n});
# next;
# }
#
# # deal with directories
# if ($local->{$l}{type} eq 'd') {
# if (exists $remote->{$l}) {
# # directory already exists remotely
# next;
# }
# die qq{$l dir missing in the FTP repository\n}
# if ($cliopt->{verbose});
# if ($cliopt->{dryrun}) {
# print "MKDIR $l\n";
# }
# else {
# $ftp->mkdir($l)
# or die "failed to MKDIR $l\n";
# }
# }
#
# # deal with everything else (files)
# else {
# if (
# # file exists on server
# exists $remote->{$l}
# and
# # remote file was modified after local file - no need to update
# ($remote->{$l}{mdtm} >= $local->{$l}{mdtm})
# ) {
# warn qq{$l: remote and ($remote->{$l}{mdtm} < $local->{$l}{mdtm})\n}
# if ($cliopt->{verbose} > 1);
# next;
# }
# else {
# # put, or dry-run the file
# if ($cliopt->{dryrun}) {
# print "PUT $l $l\n";
# }
# else {
# $ftp->put($l, $l)
# or die "Failed to PUT $l\n";
# }
# }
# }
# }
#}
#sub delete_missing_files {
# my ($config, $cliopt, $ftp, $local, $remote) = @_;
#
# my @files = sort { length($a) <=> length($b) } keys %{$local};
#
# foreach my $r (@files) {
# # warn about softlinks
# if ($local->{$r}{type} eq 'l') {
# warn(qq{symbolic link not supported: $r\n});
# next;
# }
#
# # don't DELETE remote item if exists locally
# if (exists $local->{$r}) {
# next;
# }
#
# # put, or dry-run the file
# if ($cliopt->{dryrun}) {
# print "DELETE $r\n";
# }
# else {
# $ftp->delete($r)
# or die "Failed to DELETE $r\n";
# }
# }
#}
#sub do_ftp {
# my ($config, $cliopt, $ftp) = @_;
# my ($local_files, $remote_files);
#
# # get a new ftp client object
# $ftp = ftp_client($config, $cliopt, $ftp);
# if (not defined $ftp) {
# warn(qq{Failed to connect to remote FTP server. Aborting upload.\n});
# return;
# }
#
# # get a list of local files
# warn qq{fetching list of local files...\n} if $cliopt->{verbose};
# $local_files = ftp_local_files($config, $cliopt);
##die pp($local_files);
# # get a list of remote files
# $remote_files = {}; # pre-init variable to an empty hash
# warn qq{fetching list of remote files...\n} if $cliopt->{verbose};
# ftp_remote_files($config, $cliopt, $ftp, '', $remote_files);
##warn pp($remote_files);
#
# upload_missing_files($config, $cliopt, $ftp, $local_files, $remote_files);
# #delete_missing_files($config, $cliopt, $ftp, $local_files, $remote_files);
#}
################################################################################
# new remote-ftp-sync code
################################################################################
sub do_ftpsync {
my ($config, $cliopt, $ftp) = @_;
my (@md5strings, $transfer_actions);
# get a new ftp client object
$ftp = ftp_client($config, $cliopt, $ftp);
if (not defined $ftp) {
warn(qq{Failed to connect to remote FTP server. Aborting upload.\n});
return;
}
# regenerate (local) md5s
find( sub{wanted($config,\@md5strings);}, $config->{output_dir} );
write_file(qq{$config->{output_dir}/digest.md5}, @md5strings);
# get the remote digest
fetch_remote_digest($config);
# work out what needs to happen
$transfer_actions = build_transfer_actions(
qq{$config->{output_dir}/digest.md5},
$config->{tmp_remote_digest},
);
# do the remote update
my $ftp_root = $config->{'ftp'}{'path'} || '/';
do_remote_update($transfer_actions, $ftp, $ftp_root);
# remove the temp file
unlink( $config->{tmp_remote_digest} );
}
sub wanted {
my ($config, $md5string_list) = @_;
if (
-f $_
and
$_ ne q{digest.md5}
and
$_ !~ m{\.sw?}
) {
push @{$md5string_list}, md5file($File::Find::name, $config->{output_dir}) . qq{\n};
}
}
sub md5file {
my ($file, $dir_prefix) = @_;
my ($filedata, $md5sum, $rel_filename, $md5data);
# slurp the file
$filedata = read_file($file)
or die "$file: $!";
# get the md5sum of the file
$md5sum = md5_hex($filedata);
# trim off any leading directories - making filename relative)
if (defined $dir_prefix) {
$rel_filename = $file;
$rel_filename =~ s{\A${dir_prefix}/}{};
}
# return an md5 string
return "$md5sum $rel_filename";
}
sub parse_md5file {
my ($file) = @_;
my (%md5_of, @lines);
# read in the file
@lines = read_file($file)
or die "$file: $!";
# parse/split each line
foreach my $line (@lines) {
chomp($line);
if ($line =~ m{\A([a-z0-9]{32})\s+(.+)\z}xms) {
$md5_of{$2} = $1;
}
}
return \%md5_of;
}
sub build_transfer_actions {
my ($local_digest_file, $remote_digest_file) = @_;
my ($local_md5_of, $remote_md5_of, %transfer_action_of);
$local_md5_of = parse_md5file($local_digest_file);
$remote_md5_of = parse_md5file($remote_digest_file);
# run through the list of files we have locally
foreach my $relpath (sort keys %{$local_md5_of}) {
my $dirname = dirname($relpath);
# does the file live in the server?
if (exists $remote_md5_of->{$relpath}) {
# if the MD5s match - nothing to do
if ($local_md5_of->{$relpath} eq $remote_md5_of->{$relpath}) {
delete $local_md5_of->{$relpath};
delete $remote_md5_of->{$relpath};
next;
}
push @{$transfer_action_of{$dirname}},
{
action => 'update',
relname => $relpath,
};
delete $local_md5_of->{$relpath};
delete $remote_md5_of->{$relpath};
}
# ... it's a new file to put on the server
else {
push @{$transfer_action_of{$dirname}},
{
action => 'new',
relname => $relpath,
};
delete $local_md5_of->{$relpath};
}
}
# anything left in remote is a file we don't have locally
# we'll store actions (remove) for these, but won't act on the
# action until specifically asked
foreach my $relpath (sort keys %{$remote_md5_of}) {
my $dirname = dirname($relpath);
push @{$transfer_action_of{$dirname}},
{
action => 'remove',
relname => $relpath,
};
delete $remote_md5_of->{$relpath};
}
# make sure we didn't miss anything
if (keys %{$local_md5_of}) {
warn qq{Some local files were not processed};
warn qq{Local: } . pp($local_md5_of);
}
if (keys %{$remote_md5_of}) {
warn qq{Some remote files were not processed};
warn qq{Remote: } . pp($remote_md5_of);
}
return \%transfer_action_of;
}
sub do_remote_update {
my $transfer_actions = shift;
my $ftp = shift;
my $ftp_root = shift;
my $errors = 0;
if (not defined $ftp) {
warn(qq{No FTP server defined. Aborting upload.\n});
return;
}
# do transfer actions shortest dirname first
my @remote_dirs = sort {
length($a) <=> length($b)
} keys %{$transfer_actions};
my $ftp_root_status = $ftp->cwd($ftp_root);
if (not $ftp_root_status) {
die "$ftp_root: couldn't CWD to remote directory\n";
}
my $default_dir = $ftp->pwd();
if ($default_dir !~ m{/\z}xms) {
$default_dir .= q{/};
}
# make missing (remote) directories
warn "checking remote directories...\n";
foreach my $dir (@remote_dirs) {
my $status = $ftp->cwd($default_dir . $dir);
if (not $status) {
$ftp->mkdir($default_dir . $dir)
or warn qq{failed to create $dir};
}
}
# return to the default location
$ftp->cwd($default_dir);
# now run through everything and take the appropriate action for files
warn "transferring files...\n";
foreach my $dir (@remote_dirs) {
# run through the actions for the directory
foreach my $action ( @{$transfer_actions->{$dir}} ) {
#warn pp($action);
if ($action->{action} =~ m{\A(?:new|update)\z}) {
if (not $ftp->put( $action->{relname}, $action->{relname} )) {
$errors++;
warn "failed to upload $action->{relname}\n";
}
}
}
}
# if we didn't have any errors, upload the digest
if (not $errors) {
$ftp->put('digest.md5');
}
}
sub fetch_remote_digest {
my ($config) = @_;
# fetch the remote digest (if it exists)
# open it, return path to it
my ($fh, $filename, $ua, $response);
# if website isn't defined in the config - barf
if (not defined $config->{website}) {
die qq{'website' is not defined in .ttsite; can't fetch remote digest.md5\n};
}
# a temporary file to use
($fh, $filename) = tempfile();
$config->{tmp_remote_digest} = $filename;
# get the remote file
$ua = LWP::UserAgent->new;
$ua->timeout(10);
$response = $ua->get($config->{website} . q{digest.md5});
# if we couldn't get it - write an empty one
if (not $response->is_success) {
warn "No remote digest";
print $fh "\n";
close $fh;
return;
}
# write the remote file for local use (in the temp file)
print $fh $response->content;
close $fh;
return $filename;
}
1;
################################################################################
=pod
=head1 NAME
ttsite - Chisel's site templater
=head1 SYNOPSIS
ttsite [options]
Options:
--site=X process site labelled X
--rsync after templating, perform an rsync to the remote server
--rsync-only rsync existing site to the remote server
--fsync after templating, perform an ftp-sync to the remote server
--fsync-only ftp-sync existing site to the remote server
--ftp after templating, use ftp to sync files on the
remote server [DEPRECATED, use --fsync]
--ftp-only skip templating, use ftp to sync files on the
remote server [DEPRECATED, use --fsync-only]
--dryrun show FTP commands but don't perform action
--force force templates to be regenerated regardless of
modification times
--showpath when templating files, show relative path
from <source_dir>
--showdest when templating or copying files, show where
the file was written to
--help show brief help message
--verbose increase the verbosity of the script
=head1 AUTHOR
Chisel Wright C<< <chisel@herlpacker.co.uk> >>
Jason Tang C<< <jason@dragor.net> >> Modification/Refactoring
=cut
__DATA__
---
# which site configuration to use if none are specified on the command line
default_site: 'default'
# site configurations
site:
# default site configuration - simply an example of the format
default:
source_dir: '/path/to/tt_templates'
includes_dir: '/path/to/tt_includes'
output_dir: '/var/www/default_site/html'
template_files:
- '\.html\z'
ignore_dirs:
- 'CVS'
- '.svn'
- 'stats'
- 'tmp'
ignore_files:
- '\.swp\z'
ftp_ignore_dirs:
- '.svn'
- 'tmp'
tags:
author: 'Joe Bloggs'
email: 'joe@localhost'
copyright: '© 2000-2006 Joe Bloggs. All rights reserved.'
rsync:
hostname: 'remote.site'
path: '/home/joe.bloggs'
ftp:
hostname: 'remote.ftp.site'
username: 'joe.bloggs'
password: 'sekrit'
path: '/htdocs/'
# a second site definition - to demonstrate how to define multiple sites
my-site:
source_dir: '/path/to/tt_templates'
includes_dir: '/path/to/tt_includes'
output_dir: '/var/www/default_site/html'
website: 'http://my.site.com/'
template_files:
- '\.html\z'
ignore_dirs:
- 'CVS'
- '.svn'
- 'stats'
- 'tmp'
ignore_files:
- '\.swp\z'
ftp_ignore_dirs:
- '.svn'
- 'tmp'
tags:
author: 'Joe Bloggs'
email: 'joe@localhost'
copyright: '© 2000-2006 Joe Bloggs. All rights reserved.'
rsync:
hostname: remote.ftp.site
path: /home/joe.bloggs