| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package GnuGet; | 
| 2 | 1 |  |  | 1 |  | 13408 | use feature qw(say); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 95 |  | 
| 3 | 1 |  |  | 1 |  | 503 | use Net::FTP; | 
|  | 1 |  |  |  |  | 83048 |  | 
|  | 1 |  |  |  |  | 359 |  | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | sub new { | 
| 6 | 0 |  |  | 0 | 0 |  | my $class = shift; | 
| 7 | 0 |  | 0 |  |  |  | $class = ref($class) || $class; | 
| 8 | 0 |  |  |  |  |  | my $self = { ftp => Net::FTP->new("ftp.gnu.org") }; | 
| 9 | 0 |  |  |  |  |  | return bless($self, $class); | 
| 10 |  |  |  |  |  |  | } | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | sub log { | 
| 13 | 0 |  |  | 0 | 0 |  | my ($self, $msg) = @_; | 
| 14 | 0 |  |  |  |  |  | say("[$$] $msg"); | 
| 15 |  |  |  |  |  |  | } | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | sub buildFtpCnx { | 
| 18 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 19 |  |  |  |  |  |  | $self->{ftp}->login("anonymous", '-anonymous@') | 
| 20 | 0 | 0 |  |  |  |  | or die $self->{ftp}->message; | 
| 21 | 0 |  |  |  |  |  | $self->log("connected to GNU ftp"); | 
| 22 | 0 | 0 |  |  |  |  | $self->{ftp}->cwd('/gnu') and $self->log("cwd() in gnu/"); | 
| 23 |  |  |  |  |  |  | } | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | sub download { | 
| 26 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 27 |  |  |  |  |  |  | $self->{ftp}->cwd($self->{software}) | 
| 28 | 0 | 0 |  |  |  |  | and $self->log("cwd() in $self->{software}/"); | 
| 29 |  |  |  |  |  |  | $self->{ftp}->get($self->{archive}) | 
| 30 | 0 | 0 |  |  |  |  | or $self->log("cannot download $self->{archive}"); | 
| 31 | 0 | 0 |  |  |  |  | exit(1) if (! -e $self->{archive}); | 
| 32 | 0 |  |  |  |  |  | $self->log("$self->{archive}'s download successful"); | 
| 33 |  |  |  |  |  |  | } | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | sub populate { | 
| 36 | 0 |  |  | 0 | 0 |  | my ($self, $name, $version) = @_; | 
| 37 | 0 |  |  |  |  |  | $self->{software} = $name; | 
| 38 | 0 |  |  |  |  |  | $self->{version} = $version; | 
| 39 | 0 |  |  |  |  |  | $self->{archive} = $self->{software}."-".$self->{version}.".tar.gz"; | 
| 40 |  |  |  |  |  |  | } | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | sub clean { | 
| 44 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 45 |  |  |  |  |  |  | unlink($self->{archive}) | 
| 46 | 0 | 0 |  |  |  |  | or $self->log("Cannot erase $self->{archive}"); | 
| 47 | 0 |  |  |  |  |  | $self->log("$self->{archive} cleaned"); | 
| 48 | 0 |  |  |  |  |  | $self->{ftp}->quit(); | 
| 49 | 0 |  |  |  |  |  | $self->log("disconnected from GNU ftp"); | 
| 50 |  |  |  |  |  |  | } | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | sub uncompress { | 
| 53 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 54 | 0 | 0 |  |  |  |  | system("tar xf $self->{archive} 2>/dev/null") | 
| 55 |  |  |  |  |  |  | and $self->log("cannot unpack archive"); | 
| 56 | 0 |  |  |  |  |  | $self->log("$self->{archive} unpacked"); | 
| 57 |  |  |  |  |  |  | } | 
| 58 |  |  |  |  |  |  |  | 
| 59 |  |  |  |  |  |  | 1; |