/[pxelator]/lib/PXElator/upstream.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /lib/PXElator/upstream.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 500 - (hide annotations)
Mon May 3 15:15:08 2010 UTC (13 years, 11 months ago) by dpavlin
File size: 1463 byte(s)
allow random junk after .iso

SourceForge has /download after filename

1 dpavlin 138 package upstream;
2    
3     use warnings;
4     use strict;
5     use autodie;
6    
7 dpavlin 266 use Data::Dump qw/dump/;
8 dpavlin 138 use LWP::Simple qw/mirror RC_NOT_MODIFIED/;
9     use server;
10 dpavlin 276 use once;
11 dpavlin 138
12 dpavlin 147 sub mirror_file {
13     my ( $url, $file ) = @_;
14 dpavlin 266 warn "mirror_file $url -> $file\n";
15 dpavlin 147 mirror( $url, $file )
16     == RC_NOT_MODIFIED
17     && warn(" not modified\n")
18     || warn(" done ", -s $file, " bytes\n")
19     ;
20     }
21    
22 dpavlin 138 sub iso {
23     my $url = shift;
24    
25     my $name = (caller(1))[3];
26     $name =~ s{config::}{} || die "caller isn't package config !";
27    
28     warn "$name $url";
29    
30     my $dir = "$server::base_dir/iso";
31     mkdir $dir unless -e $dir;
32    
33 dpavlin 500 my $file = $1 if $url =~ m{/([^/]+\.iso)}i;
34 dpavlin 138 die "can't find iso file in $url" unless $file;
35    
36     my $iso = "$dir/$file";
37    
38 dpavlin 276 mirror_file( $url, $iso ) if once::first_time $url;
39 dpavlin 138
40     $file =~ s{\.iso$}{}i;
41     my $mnt = "$server::base_dir/tftp/$name";
42     mkdir $mnt unless -d $mnt;
43     $mnt .= '/iso';
44     mkdir $mnt unless -d $mnt;
45    
46 dpavlin 147 system("mount -t iso9660 | grep $name/iso || sudo mount $iso $mnt -o loop -t iso9660 -v") == 0;
47 dpavlin 138 }
48    
49 dpavlin 233 sub files {
50     my $url = shift;
51 dpavlin 266 my @files = @_;
52 dpavlin 233
53 dpavlin 266 if ( ! @files ) {
54     push @files, $1 if $url =~ s{/([^/]+)$}{};
55     }
56    
57 dpavlin 233 my $name = (caller(1))[3];
58     $name =~ s{config::}{} || die "caller isn't package config !";
59    
60     my $path = "$server::base_dir/tftp/$name";
61 dpavlin 266 mkdir $path unless -d $path;
62 dpavlin 233
63 dpavlin 266 warn "# files $url ",dump( @files ), " -> $path\n";
64    
65     foreach my $file ( @files ) {
66     mirror_file( "$url/$file", "$path/$file" )
67 dpavlin 276 if ! -e "$path/$file" || once::first_time( "$url/$file" );
68 dpavlin 233 }
69     }
70    
71 dpavlin 138 1;

  ViewVC Help
Powered by ViewVC 1.1.26