App-DistSync
view release on metacpan or search on metacpan
bin/distsync view on Meta::CPAN
verbose => $options->{verbose},
insecure=> $options->{insecure},
proxy => $options->{proxy},
);
my $exitval = 1; # error
# Init
if ($command eq 'init') {
$ds->init or goto FINISH;
say "The work directory has been successfully initialized";
printf "Your files are in \"%s\"\n", $ds->dir if $options->{verbose};
$exitval = 0; # Ok
}
# Status
elsif ($command eq 'status') {
if ($ds->status) {
$ds->_show_summary;
$exitval = 0; # Ok
}
}
# Sync
elsif ($command eq 'sync') {
if ($ds->sync) {
say "Sync successfully completed";
goto FINISH unless $options->{verbose};
$ds->_show_summary;
$exitval = 0; # Ok
} else {
printf("Sync \"%s\" completed with errors\n", $ds->dir);
}
}
# Make manifest file
elsif ($command eq 'manifest' or $command eq 'mkmani') {
if ($ds->mkmani) {
say sprintf "The MANIFEST file has been successfully generated in \"%s\"", $ds->dir;
$exitval = 0; # Ok
} else {
printf("Failed to generate MANIFEST file in \"%s\"\n", $ds->dir);
}
}
FINISH: debug("%s FINISH", tms);
warn $lock->error . "\n" if $lock->unlock->error;
exit $exitval;
lib/App/DistSync.pm view on Meta::CPAN
"",
"# Avoid Apache and building files",
"!!perl/regexp (?i-xsm:\\B\\.ht.+\$)",
"!!perl/regexp (?i-xsm:\\B\\.exists\$)",
"",
"# Skip TEMP files",
"!!perl/regexp (?i-xsm:\\.TEMP\\-\\d+\$)",
"\n",
);
if (spew($self->{file_maniskip}, join("\n", @content))) {
say "ok";
} else {
say "fail";
$status = 0;
}
} else {
say "skip";
}
# MANIFEST.DEL
printf "%s... ", $self->{file_manidel};
if (touch($self->{file_manidel}) && (-e $self->{file_manidel}) && -z $self->{file_manidel}) {
my @content = (
"# Generated on $stamp",
"# List of files that must be deleted. By default, the files will be",
"# deleted after 3 days.",
"#",
lib/App/DistSync.pm view on Meta::CPAN
"#",
"# dir1/dir2/.../dirn/foo.txt 1d",
"# bar.txt 2M",
"# baz.txt",
"# 'spaced dir1/foo.txt' 1m",
"# 'spaced dir1/foo.txt' 2y",
"#",
"\n",
);
if (spew($self->{file_manidel}, join("\n", @content))) {
say "ok";
} else {
say "fail";
$status = 0;
}
} else {
say "skip";
}
# MIRRORS
printf "%s... ", $self->{file_mirrors};
if (touch($self->{file_mirrors}) && (-e $self->{file_mirrors}) && -z $self->{file_mirrors}) {
my @content = (
"# Generated on $stamp",
"# List of addresses (URIs) of remote storage (mirrors).",
"# Must be specified at least two mirrors",
"#",
"# Format of file:",
"#",
"# http://www.example.com/dir1 any comment, for example blah-blah-blah",
"# http://www.example.com/dir2 any comment, for example blah-blah-blah",
"# 'http://www.example.com/dir2' any comment, for example blah-blah-blah",
"#",
"\n",
);
if (spew($self->{file_mirrors}, join("\n", @content))) {
say "ok";
} else {
say "fail";
$status = 0;
}
} else {
say "skip";
}
# README
printf "%s... ", $self->{file_readme};
if (touch($self->{file_readme}) && (-e $self->{file_readme}) && -z $self->{file_readme}) {
my @content = (
"# This file contains information about the resource (mirror) in the free form.",
"#",
"# Initialization date : $stamp",
"# Resource's directory : " . $self->dir,
"#",
"\n",
);
if (spew($self->{file_readme}, join("\n", @content))) {
say "ok";
} else {
say "fail";
$status = 0;
}
} else {
say "skip";
}
return $status;
}
sub sync { # Synchronization. Main proccess
my $self = shift;
my $status = 0;
my %skips; # { file => /regexp/|file } List of skipped files
my $manifest = maniread($self->{file_manifest}) // {}; # {file => [epoch, size, wday, month, day, time, year]}
my %sync_list; # {file => [{url, mtime, size}]} List of files to sync
lib/App/DistSync.pm view on Meta::CPAN
my $response = $ua->request($request);
my $content_type = scalar $response->header('Content-Type');
my $document_length = scalar $response->header('Content-Length');
my $modified_time = HTTP::Date::str2time($response->header('Last-Modified'));
my $expires = HTTP::Date::str2time($response->header('Expires'));
my $server = scalar $response->header('Server');
$ret->{code} = $response->code;
$ret->{message} = $response->message;
if ($self->verbose) {
if (!$DEBUG && !$response->is_success) {
say sprintf "> HEAD %s", $uri->as_string;
say sprintf "< %s", $response->status_line;
}
debug("> HEAD %s", $uri->as_string);
debug("< %s", $response->status_line);
if ($response->is_success) {
debug("< Content-Type : %s", $content_type // '');
debug("< Content-Length : %s", $document_length || 0);
debug("< Last-Modified : %s", $modified_time ? scalar(localtime($modified_time)) : '');
debug("< Expires : %s", $expires ? scalar(localtime($expires)) : '');
debug("< Server : %s", $server // '');
} else {
lib/App/DistSync.pm view on Meta::CPAN
printf STDERR "Can't move file \"%s\" to \"%s\": %s\n", $file, $temp, $!;
return $ret;
}
}
# Request
$response = $ua->mirror($uri, $file);
$ret->{code} = $response->code;;
$ret->{message} = $response->message;
if ($self->verbose) {
debug("> GET %s", $uri->as_string) or say sprintf "> GET %s", $uri->as_string;
debug("< %s", $response->status_line) or say sprintf "< %s", $response->status_line;
}
if ($response->is_success) {
if (-e $file && (-s $file) == $ret->{size}) {
$ret->{status} = 1;
fdelete($temp);
}
} else {
debug("Can't fetch %s. %s", $uri->as_string, $response->status_line);
return $ret;
}
lib/App/DistSync.pm view on Meta::CPAN
return $ret;
}
sub status { # Show statistic information
my $self = shift;
# Read MIRRORS file
my $mirrors_mani = maniread($self->{file_mirrors}) // {}; # MIRRORS
my @mirrors = sort {$a cmp $b} keys %$mirrors_mani;
unless (scalar(@mirrors)) {
say STDERR sprintf "File %s is empty", MIRRORS;
return;
}
# Go!
foreach my $url (@mirrors) {
say sprintf "RESOURCE \"%s\"", $url;
my $self_mode = 0;
# Downloading the MANIFEST.LOCK file, skipping the mirror resource if this
# file was successfully downloaded from the resource
{
debug("Fetching %s", MANILOCK);
my $fetch_lock = $self->fetch($url, MANILOCK, $self->{file_manitemp});
if ($fetch_lock->{status}) { # Ok
if ($self->_check_lockfile($self->{file_manitemp})) {
$self->{url} = $url;
$self_mode = 1;
} else {
say STDERR "Remote resource is in a state of updating. Please wait";
next;
}
}
}
# Downloading the META file and analyzing the resource (checking the resource
# status and update date). If the check fails, the resource is skipped.
{
debug("Fetching %s", METAFILE);
my $meta = $self->fetch($url, METAFILE, $self->{file_manitemp});
if ($meta->{status}) { # Ok
my $remote_meta = read_yaml($self->{file_manitemp}) // '';
if (((ref($remote_meta) eq 'ARRAY') || ref($remote_meta) eq 'YAML::Tiny')) {
$remote_meta = $remote_meta->[0] || {};
}
unless ($remote_meta && ref($remote_meta) eq 'HASH') {
say STDERR "Remote resource is unreadable. Please contact the administrator of this resource";
next;
}
unless ($remote_meta->{status}) {
say STDERR "Remote resource is broken. Please contact the administrator of this resource";
next;
}
# Show information
my $remote_url = $remote_meta->{url} || $remote_meta->{uri} || '';
my $remote_date = $meta->{mtime} || 0;
my $remote_datef = $remote_date ? scalar(localtime($remote_date)) : 'UNKNOWN';
my $remote_ok = (time - $remote_date) > _expire(FREEZE) ? 0 : 1;
say sprintf " Resource URL : %s%s", $remote_url, $self_mode ? " (LOCAL RESOURCE)" : '';
say sprintf " Status : %s", $remote_ok ? "OK" : "EXPIRED";
say sprintf " Date : %s", $remote_meta->{date} // 'UNKNOWN';
say sprintf " Modified : %s", $remote_datef;
say sprintf " Hostname : %s", $remote_meta->{hostname} // '';
say sprintf " Directory : %s", $remote_meta->{directory} // '';
say sprintf " Project : %s v%s", $remote_meta->{project} || ref($self), $remote_meta->{version} // '';
say sprintf " Script : %s", $remote_meta->{script} // $Script;
say sprintf " Time : %d sec", $remote_meta->{'time'} || 0;
unless ($remote_ok) {
say STDERR sprintf "NOTE! The resource is expired. Last updated: %s", $remote_datef;
next
}
} else {
printf STDERR "Can't download \"%s\": %s\n", $meta->{url}, $meta->{message};
}
}
}
return 1;
}
lib/App/DistSync.pm view on Meta::CPAN
}
my ($r_pid, $r_stamp, $r_name) = split(/#/, $l);
return 0 unless $r_pid && ($r_pid =~ /^[0-9]{1,11}$/);
return 1 if kill(0, $r_pid) && $pid == $r_pid;
return 0;
}
sub _show_summary {
my $self = shift;
my $now = time;
say "SHORT SUMMARY";
printf " Local URL : %s\n", $self->{url} // 'undefined';
printf " Hostname : %s\n", $self->{hostname};
printf " Directory : %s\n", $self->dir;
printf " Insecure mode : %s\n", $self->{insecure} ? 'Yes' : 'No';
printf " Proxy : %s\n", $self->{proxy} || 'none';
printf " Started : %s\n", scalar(localtime($self->{started}));
printf " Finished : %s\n", scalar(localtime($now));
printf " Time : %d sec\n", $now - $self->{started};
return 1;
}
( run in 0.332 second using v1.01-cache-2.11-cpan-d7a12ab2c7f )