File Coverage

blib/lib/Net/SFTP/Foreign/Tempdir/Extract.pm

Criterion	Covered	Total	%
statement	18	115	15.6
branch	0	80	0.0
condition	0	6	0.0
subroutine	6	22	27.2
pod	13	13	100.0
total	37	236	15.6

package Net::SFTP::Foreign::Tempdir::Extract;
use strict;
use warnings;
use base qw{Package::New};
use File::Tempdir qw{};
use Net::SFTP::Foreign qw{};
use Net::SFTP::Foreign::Tempdir::Extract::File;

our $VERSION = '0.14';

=head1 NAME

Net::SFTP::Foreign::Tempdir::Extract - Secure FTP client integrating Path::Class, Tempdir, and Archive Extraction

=head1 SYNOPSIS

  use Net::SFTP::Foreign::Tempdir::Extract;
  my $sftp = Net::SFTP::Foreign::Tempdir::Extract->new(
                                                       host   => $host,
                                                       user   => $user,
                                                       match  => qr/\.zip\Z/,
                                                       backup => './backup', #default is not to backup
                                                       delete => 1,          #default is not to delete
                                                      );
  my $file = $sftp->next;

=head1 DESCRIPTION

Secure FTP client which downloads files locally to a temp directory for operations and automatically cleans up all temp files after variables are out of scope.

This package assume SSH keys are correctly installed on local account and remote server.

=head1 USAGE

=head2 File Downloader

This is a simple file downloader implementation

  use Net::SFTP::Foreign::Tempdir::Extract;
  my $sftp = Net::SFTP::Foreign::Tempdir::Extract->new(host=>$remote_host, user=>$remote_user);
  my $file = $sftp->download($remote_folder, $remote_filename);

=head2 File Watcher

This is a simple file watcher implementation

  use Net::SFTP::Foreign::Tempdir::Extract;
  my $sftp = Net::SFTP::Foreign::Tempdir::Extract->new(
                                                       host=>'remote_server',
                                                       user=>'remote_account',
                                                       match=>qr/\.zip\Z/,
                                                       folder=>'/remote_folder'
                                                      );
  my $file = $sftp->next or exit;        #nothing to process so exit
  print "$file";                       #process file here

=head2 Subclass

This is a typical subclass implementation for a particular infrastructure

  {
    package My::SFTP;
    use base qw{Net::SFTP::Foreign::Tempdir::Extract};
    sub host   {'remote_server.domain.tld'};
    sub folder {'/remote_folder'};
    sub match  {qr/\.zip\Z/};
    sub backup {time};
    1;
  }

  my $sftp = My::SFTP->new;
  while (my $file = $sftp->next) {
    printf "File %s is a %s\n", "$file", ref($file);
  }

Which outputs something like this.

  File /tmp/hwY9jVeYo3/file1.zip is a Net::SFTP::Foreign::Tempdir::Extract::File
  File /tmp/ytWaYdPXuD/file2.zip is a Net::SFTP::Foreign::Tempdir::Extract::File
  File /tmp/JrsrkleBOy/file3.zip is a Net::SFTP::Foreign::Tempdir::Extract::File

=head1 CONSTRUCTOR

=head2 new

=head1 METHODS

=head2 download

Downloads the named file in the folder.

  my $file = $sftp->download('remote_file.zip');                   #isa Net::SFTP::Foreign::Tempdir::Extract::File
  my $file = $sftp->download('/remote_folder', 'remote_file.zip'); #  which isa Path::Class::File object with an extract method

=cut

