view release on metacpan or  search on metacpan

lib/Net/RRP/Toolkit.pm  view on Meta::CPAN

package Net::RRP::Toolkit;

use strict;
use Errno;
use Fcntl ':flock';
require Exporter;

@Net::RRP::Toolkit::ISA = qw(Exporter);
@Net::RRP::Toolkit::EXPORT_OK = qw(decodeTilde safeCall safeCopy lowerKeys pathSubtract);
$Net::RRP::Toolkit::VERSION = (split " ", '# 	$Id: Toolkit.pm,v 1.3 2000/10/04 08:05:37 mkul Exp $	')[3];

sub decodeTilde
{
    my $path = shift || return undef;
    $path =~ s/^~([^\/]*)/$1 ? (getpwnam($1))[7] : (getpwuid($>))[7]/e;
    $path;
}

sub safeCall
{
    my $codeRef = shift;
    my $result  = &$codeRef;
    while ( ( $! == Errno::EINTR ) && ( ! $result ) )
    {
	$result  = &$codeRef;
    }
    $result;
}

sub safeWrite
{
    my ( $handler, $buffer, $length ) = @_;
    $handler         || raise ZError 'MISSING_MANDATORY_PARAM', { name => 'hander' };
    defined $buffer  || raise ZError 'MISSING_MANDATORY_PARAM', { name => 'buffer' };
    $length ||= length ( $buffer );

    my ( $origLength, $itemLength ) = ( $length );

    while ( $length )
    {
	$itemLength = Net::RRP::Toolkit::safeCall ( sub { $handler->syswrite ( $buffer, $length ) } );
	last unless $itemLength;
	$length -= $itemLength;
	$buffer  = substr ( $buffer, $itemLength ) if $length;
    }

    defined $itemLength ? $origLength : undef;
}

sub safeRead
{
    my ( $handler, $buffer, $length ) = @_;
    $handler         || raise ZError 'MISSING_MANDATORY_PARAM', { name => 'hander' };
    defined $buffer  || raise ZError 'MISSING_MANDATORY_PARAM', { name => 'buffer' };
    $length ||= length ( $buffer );
    $$buffer  = '';

    my ( $origLength, $itemLength ) = ( $length );
    my $subBuffer;

    while ( $length )
    {
	$itemLength = Net::RRP::Toolkit::safeCall ( sub { $handler->sysread ( $subBuffer, $length ) } );
	last unless $itemLength;
	$length  -= $itemLength;
	$$buffer .= $subBuffer;
    }

    defined $itemLength ? $origLength : undef;
}

sub safeCopy
{
    my $fromName   = $_{srcFile}    || die "safeCopy(): srcFile required";
    my $toName     = $_{dstFile}    || die "safeCopy(): dstFile required";