lib/PXElator/upstream.pm

package upstream;

use warnings;
use strict;
use autodie;

use Data::Dump qw/dump/;
use LWP::Simple qw/mirror RC_NOT_MODIFIED/;
use server;
use once;

sub mirror_file {
        my ( $url, $file ) = @_;

        return unless once::first_time $file;

        warn "mirror_file $url -> $file\n";
        mirror( $url, $file )
                == RC_NOT_MODIFIED
                && warn(" not modified\n")
                || warn(" done ", -s $file, " bytes\n")
                ;
}

=head2 iso

  my $iso_path = upstream::iso 'http://example.com/bootable.iso';

=cut

sub iso {
        my $url = shift;

        my $name = (caller(1))[3];
        $name =~ s{config::}{} || die "caller isn't package config !";

        warn "$name $url";

        my $dir = "$server::base_dir/iso";
        mkdir $dir unless -e $dir;

        my $file = $1 if $url =~ m{/([^/]+\.iso)}i;
        die "can't find iso file in $url" unless $file;

        my $iso = "$dir/$file";

        mirror_file( $url, $iso );

        $file =~ s{\.iso$}{}i;
        my $mnt = "$server::base_dir/tftp/$name";
        mkdir $mnt unless -d $mnt;
        $mnt .= '/iso';
        mkdir $mnt unless -d $mnt;

        system("mount -t iso9660 | grep $name/iso || sudo mount $iso $mnt -o loop -t iso9660 -v") == 0;
        return $iso;
}

=head2 files

  my $to_dir = upstream::files qw(http://base.url.example.com/ file1 file2 file2);

=cut

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 ( @files ) {
                mirror_file( "$url/$file", "$path/$file" )
                        if ! -e "$path/$file" || once::first_time( "$url/$file" );
        }

        return $path;
}

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