sub download {
  my $self         = shift;
  my $sftp         = $self->sftp;
  my $remote       = pop                    or die('Error: filename required.');
  my $folder       = shift                  || $self->folder;
  my $tmpdir       = File::Tempdir->new     or die('Error: Could not create File::Tempdir object');
  my $local_folder = $tmpdir->name          or die('Error: Temporary directory not configured.');
  $sftp->setcwd($folder)                    or die(sprintf('Error: %s', $sftp->error));
  $sftp->mget($remote, $local_folder)       or die(sprintf('Error: %s', $sftp->error));
  my $file         = Net::SFTP::Foreign::Tempdir::Extract::File->new($local_folder => $remote);
  die("Error: Could not read $file.") unless -r $file;
  $file->{'__tmpdir'}=$tmpdir; #must keep tmpdir scope alive
  my $backup = $self->backup;
  if ($backup) {
    $sftp->mkpath($backup)                    or die('Error: Cannot create backup directory');
    $sftp->rename($remote, "$backup/$remote") or die("Error: Cannot rename remote file $remote to $backup/$remote");
  } elsif ($self->delete) {
    $sftp->remove($remote)                    or warn("Warning: Cannot delete remote file $remote");
  }
  return $file;
}

=head2 next

Downloads the next file in list and saves it locally to a temporary folder. Returns a L object or undef if there are no more files.

  my $file = $sftp->next or exit;  #get file or exit

  while (my $file = $sftp->next) {
    print "$file";
  }

=cut

sub next {
  my $self=shift;
  my $list=$self->list;
  if (@$list) {
    my $file=shift @$list;
    #print Dumper($file);
    return $self->download($file);
  } else {
    return;
  }
}

=head2 list

Returns list of filenames remaining to be processed that match the folder and regular expression

Note: List is shifted for each call to next method

=cut

sub list {
  my $self=shift;
  $self->{'list'}=shift if @_;
  unless (defined($self->{'list'})) {
    #printf "%s: Listing files in folder: %s\n", DateTime->now, $self->folder;
    $self->{'list'}=$self->sftp->ls(
                                    $self->folder,
                                    wanted     => $self->match,
                                    ordered    => 1,
                                    no_wanted  => qr/\A\.{1,2}\Z/,
                                    names_only => 1,
                                   );
    die(sprintf(qq{Error: File list did not return as expected. Verify folder "%s" exists and is readable.}, $self->folder))
      unless (defined($self->{'list'}) and ref($self->{'list'}) eq 'ARRAY');
  }
  return wantarray ? @{$self->{'list'}} : $self->{'list'};
}

=head2 upload

Uploads file to the folder and returns the count of uploaded files.

  $sftp->folder("/remote_folder"); #or set on construction
  $sftp->upload('local_file.zip');
  $sftp->upload('local_file1.zip', 'local_file2.zip');

The upload method is a simple wrapper around Net::SFTP::Foreign->mput that is parallel to download.

=cut

sub upload {
  my $self   = shift;
  my @files  = @_;
  my $sftp   = $self->sftp;
  return $sftp->mput(\@files, $self->folder);
}

=head1 PROPERTIES

=head2 host

SFTP server host name.

  $sftp->host("");           #default

=cut

sub host {
  my $self=shift;
  if (@_) {
    $self->{'host'} = shift;
    delete $self->{'list'};
    delete $self->{'sftp'};
  }
  $self->{'host'}=$self->_host_default unless defined($self->{'host'});
  return $self->{'host'};
}

sub _host_default {
  return '';
}

=head2 user

SFTP user name (defaults to current user)

  $sftp->user(undef);        #default

=cut

sub user {
  my $self=shift;
  if (@_) {
    $self->{'user'} = shift;
    delete $self->{'list'};
    delete $self->{'sftp'};
  }
  return $self->{'user'};
}

=head2 port

SFTP port number (defaults to undef not passed through)

  $sftp->port(undef);        #default

=cut

sub port {
  my $self=shift;
  if (@_) {
    $self->{'port'} = shift;
    delete $self->{'list'};
    delete $self->{'sftp'};
  }
  $self->{'port'}=undef unless defined $self->{'port'};
  return $self->{'port'};
}

=head2 options

SSH options passed to the more property of L as an array reference.

  $sftp->options(['-q']);    #default
  $sftp->options([]);        #no options
  $sftp->options(['-v']);    #verbose

