#  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, 2009-2011 -- leonerd@leonerd.org.uk

package IPC::PerlSSH::Library::IO;

use strict;
use warnings;

use IPC::PerlSSH::Library;

our $VERSION = '0.16';

=head1 NAME

C<IPC::PerlSSH::Library::IO> - a library of file IO functions for
C<IPC::PerlSSH>

=head1 SYNOPSIS

 use IPC::PerlSSH;

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

 $ips->use_library( "IO", qw( open fchmod write close ) );

 my $fd = $ips->call( "open", ">", "secret.txt" );
 $ips->call( "fchmod", $fd, 0600 );
 $ips->call( "write", $fd, "s3kr1t\n" );
 $ips->call( "close" );

=head1 DESCRIPTION

This module provides a library of functions for interacting with remote IO
filehandles. It provides simple wrappers around the perl IO functions, taking
or returning file descriptor numbers instead of filehandle objects. This
allows filehandles to remain open in the remote perl instance, across many
C<call>s.

Because the filehandles remain open, the program must take care to call
C<close> at the appropriate time, so as not to leak file descriptors in the
remote perl.

=cut

init q[
use IO::Handle;

our %handles;

sub store_handle
{
   my $fh = shift;
   my $fd = $fh->fileno;
   $handles{$fd} = $fh;
   return $fd;
}

sub get_handle
{
   my $fd = shift;
   $fd > 2 or die "Cannot operate on STD{IN|OUT|ERR}\n";
   return $handles{$fd} || die "No handle on fileno $fd\n";
}
];

=head1 FUNCTIONS

=cut

=head2 open

Open a new filehandle in the remote perl and return its FD number.

 my $fd = $ips->call( "open", $mode, @args )

The filehandle is put into unbuffered mode, such that subsequent C<write>
calls will send the data directly to the underlying operating system.

The C<$mode> argument supports the full range of perl open modes, including
pipe opens with C<-|>. If using a pipe open, you can close the file handle
with C<pclose> instead of C<close> to obtain the child process exit status.

In the case of pipe opens, L<IPC::PerlSSH::Library::Run> provides a selection
of functions that may be more convenient for executing a child program on the
remote perl, if interaction during its execution is not required.

In the case of simple C<open> / C<read> / C<close> or C<open> / C<write> /
C<close> sequences, see also the L<IPC::PerlSSH::Library::FS> functions
C<readfile> and C<writefile>.

=cut

func open => q{
   my ( $mode, @args ) = @_;
   open( my $fh, $mode, @args ) or die "Cannot open() - $!\n";
   $fh->autoflush;
   store_handle( $fh );
};

=head2 close

Close a remote filehandle.

 $ips->call( "close", $fd )

=cut

func close => q{
   our %handles;
   undef $handles{shift()};
};

=head2 pclose

Close a remote filehandle which was part of a pipe-open, and return the child
process exit status.

 $exitstatus = $ips->call( "pclose", $fd )

=cut

func pclose => q{
   our %handles;
   my $fd = shift;
   my $fh = get_handle( $fd );
   undef $handles{$fd};
   close $fh;
   return $?;
};

=head2 read

Perform a single read call on a remote filehandle.

 my $data = $ips->call( "read", $fd, $length )

Returns empty string on EOF.

=cut

func read => q{
   my $fh = get_handle( shift );
   defined( $fh->read( my $data, $_[0] ) ) or die "Cannot read() - $!\n";
   return $data;
};

=head2 getline

Read a single line from the remote filehandle.

 my $line = $ips->call( "getline", $fd );

Returns empty string on EOF.

=cut

func getline => q{
   my $fh = get_handle( shift );
   defined( my $line = $fh->getline() ) or die "Cannot getline() - $!\n";
   return $line;
};

=head2 write

Perform a single write call on a remote filehandle.

 $ips->call( "write", $fd, $data )

Note this is called C<write> to match the system call, rather than C<print>.

=cut

func write => q{
   my $fh = get_handle( shift );
   defined( $fh->print( $_[0] ) ) or die "Cannot write() - $!\n";
};

=head2 tell

Return the current file position on a remote filehandle.

 my $pos = $ips->call( "tell", $fd )

=cut

func tell => q{
   my $fh = get_handle( shift );
   return tell($fh);
};

=head2 seek

Seek to the given position in the remote filehandle and return the new
position.

 my $newpos = $ips->call( "seek", $fd, $pos, $whence )

You may find it useful to import the C<SEEK_*> constants from the C<Fcntl>
module.

=cut

func seek => q{
   my $fh = get_handle( shift );
   seek( $fh, $_[0], $_[1] ) or die "Cannot seek() - $!\n";
   return tell($fh);
};

=head2 truncate

Truncates the file to the given length.

 $ips->call( "truncate", $fd, $len );

=cut

func truncate => q{
   my $fh = get_handle( shift );
   $fh->truncate( $_[0] ) or die "Cannot truncate() - $!\n";
};

=head2 fstat

Returns the status of the file (see L<perldoc -f stat>).

 my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime,
      $mtime, $ctime, $blksize, $blocks ) = $ips->call( "fstat", $fd )

=cut

func fstat => q{
   my $fh = get_handle( shift );
   my @s = stat( $fh ) or die "Cannot stat() - $!\n";
   @s;
};

=head2 fchmod

Change the permissions on the remote filehandle.

 $ips->call( "fchmod", $fd, 0755 )

Note the order of arguments does not match perl's C<chmod()>.

Only works on versions of remote F<perl> 5.8.8 and above.

=cut

func fchmod => q{
   die "Perl too old for fchmod()" if $] < 5.008008;
   my $fh = get_handle( shift );
   chmod( $_[0], $fh ) or die "Cannot chmod() - $!\n";
};

=head2 fchown

Changes the owner (and group) of the remote filehandle.

 $ips->call( "fchown", $uid, $gid )

Note the order of arguments does not match perl's C<chown()>.

Only works on versions of remote F<perl> 5.8.8 and above.

=cut

func fchown => q{
   die "Perl too old for fchown()" if $] < 5.008008;
   my $fh = get_handle( shift );
   chown( $_[0], $_[1], $fh ) or die "Cannot chown() - $!\n";
};

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;
