App-DistSync
view release on metacpan or search on metacpan
lib/App/DistSync.pm view on Meta::CPAN
for (keys %$dellist) {$skips{$_} = qrreconstruct($_)}
}
# Reading the MIRRORS file and deciding whether to synchronize or not
debug("Synchronization");
my $mirrors_mani = maniread($self->{file_mirrors}) // {}; # MIRRORS
my @mirrors = sort {$a cmp $b} keys %$mirrors_mani;
if (scalar(@mirrors)) {
foreach my $url (@mirrors) {
debug("RESOURCE \"%s\"", $url);
# 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;
debug("> [SKIPPED] Current resource SHOULD NOT update itself");
} else {
debug("> [SKIPPED] 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 $fetch_meta = $self->fetch($url, METAFILE, $self->{file_manitemp});
if ($fetch_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') {
debug("> [SKIPPED] Remote resource is unreadable. Please contact the administrator of this resource");
next;
}
if ($remote_meta->{status}) {
my $remote_url = $remote_meta->{url} || $remote_meta->{uri} || '';
my $remote_date = $fetch_meta->{mtime} || 0;
my $remote_datef = $remote_date ? scalar(localtime($remote_date)) : 'UNKNOWN';
my $remote_ok = (time - $remote_date) > _expire(FREEZE) ? 0 : 1;
if ($self->verbose) {
debug("RESOURCE INFORMATION:");
debug(" Resource URL : %s", $remote_url);
debug(" Date : %s", $remote_meta->{date} // 'UNKNOWN');
debug(" Modified : %s", $remote_datef);
debug(" Hostname : %s", $remote_meta->{hostname} // '');
debug(" Directory : %s", $remote_meta->{directory} // '');
debug(" Project : %s v%s",
$remote_meta->{project} || ref($self), $remote_meta->{version} // '0.01');
debug(" Script : %s", $remote_meta->{script} // '');
debug(" Status : %s", $remote_ok ? "OK" : "EXPIRED");
debug(" Time : %d sec", $remote_meta->{'time'} || 0);
}
unless ($remote_ok) {
debug("> [SKIPPED] Remote resource is expired. Last updated: %s", $remote_datef);
next
}
} else {
debug("> [SKIPPED] Remote resource is broken. Please contact the administrator of this resource");
next;
}
} else {
printf STDERR "Can't download \"%s\": %s\n", $fetch_meta->{url}, $fetch_meta->{message};
}
}
# Downloading the MANIFEST file
{
debug("Fetching %s", MANIFEST);
my $fetch_mani = $self->fetch($url, MANIFEST, $self->{file_manitemp});
if ($fetch_mani->{status}) {
my $remote_manifest = maniread($self->{file_manitemp}) // {};
my %mtmp; # {file => count} Temporary work structure
# Two manifest lists - local and remote - are merged into a temporary structure
# {file => [epoch, size, wday, month, day, time, year]}
foreach my $k (keys(%$manifest), keys(%$remote_manifest)) {
unless (exists $mtmp{$k}) {
$mtmp{$k} = 1;
next;
}
my $mt_l = $manifest->{$k}[0] || 0; # Modified time (local, left)
my $mt_r = $remote_manifest->{$k}[0] || 0; # Modified time (remote, right)
$mtmp{$k}++ if $mt_l && $mt_r && $mt_l == $mt_r; # =2 if the files are identical
}
#debug(Data::Dumper::Dumper(\%mtmp));
# Getting the difference between the lists of local and remote files
#
# [=] The files do not differ; they are identical in both lists
# [<] The file exists in the local (left) file list
# [>] The file exists in the remote (right) file list
# [{] The "newer" file is the one in the local list
# [}] The "newer" file is the one in the remote list
# [~] The file sizes differ between the lists. This is only reported as information,
# since modification times and file presence have higher priority than sizes
# [!] A conflict situation. An almost impossible edge case
#
# The comparison works as follows:
# We iterate through the entries of the manifest structures (the left and right lists)
# and analyze where the counter value is 1 and where it is 2.
# A value of 1 means that the file exists in only one of the file lists - but in which one?
# If it's the left list, the line is marked with "<", as described in the legend above;
# if it's the right list, the line is marked with ">".
my $lim = _expire(LIMIT); # 1 min
foreach my $k (keys %mtmp) {
next unless $mtmp{$k}; # Skip broken records
next unless $mtmp{$k} == 1; # Files are NOT idential
if ($manifest->{$k} && $remote_manifest->{$k}) { # Both sides: left and right
my $mt_l = $manifest->{$k}[0] || 0;
my $mt_r = $remote_manifest->{$k}[0] || 0;
if (($mt_l > $mt_r) && ($mt_l - $mt_r) > $lim) {
# Skip! The left (local) file is more than one minute newer than the right one
# debug("# [{] %s", $k) if $self->verbose;
} if (($mt_l < $mt_r) && ($mt_r - $mt_l) > $lim) {
lib/App/DistSync.pm view on Meta::CPAN
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;
}
sub mkmani {
my $self = shift;
my %skips; # { file => /regexp/|file } List of skipped files
# Filling the list of exclusion files using the MANIFEST.SKIP file and
# the list of system files from the SKIPFILES constant
{
debug("Getting the list of skipped files");
my @skip_keys = @{(SKIPFILES)};
my $maniskip = maniread($self->{file_maniskip}, SKIPMODE); # MANIFEST.SKIP
push @skip_keys, keys %$maniskip if ref($maniskip) eq 'HASH';
for (@skip_keys) {$skips{$_} = qrreconstruct($_)}
debug("Found %d keys in the list of skipped files", scalar(keys %skips));
}
# Getting list files from MANIFEST.DEL file but not in the exclusion list
{
debug("Getting list files from: %s", MANIDEL);
my $delfile = $self->{file_manidel}; # MANIFEST.DEL
my $dellist = maniread($delfile) // {}; # { file => expire };
#debug(Data::Dumper::Dumper($dellist));
# Check by exclusion list
foreach my $k (keys %$dellist) {
if (_skipcheck(\%skips, $k)) { # The file is in the exclusion list.
debug("> [SKIPPED] %s", $k);
next;
}
# Adding files listed in MANIFEST.DEL to the exclusion list
$skips{$k} = qrreconstruct($k);
}
#debug(Data::Dumper::Dumper(\%skips));
}
# Cteating MANIFEST file
debug("Generating new manifest");
my $new_manifest = manifind($self->dir);
# We select files excluding files listed in the exclusion list
foreach my $k (keys %$new_manifest) {
my $nskip = _skipcheck(\%skips, $k);
delete $new_manifest->{$k} if $nskip;
debug("> [%s] %s", $nskip ? "SKIPPED" : " ADDED ", $k);
}
#debug(Data::Dumper::Dumper($new_manifest));
# Save the created file
debug("Saving manifest to %s", MANIFEST);
return 0 unless maniwrite($self->{file_manifest}, $new_manifest);
( run in 1.151 second using v1.01-cache-2.11-cpan-39bf76dae61 )