Working synchronization
This commit is contained in:
parent
db77d8b697
commit
3c04523ca8
6 changed files with 135 additions and 44 deletions
120
gen_site.pl
Normal file → Executable file
120
gen_site.pl
Normal file → Executable file
|
|
@ -6,10 +6,19 @@ use warnings;
|
|||
use threads;
|
||||
use threads::shared;
|
||||
|
||||
use Cwd 'abs_path';
|
||||
use File::Basename;
|
||||
use File::Copy;
|
||||
use File::Find;
|
||||
use File::Path qw/make_path remove_tree/;
|
||||
use File::Temp "tempdir";
|
||||
use Getopt::Long;
|
||||
use Thread::Queue;
|
||||
|
||||
our $outdir = "outest";
|
||||
our $outteams = "/teams/";
|
||||
our $outhome = "/htdocs/";
|
||||
our $tmpdir = tempdir();
|
||||
|
||||
our $baseurl = "http://localhost";
|
||||
our $baseadmin = "/admin/";
|
||||
|
|
@ -21,6 +30,7 @@ our $threads = 6;
|
|||
sub genHome(;$)
|
||||
{
|
||||
my $m = shift // Mirror->new();
|
||||
$m->add_url($basehome . "index.html");
|
||||
$m->add_url($basehome);
|
||||
|
||||
return $m;
|
||||
|
|
@ -104,9 +114,19 @@ sub manage
|
|||
elsif (/^(reset)*r(e(s(e(t)?)?)?)?/)
|
||||
{
|
||||
say "Performing RESET ...";
|
||||
remove_tree($main::tmpdir);
|
||||
mkdir($main::tmpdir);
|
||||
$m->reset();
|
||||
}
|
||||
elsif (/^J$/)
|
||||
elsif (/^(D)?(SYNC)*S(Y(N(C)?)?)?/)
|
||||
{
|
||||
sync($1);
|
||||
}
|
||||
elsif (/^LS$/)
|
||||
{
|
||||
system("ls '$main::tmpdir'");
|
||||
}
|
||||
elsif (/^J(O(I(N)?)?)?$/)
|
||||
{
|
||||
say "JOIN receive, stopping all threads...";
|
||||
$m->stop();
|
||||
|
|
@ -144,6 +164,77 @@ sub manage
|
|||
}
|
||||
}
|
||||
|
||||
sub sync
|
||||
{
|
||||
if (shift)
|
||||
{
|
||||
say "Full synchronization to $main::outdir";
|
||||
|
||||
my $tmpcopy = tempdir();
|
||||
|
||||
find(
|
||||
sub
|
||||
{
|
||||
if (-f)
|
||||
{
|
||||
my $todir = $File::Find::dir."/";
|
||||
if ($todir =~ /^\Q$main::tmpdir\E\/?(\Q$main::baseadmin\E|\Q$main::baseteams\E|\Q$main::basehome\E)(.*)$/)
|
||||
{
|
||||
$todir = $tmpcopy;
|
||||
|
||||
return if ($1 eq $main::baseadmin);
|
||||
$todir .= $main::outteams if ($1 eq $main::baseteams);
|
||||
$todir .= $main::outhome if ($1 eq $main::basehome);
|
||||
|
||||
$todir .= $2;
|
||||
}
|
||||
make_path($todir, { mode => 0711 }) if (! -d $todir );
|
||||
|
||||
copy($File::Find::name, $todir) or warn(q{copy failed:} . $!);
|
||||
}
|
||||
},
|
||||
$tmpdir
|
||||
);
|
||||
|
||||
abs_path($main::outdir);
|
||||
abs_path($tmpcopy);
|
||||
|
||||
remove_tree($main::outdir);
|
||||
|
||||
system("mv '$tmpcopy' '$main::outdir'");
|
||||
}
|
||||
else
|
||||
{
|
||||
say "Incremental synchronization to $main::outdir";
|
||||
|
||||
find(
|
||||
sub
|
||||
{
|
||||
if (-f)
|
||||
{
|
||||
my $todir = $File::Find::dir."/";
|
||||
if ($todir =~ /^\Q$main::tmpdir\E\/?(\Q$main::baseadmin\E|\Q$main::baseteams\E|\Q$main::basehome\E)(.*)$/)
|
||||
{
|
||||
$todir = $main::outdir;
|
||||
|
||||
return if ($1 eq $main::baseadmin);
|
||||
$todir .= $main::outteams if ($1 eq $main::baseteams);
|
||||
$todir .= $main::outhome if ($1 eq $main::basehome);
|
||||
|
||||
$todir .= $2;
|
||||
}
|
||||
make_path($todir, { mode => 0711 }) if (! -d $todir );
|
||||
|
||||
say "$File::Find::name -> $todir";
|
||||
|
||||
copy($File::Find::name, $todir) or warn(q{copy failed:} . $!);
|
||||
}
|
||||
},
|
||||
$tmpdir
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
sub parse($$)
|
||||
{
|
||||
my $m = shift;
|
||||
|
|
@ -189,6 +280,8 @@ GetOptions ("threads|thread|t=i" => \$threads,
|
|||
"deamon|d" => \$deamon,
|
||||
"help|h|?" => \$help);
|
||||
|
||||
$outdir = abs_path($outdir);
|
||||
|
||||
if ($deamon)
|
||||
{
|
||||
my $m :shared = Mirror->new();
|
||||
|
|
@ -222,8 +315,12 @@ else
|
|||
genHome($m);
|
||||
|
||||
$m->join();
|
||||
|
||||
sync(1);
|
||||
}
|
||||
|
||||
remove_tree($main::tmpdir);
|
||||
|
||||
|
||||
package Mirror;
|
||||
|
||||
|
|
@ -461,21 +558,30 @@ sub getLinks($)
|
|||
{
|
||||
my $self = shift;
|
||||
|
||||
return $self->{content} =~ /(?:src|href)="([^"]+)"/g;
|
||||
return $self->{content} =~ /(?:src|href|action)="([^"]+)"/g;
|
||||
}
|
||||
|
||||
sub getNearLinks($)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
return $self->{content} =~ /(?:src|href)="(?:\Q$main::baseurl\E|(?:\/?\.\.)+)?([^:"]+)"/g;
|
||||
my @links = $self->{content} =~ /(?:src|href)="(?:\Q$main::baseurl\E|(?:\/?\.\.)+)?([^:"]+)"/g;
|
||||
|
||||
for my $action ($self->{content} =~ /action="(?:\Q$main::baseurl\E|(?:\/?\.\.)+)?([^:"]+)"/g)
|
||||
{
|
||||
push @links, $action;
|
||||
push @links, "$action/gerr";
|
||||
push @links, "$action/serr";
|
||||
}
|
||||
|
||||
return @links;
|
||||
}
|
||||
|
||||
sub treatLinks($)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->{content} =~ s!(src|href)="( \Q$baseteams\E[^/]+/ | \Q$baseadmin\E | \Q$basehome\E)([^"]*)"!$1="/$3"!gx;
|
||||
$self->{content} =~ s!(src|href|action)="( \Q$baseteams\E[^/]+/ | \Q$baseadmin\E | \Q$basehome\E)([^"]*)"!$1="/$3"!gx;
|
||||
}
|
||||
|
||||
sub fetch($)
|
||||
|
|
@ -499,7 +605,7 @@ sub alreadySaved($;$)
|
|||
sub getSavePath($;$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $basedir = shift // $main::outdir;
|
||||
my $basedir = shift // $main::tmpdir;
|
||||
|
||||
# Convert URL to real directory path
|
||||
my $path = $self->{url};
|
||||
|
|
@ -520,7 +626,7 @@ sub save($;$)
|
|||
if ($path =~ /\.[a-z0-9]{2,4}$/)
|
||||
{
|
||||
eval {
|
||||
make_path( dirname("$path") ) if (! -d dirname("$path") );
|
||||
make_path( dirname("$path") , { mode => 0711 }) if (! -d dirname("$path") );
|
||||
};
|
||||
|
||||
open my $fd, ">", $path or die "$path: $!";
|
||||
|
|
@ -530,7 +636,7 @@ sub save($;$)
|
|||
else
|
||||
{
|
||||
eval {
|
||||
make_path "$path" if (! -d "$path");
|
||||
make_path "$path", { mode => 0711 } if (! -d "$path");
|
||||
};
|
||||
|
||||
open my $fd, ">", "$path/index.html" or die "$path: $!";
|
||||
|
|
|
|||
Reference in a new issue