view release on metacpan or  search on metacpan

GMOD/Util/Mirror.pm  view on Meta::CPAN

  # return shift->{path};}
  my $p = $_[0]->{path};
  $_[0]->{path} = $_[1] if defined $_[1];
  $p;
}

sub ftp  {
  # return shift->{ftp}; }
  my $p = $_[0]->{ftp};
  $_[0]->{ftp} = $_[1] if defined $_[1];
  $p;
}

sub verbose {
  # return shift->{verbose}; }
  my $p = $_[0]->{verbose};
  $_[0]->{verbose} = $_[1] if defined $_[1];
  $p;
}

# top-level entry point for mirroring.
sub mirror {
  my $self = shift;
  $self->path(shift) if @_;
  my $path = $self->path;
  
  my $cd;
  if ($self->{localpath}) {
    chomp($cd = `pwd`);
    chdir($self->{localpath}) or croak "can't chdir to $self->{localpath}: $!";
  }

  my $type = $self->find_type($self->path) or croak "top level file/directory not found";
  my ($prefix,$leaf) = $path =~ m!^(.*?)([^/]+)/?$!;
  $self->ftp->cwd($prefix) if $prefix;

  my $ok;
  if ($type eq '-') {  # ordinary file
    $ok = $self->get_file($leaf);
  } elsif ($type eq 'd') {  # directory
    $ok = $self->get_dir($leaf);
  } else {
    carp "Can't parse file type for $leaf\n";
    return;
  }
  
  chdir $cd if $cd;
  $ok;
}

# mirror a file
sub get_file {
  my $self = shift;
  my ($path,$mode) = @_;
  my $ftp = $self->ftp;
  
  my $rtime = $ftp->mdtm($path);
  my $rsize = $ftp->size($path);
  $mode = ($self->parse_listing($ftp->dir($path)))[2] unless defined $mode;
  
  my ($lsize,$ltime) = stat($path) ? (stat(_))[7,9] : (0,0);
  if ( defined($rtime) and defined($rsize) 
       and ($ltime >= $rtime) 
       and ($lsize == $rsize) ) {
    $self->warning(-msg => "Getting file $path: not newer than local copy.") if $self->verbose;
    return 1;
  }

  $self->logit(-msg => "Downloading file $path");
  $ftp->get($path) or ($self->warning(-msg=>$ftp->message) and return);
  chmod $mode,$path if $mode;
}

# mirror a directory, recursively
sub get_dir {
  my $self = shift;
  my ($path,$mode) = @_;
  
  my $localpath = $path;
  -d $localpath or mkpath $localpath or carp "mkpath failed: $!" && return;
  chdir $localpath                   or carp "can't chdir to $localpath: $!" && return;
  $mode = 0755 if ($mode == 365); # Kludge-can't mirror non-writable directories
  chmod $mode,'.' if $mode;
  
  my $ftp = $self->ftp;
  
  my $cwd = $ftp->pwd                or carp("can't pwd: ",$ftp->message) && return;
  $ftp->cwd($path)                   or carp("can't cwd: ",$ftp->message) && return;
  
  $self->logit(-msg => "Downloading directory $path") if $self->verbose;

  foreach ($ftp->dir) {
    next unless my ($type,$name,$mode) = $self->parse_listing($_);
    next if $name =~ /^(\.|\.\.)$/;  # skip . and ..
    $self->get_dir ($name,$mode)    if $type eq 'd';
    $self->get_file($name,$mode)    if $type eq '-';
    $self->make_link($name)         if $type eq 'l';
  }
  
  $ftp->cwd($cwd)     or carp("can't cwd: ",$ftp->message) && return;
  chdir '..';
}

# subroutine to determine whether a path is a directory or a file
sub find_type {
  my $self = shift;
  my $path = shift;
  
  my $ftp = $self->ftp;
  my $pwd = $ftp->pwd;
  my $type = '-';  # assume plain file
  if ($ftp->cwd($path)) {
    $ftp->cwd($pwd);
    $type = 'd';
  }
  return $type;
}

# Attempt to mirror a link.  Only works on relative targets.
sub make_link {
  my $self = shift;