support for mirroring single file specified as url only
authorDobrica Pavlinusic <dpavlin@rot13.org>
Wed, 19 Aug 2009 17:00:46 +0000 (17:00 +0000)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Wed, 19 Aug 2009 17:00:46 +0000 (17:00 +0000)
lib/PXElator/upstream.pm

index 56d14e5..76ee8fe 100644 (file)
@@ -4,13 +4,14 @@ use warnings;
 use strict;
 use autodie;
 
+use Data::Dump qw/dump/;
 use LWP::Simple qw/mirror RC_NOT_MODIFIED/;
 use Storable;
 use server;
 
 sub mirror_file {
        my ( $url, $file ) = @_;
-       print STDERR "mirror $url";
+       warn "mirror_file $url -> $file\n";
        mirror( $url, $file )
                == RC_NOT_MODIFIED
                && warn(" not modified\n")
@@ -58,15 +59,23 @@ sub iso {
 
 sub files {
        my $url = shift;
+       my @files = @_;
+
+       if ( ! @files ) {
+               push @files, $1 if $url =~ s{/([^/]+)$}{};
+       }
 
        my $name = (caller(1))[3];
        $name =~ s{config::}{} || die "caller isn't package config !";
 
        my $path = "$server::base_dir/tftp/$name";
+       mkdir $path unless -d $path;
+
+       warn "# files $url ",dump( @files ), " -> $path\n";
 
-       foreach my $file ( @_ ) {
-               mirror_file "$url/$file", "$path/$file"
-                       if first_time( "$url/$file" );
+       foreach my $file ( @files ) {
+               mirror_file( "$url/$file", "$path/$file" )
+                       if ! -e "$path/$file" || first_time( "$url/$file" );
        }
 }