=cut

sub options {
  my $self=shift;
  if (@_) {
    $self->{'options'} = shift;
    delete $self->{'list'};
    delete $self->{'sftp'};
  }
  $self->{'options'}=['-q'] unless defined $self->{'options'};
  die 'Error: options must be an array reference.' unless ref($self->{'options'}) eq 'ARRAY';
  return $self->{'options'};
}

=head2 folder

Folder on remote SFTP server.

  $sftp->folder("/home/user/download");

Note: Some SFTP servers put clients in a change rooted environment.

=cut

sub folder {
  my $self=shift;
  if (@_) {
    $self->{'folder'} = shift;
    delete $self->{'list'};
   }
  $self->{'folder'}=$self->_folder_default unless defined $self->{'folder'};
  return $self->{'folder'};
}

sub _folder_default {
  return '/incoming';
}

=head2 match

Regular Expression to match file names for the next iterator

  $sftp->match(qr/\Aremote_file\.zip\Z/);   #exact file
  $sftp->match(qr/\.zip\Z/);                #any zip file
  $sftp->match(undef);                      #reset to default - all files

=cut

sub match {
  my $self=shift;
  if (@_) {
    $self->{'match'} = shift;
    delete $self->{'list'};
  }
  $self->{'match'}=$self->_match_default unless defined($self->{'match'});
  return $self->{'match'};
}

sub _match_default {
  return qr//;
}

=head2 backup

Sets or returns the backup folder property.

  $sftp->backup("");         #don't backup
  $sftp->backup("./folder"); #backup to folder

Note: If configured, backup overrides delete option.

=cut

sub backup {
  my $self=shift;
  $self->{'backup'}=shift if @_;
  $self->{'backup'}='' unless defined($self->{'backup'});
  return $self->{'backup'};
}

=head2 delete

Sets or returns the delete boolean property.

  $sftp->delete(0);          #don't delete
  $sftp->delete(1);          #delete after downloaded

Note: Ineffective when backup option is configured.

=cut

sub delete {
  my $self=shift;
  $self->{'delete'}=shift if @_;
  $self->{'delete'}=0 unless defined($self->{'delete'});
  return $self->{'delete'};
}

=head1 OBJECT ACCESSORS

=head2 sftp

Returns a cached connected L object

=cut

sub sftp {
  my $self=shift;
  unless (defined $self->{'sftp'}) {
    my %params      = ();
    $params{'host'} = $self->host    or die('Error: host required');
    $params{'user'} = $self->user    if $self->user;           #not required
    $params{'port'} = $self->port    if defined($self->port);  #not required
    $params{'more'} = $self->options if @{$self->options} > 0; #not required
    my $sftp        = Net::SFTP::Foreign->new($params{'host'}, %params);
    die(
      sprintf("Error connecting to sftp://%s%s%s/ - %s",
                  ($params{'user'} ? $params{'user'} . '@' : ''),
                  $params{'host'},
                  ($params{'port'} ? ':' . $params{'port'} : ''),
                  $sftp->error
      )
    ) if $sftp->error;
    $self->{'sftp'} = $sftp;
  }
  return $self->{'sftp'};
}

=head1 BUGS

Send email to author and log on RT.

=head1 SUPPORT

DavisNetworks.com supports all Perl applications including this package.

=head2 Testing

This packages relies on the SSH keys to be operational for the local account.  To test your SSH keys from the command line type  `sftp user@server`. If this command prompts the user for a password, then your SSH keys are not installed correctly.  You cannot reliably test with `ssh user@server` as the remote administrator may have disabled the terminal service over SSH.

=head1 AUTHOR

  Michael R. Davis
  CPAN ID: MRDVT
  Satellite Tracking of People, LLC
  [e-mail]
  http://www.stopllc.com/

=head1 COPYRIGHT

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the LICENSE file included with this module.

=head1 SEE ALSO

=head2 Building Blocks

L, L, L

=cut

1;