File Coverage

blib/lib/IPC/PerlSSH/Library/FS.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2008-2011 -- [e-mail]

package IPC::PerlSSH::Library::FS;

use strict;
use warnings;

use IPC::PerlSSH::Library;

our $VERSION = '0.17';

=head1 NAME

C - a library of filesystem functions for
C

=head1 SYNOPSIS

 use IPC::PerlSSH;

 my $ips = IPC::PerlSSH->new( Host => "over.there" );

 $ips->use_library( "FS", qw( mkdir chmod writefile ) );

 $ips->call( "mkdir", "/tmp/testing" );
 $ips->call( "chmod", 0600, "/tmp/testing" );

 $ips->call( "writefile", "/tmp/testing/secret", <
 Some secret contents of my file here
 EOF

=head1 DESCRIPTION

This module provides a library of functions for interating with the remote
filesystem. It provides wrappers for most of the perl filesystem functions,
and some useful new functions that are more convenient to call remotely.

Because of the large number of functions defined by this library, it is
recommended to only load the ones being used by the program, to avoid sending
unnecessary data when setting up SSH connections across slow links.

=cut

=head1 FUNCTIONS

=head2 Simple Functions

The following perl functions have trivial wrappers that take arguments and
return values in the same way as perl's. They throw exceptions via the
C call when they fail, rather than returning undef, because
otherwise C<$!> would be difficult to obtain.

 chown chmod lstat mkdir readlink rename rmdir stat symlink unlink utime

The following functions are imported from L with the following
API adjustments:

 mkpath( $path, %opts ) # %opts supports mode, user, group
 rmtree( $path, %opts ) # %opts supports safe, keep_root

=cut

init q{
   use File::Path qw( mkpath rmtree );
};

func chown =>
   q{my $uid = shift; my $gid = shift;
      chown $uid, $gid, $_ or die "Cannot chown($uid, $gid, '$_') - $!" for @_;};

func chmod =>
   q{my $mode = shift;
     chmod $mode, $_ or die "Cannot chmod($mode, '$_') - $!" for @_;};

func lstat =>
   q{my @s = lstat $_[0]; @s or die "Cannot lstat('$_[0]') - $!"; @s};

func mkdir =>
   q{mkdir $_[0] or die "Cannot mkdir('$_[0]') - $!"};

func mkpath =>
   q{my ( $path, %opts ) = @_;
     mkpath $path, \%opts or die "Cannot mkpath('$path') - $!"};

func readlink =>
   q{my $l = readlink $_[0]; defined $l or die "Cannot readlink('$_[0]') - $!"; $l};

func rename =>
   q{rename $_[0], $_[1] or die "Cannot rename('$_[0]','$_[1]') - $!"};

func rmdir =>
   q{rmdir $_[0] or die "Cannot rmdir('$_[0]') - $!"};

func rmtree =>
   q{my ( $path, %opts ) = @_;
     rmtree $path, \%opts or die "Cannot rmtree('$_[0]') - $!"};

func stat =>
   q{my @s = stat $_[0]; @s or die "Cannot stat('$_[0]') - $!"; @s};

func symlink =>
   q{symlink $_[0], $_[1] or die "Cannot symlink('$_[0]','$_[1]') - $!"};

func unlink =>
   q{unlink $_[0] or die "Cannot unlink('$_[0]') - $!"};

func utime =>
   q{my $atime = shift; my $mtime = shift;
     utime $atime, $mtime, $_ or die "Cannot utime($atime, $mtime, '$_') - $!" for @_};

=head2 Variations on C

The following functions each returns just one element from the C list
for efficiency when only one is required.

 stat_dev stat_ino stat_mode stat_nlink stat_uid stat_gid stat_rdev
 stat_size stat_atime stat_mtime stat_ctime stat_blksize stat_blocks

=cut

my %statfields = (
   dev     => 0,
   ino     => 1,
   mode    => 2,
   nlink   => 3,
   uid     => 4,
   gid     => 5,
   rdev    => 6,
   # size is 7 but we do that a different way
   atime   => 8,
   mtime   => 9,
   ctime   => 10,
   blksize => 11,
   blocks  => 12,
);

func( "stat_$_", "(stat(\$_[0]))[$statfields{$_}]" ) for keys %statfields;

=pod

The following stored functions wrap the perl -X file tests (documented here in
the same order as in F)

 stat_readable stat_writable stat_executable stat_owned

 stat_real_readable stat_real_writable stat_real_executable
 stat_real_owned

 stat_exists stat_isempty stat_size

 stat_isfile stat_isdir stat_islink stat_ispipe stat_issocket
 stat_isblock stat_ischar

 stat_issetuid stat_issetgid stat_issticky

 stat_istext stat_isbinary

 stat_mtime_days stat_atime_days stat_ctime_days

=cut

# We can cheat with the filetests
my %filetests = (
   readable   => 'r',
   writable   => 'w',
   executable => 'x',
   owned      => 'o',

   real_readable   => 'R',
   real_writable   => 'W',
   real_executable => 'X',
   real_owned      => 'O',

   'exists' => 'e',
   isempty  => 'z',
   size     => 's',

   isfile   => 'f',
   isdir    => 'd',
   islink   => 'l',
   ispipe   => 'p',
   issocket => 's',
   isblock  => 'b',
   ischar   => 'c',

   issetuid => 'u',
   issetgid => 'g',
   issticky => 'k',

   istext   => 'T',
   isbinary => 'B',

   mtime_days => 'M',
   atime_days => 'A',
   ctime_days => 'C',
);

func( "stat_$_", "-$filetests{$_} \$_[0]" ) for keys %filetests;

=head2 Variation Functions

The following functions are defined as variations on the perl function of the
same name

 my @ents = $ips->call( "readdir", $dirpath, $hidden );

Return a list of the directory entries. Hidden files are skipped if $hidden is
true. F<.> and F<..> are always skipped.

=cut

func readdir =>
   q{opendir( my $dirh, $_[0] ) or die "Cannot opendir('$_[0]') - $!";
     my @ents = readdir( $dirh );
     grep { $_[1] ? $_ !~ m/^\.\.?$/ : $_ !~ m/^\./ } @ents};

=pod

 $ips->call( "remove", $path );

Calls C if C<$path> is a directory, or C if not

=cut

func remove =>
   q{(lstat $_[0] && -d _) ? rmdir $_[0] : unlink $_[0] or die "Cannot remove('$_[0]') - $!"};

=head2 New Functions

The following functions are newly defined to wrap common perl idoms

 my $content = $ips->call( "readfile", $filepath );
 $ips->call( "writefile", $filepath, $newcontent );

To open a remote filehandle and interact with it over a sequence of multiple
calls, see also L.

=cut

func readfile =>
   q{open( my $fileh, "<", $_[0] ) or die "Cannot open('$_[0]') for reading - $!";
     local $/; <$fileh>};

func writefile =>
   q{open( my $fileh, ">", $_[0] ) or die "Cannot open('$_[0]') for writing - $!";
     print $fileh $_[1] or die "Cannot print to '$_[0]' - $!"};

=head1 AUTHOR

Paul Evans

=cut

0x55AA;