File Coverage

blib/lib/Paranoid/IO.pm

Criterion	Covered	Total	%
statement	293	314	93.3
branch	104	156	66.6
condition	21	36	58.3
subroutine	32	33	96.9
pod	14	14	100.0
total	464	553	83.9

# Paranoid::IO -- Paranoid IO support
#
# $Id: lib/Paranoid/IO.pm, 2.08 2020/12/31 12:10:06 acorliss Exp $
#
# This software is free software.  Similar to Perl, you can redistribute it
# and/or modify it under the terms of either:
#
#   a)     the GNU General Public License
#           as published by the
#          Free Software Foundation ; either version 1
#          , or any later version
#          , or
#   b)     the Artistic License 2.0
#          ,
#
# subject to the following additional term:  No trademark rights to
# "Paranoid" have been or are conveyed under any of the above licenses.
# However, "Paranoid" may be used fairly to describe this unmodified
# software, in good faith, but not as a trademark.
#
# (c) 2005 - 2020, Arthur Corliss ([e-mail])
# (tm) 2008 - 2020, Paranoid Inc. (www.paranoid.com)
#
#####################################################################

#####################################################################
#
# Environment definitions
#
#####################################################################

package Paranoid::IO;

use 5.008;

use strict;
use warnings;
use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
use base qw(Exporter);
use Cwd qw(realpath);
use Fcntl qw(:DEFAULT :flock :mode :seek);
use Paranoid;
use Paranoid::Debug qw(:all);
use Paranoid::Input;
use IO::Handle;

($VERSION) = ( q$Revision: 2.08 $ =~ /(\d+(?:\.\d+)+)/sm );

@EXPORT = qw(pclose pcloseAll popen preopen ptell pseek pflock pread
    pnlread pwrite pappend ptruncate);
@EXPORT_OK = ( @EXPORT, qw(PIOBLKSIZE PIOMAXFSIZE) );
%EXPORT_TAGS = ( all => [@EXPORT_OK] );

use constant PDEFPERM   => 0666;
use constant PDEFMODE   => O_CREAT | O_RDWR;
use constant PDEFBLKSZ  => 4096;
use constant PDEFFILESZ => 65536;

#####################################################################
#
# Module code follows
#
#####################################################################

{

    my $mblksz = PDEFBLKSZ;

    sub PIOBLKSIZE : lvalue {

        # Purpose:  Gets/sets default block size for I/O
        # Returns:  $mblksz
        # Usage:    PIOBLKSIZE

        $mblksz;
    }

    my $mfsz = PDEFFILESZ;

    sub PIOMAXFSIZE : lvalue {

        # Purpose:  Gets/sets default max file size for I/O
        # Returns:  $mfsz
        # Usage:    PIOBLKSIZE

        $mfsz;
    }

    # %files:  {name} => {
    #   pid     => $pid,
    #   mode    => $mode,
    #   perms   => $perms,
    #   fh      => $fh,
    #   real    => $realpath,
    #   ltype   => $lock,
    #   }
    my %files;

    sub _pfFhind ($) {

        # Purpose:  Searches for a filename based on the
        #           current file handle
        # Returns:  String/undefined
        # Usage:    $rv = _pfFhind($fh);

        my $fh = shift;
        my $rv;

        pdebug( 'entering w/%s', PDLEVEL2, $fh );
        pIn();

        if ( defined $fh and ref $fh eq 'GLOB' ) {
            foreach ( keys %files ) {
                if ( $files{$_}{fh} eq $fh ) {
                    $rv = $_ and last;
                }
            }
        }

        pOut();
        pdebug( 'leaving w/rv: %s', PDLEVEL2, $rv );

        return $rv;
    }

    sub pclose {

        # Purpose:  Closes a cached file handle
        # Returns:  Boolean
        # Usage:    $rv = plcose($filename)
        # Usage:    $rv = plcose($fh)

        my $filename = shift;
        my $rv       = 1;
        my $fh;

        pdebug( 'entering w/%s', PDLEVEL2, $filename );
        pIn();

        if ( defined $filename ) {

            # Get the missing variable
            if ( ref $filename eq 'GLOB' ) {
                $fh       = $filename;
                $filename = _pfFhind($fh);
            } else {
                $fh = $files{$filename}{fh} if exists $files{$filename};
            }

            # Close the filehandle
            if ( defined $fh and fileno $fh ) {
                flock $fh, LOCK_UN;
                $rv = close $fh;
            }

            # Clean up internal data structures
            delete $files{$filename} if defined $filename;

            Paranoid::ERROR =
                pdebug( 'error closing file handle: %s', PDLEVEL1, $! )
                unless $rv;
        }

        pOut();
        pdebug( 'leaving w/rv: %s', PDLEVEL2, $rv );

        return $rv;
    }

    sub pcloseAll {

        # Purpose:  Closes all filehandles
        # Returns:  Boolean
        # Usage:    $rv = pcloseAll();

        my @files = @_;
        my $rv    = 1;

        pdebug( 'entering', PDLEVEL3 );
        pIn();

        @files = keys %files unless @files;
        foreach (@files) {
            $rv = 0 unless pclose($_);
        }

        pOut();
        pdebug( 'leaving w/rv: %s', PDLEVEL3, $rv );

        return $rv;
    }

    sub _open {

        # Purpose:  Performs the sysopen call
        # Returns:  rv of sysopen
        # Usage:    $rv = _open($filename);
        # Usage:    $rv = _open($filename, $mode);
        # Usage:    $rv = _open($filename, $mode, $perms);

        my $filename = shift;
        my $mode     = shift;
        my $perms    = shift;
        my ( %tmp, $f, $fh, $rv );

        pdebug( 'entering w/(%s)(%s)(%s)',
            PDLEVEL3, $filename, $mode, $perms );
        pIn();

        if ( defined $filename ) {

            # Detaint mode/perms
            $rv    = 1;
            $mode  = PDEFMODE unless defined $mode;
            $perms = PDEFPERM unless defined $perms;
            unless ( detaint( $mode, 'int' ) ) {
                $rv = 0;
                Paranoid::ERROR =
                    pdebug( 'invalid mode passed: %s', PDLEVEL1, $mode );
            }
            unless ( detaint( $perms, 'int' ) ) {
                $rv = 0;
                Paranoid::ERROR =
                    pdebug( 'invalid perm passed: %s', PDLEVEL1, $perms );
            }

            # Prep file record
            %tmp = (
                mode  => $mode,
                perms => $perms,
                pid   => $$,
                ltype => LOCK_UN,
                );

            # Detaint filename
            if ($rv) {
                if ( detaint( $filename, 'filename', $f ) ) {

                    # Attempt to open the fila
                    $rv =
                        ( $tmp{mode} & O_CREAT )
                        ? sysopen $fh, $f, $tmp{mode}, $tmp{perms}
                        : sysopen $fh,
                        $f, $tmp{mode};
                    if ($rv) {
                        $tmp{fh}          = $fh;
                        $tmp{real}        = realpath($filename);
                        $files{$filename} = {%tmp};
                    } else {
                        Paranoid::ERROR = pdebug( 'failed to open %s: %s',
                            PDLEVEL1, $filename, $! );
                    }

                } else {
                    Paranoid::ERROR =
                        pdebug( 'failed to detaint %s', PDLEVEL1, $filename );
                }
            }
        }

        pOut();
        pdebug( 'leaving w/rv: %s', PDLEVEL3, $rv );

        return $rv;
    }

    sub _reopen {

        # Purpose:  Reopens an open file handle
        # Returns:  rv of _open
        # Usage:    $rv = _reopen($filename);
        # Usage:    $rv = _reopen($fh);

        my $filename = shift;
        my ( %tmp, $fh, $pos, $rv, $af );

        pdebug( 'entering w/(%s)', PDLEVEL3, $filename );
        pIn();

        if ( defined $filename and exists $files{$filename} ) {

            # Get a copy of the file record
            %tmp = %{ $files{$filename} };
            $fh  = $tmp{fh};

            # Get the current cursor position
            $pos = fileno $fh ? sysseek $fh, 0, SEEK_CUR : 0;
            $af = $fh->autoflush;

            # Close the old file handle
            $tmp{fh} = $fh = undef;
            if ( pclose($filename) ) {

                # Remove O_TRUNC
                $tmp{mode} ^= O_TRUNC if $tmp{mode} & O_TRUNC;

                # Open the file and move the cursor back where it was
                $rv = _open( @tmp{qw(real mode perms)} );
                if ($rv) {

                    # Move the cursor back to where it was
                    $fh = $files{ $tmp{real} }{fh};
                    $fh->autoflush($af);
                    $rv = sysseek $fh, $pos, SEEK_SET;

                    # Move the record over to the original file name
                    $files{$filename} = { %{ $files{ $tmp{real} } } };
                    delete $files{ $tmp{real} } if $filename ne $tmp{real};
                }
            }
        }

        pOut();
        pdebug( 'leaving w/rv: %s', PDLEVEL3, $rv );

        return $rv;
    }

    sub popen {

        # Purpose:  Performs a sysopen with file descriptor caching
        # Returns:  file handle
        # Usage:    $fh = popen($filename, $mode, $perms);

        my $filename = shift;
        my $mode     = shift;
        my $perms    = shift;
        my ( %tmp, $fh, $f, $pos, $rv );

        pdebug( 'entering w/(%s)(%s)(%s)',
            PDLEVEL2, $filename, $mode, $perms );
        pIn();

        # Make sure we weren't passed a file handle, but if we
        # were attempt to find the actual filename
        if ( defined $filename ) {
            if ( ref $filename eq 'GLOB' ) {
                $fh       = $filename;
                $filename = _pfFhind($filename);
            } else {
                $fh = $files{$filename}{fh} if exists $files{$filename};
            }
        }

        if ( defined $filename and exists $files{$filename} ) {

            # Make sure pid is the same
            if ( $files{$filename}{pid} == $$ ) {

                if ( fileno $fh ) {

                    # Return existing filehandle
                    pdebug( 'returning cached file handle', PDLEVEL2 );
                    $rv = $fh;

                } else {

                    # Reopen a filehandle that was closed outside
                    # of this module
                    pdebug( 'reopening closed file handle', PDLEVEL2 );
                    $rv = $files{$filename}{fh} if _reopen($filename);
                }

            } else {

                pdebug( 'reopening inherited file handle in child',
                    PDLEVEL2 );
                $rv = $files{$filename}{fh} if _reopen($filename);

            }

        } elsif ( defined $filename ) {

            pdebug( 'opening new file handle', PDLEVEL2 );
            $rv = $files{$filename}{fh} if _open( $filename, $mode, $perms );

        } elsif ( !defined $filename and defined $fh ) {
            Paranoid::ERROR =
                pdebug( 'popen called with an unmanaged file handle',
                PDLEVEL1 );
            $rv = fileno $fh ? $fh : undef;
        } else {
            Paranoid::ERROR =
                pdebug( 'attempted to open a file with an undefined name',
                PDLEVEL1 );
        }

        pOut();
        pdebug( 'leaving w/rv: %s', PDLEVEL2, $rv );

        return $rv;
    }

    sub preopen {

        # Purpose:  Reopens either the named files or all
        # Returns:  Boolean
        # Usage:    $rv = preopen();
        # Usage:    $rv = preopen(@filenames);

        my @files = @_;
        my $rv    = 1;

        pdebug( 'entering w/%s', PDLEVEL2, @files );
        pIn();

        @files = keys %files unless @files;
        foreach (@files) { $rv = 0 unless _reopen($_) }

        pOut();
        pdebug( 'leaving w/rv: %s', PDLEVEL2, $rv );

        return $rv;
    }

    sub pflock {

        # Purpose:  Performs file-locking operations on the passed filename
        # Returns:  Boolean
        # Usage:    $rv = pflock($filename, LOCK_EX);

        my $filename = shift;
        my $lock     = shift;
        my ( $rv, $fh );
        local $!;

        pdebug( 'entering w/(%s)(%s)', PDLEVEL2, $filename, $lock );
        pIn();

        if ( defined $filename ) {

            # Get the missing variable
            if ( ref $filename eq 'GLOB' ) {
                $fh       = $filename;
                $filename = _pfFhind($fh);
            } else {
                $fh = $files{$filename}{fh} if exists $files{$filename};
            }

            if ( defined $fh ) {

                # Apply the lock
                $rv = flock $fh, $lock;

                # Record change to internal state if we're tracking this file
                $files{$filename}{ltype} = $lock
                    if defined $filename
                        and exists $files{$filename};

                Paranoid::ERROR =
                    pdebug( 'error attempting to pflock: %s', PDLEVEL1, $! )
                    unless $rv;
            }
        }

        pOut();
        pdebug( 'leaving w/rv: %s', PDLEVEL2, $rv );

        return $rv;
    }
}

sub ptell {

    # Purpose:  Returns the cursor position in the file handle
    # Returns:  Integer
    # Usage:    $pos = ptell($filename);

    my $filename = shift;
    my ( $rv, $fh );
    local $!;

    pdebug( 'entering w/%s', PDLEVEL2, $filename );
    pIn();

    if ( defined $filename ) {

        $fh = popen( $filename, O_RDWR );
        if ( defined $fh ) {
            $rv = sysseek $fh, 0, SEEK_CUR;
            Paranoid::ERROR =
                pdebug( 'error attempting to ptell: %s', PDLEVEL1, $! )
                unless $rv;
        }
    }

    pOut();
    pdebug( 'leaving w/rv: %s', PDLEVEL2, $rv );

    return $rv;
}

sub pseek {

    # Purpose:  Performs a sysseek
    # Returns:  Integer/undef
    # Usage:    $cur = pseek($filename, $curpos, $whence);

    my $filename = shift;
    my $setpos   = shift;
    my $whence   = shift;
    my ( $rv, $fh );
    local $!;

    pdebug( 'entering w/(%s)(%s)(%s)', PDLEVEL2, $filename, $setpos,
        $whence );
    pIn();

    if ( defined $filename ) {

        $fh = popen( $filename, O_RDWR );
        if ( defined $fh ) {
            $rv = sysseek $fh, $setpos, $whence;
            Paranoid::ERROR =
                pdebug( 'error attempting to pseek: %s', PDLEVEL1, $! )
                unless $rv;
        }
    }

    pOut();
    pdebug( 'leaving w/rv: %s', PDLEVEL2, $rv );

    return $rv;
}

sub pwrite {

    # Purpose:  Performs a syswrite w/locking
    # Returns:  Integer/undef
    # Usage:    $bytes = pwrite($filename, $text);
    # Usage:    $bytes = pwrite($filename, $text, $length);
    # Usage:    $bytes = pwrite($filename, $text, $length, $offset);

    my $filename = shift;
    my $out      = shift;
    my $wlen     = shift;
    my $offset   = shift;
    my ( $fh, $rv );

    pdebug( 'entering w/(%s)(%s)(%s)(%s)',
        PDLEVEL2, $filename, $out, $wlen, $offset );
    pIn();

    if ( defined $filename and defined $out and length $out ) {

        # Opportunistically open a file handle if needed,
        # otherwise, just retrieve the existing file handle
        $fh = popen( $filename, O_WRONLY | O_CREAT | O_TRUNC );

        # Smoke 'em if you got'em...
        if ( defined $fh ) {
            if ( pflock( $filename, LOCK_EX ) ) {
                $wlen   = length $out unless defined $wlen;
                $offset = 0           unless defined $offset;
                $rv = syswrite $fh, $out, $wlen, $offset;
                if ( defined $rv ) {
                    pdebug( 'wrote %d bytes', PDLEVEL2, $rv );
                } else {
                    Paranoid::ERROR =
                        pdebug( 'failed to write to file handle: %s',
                        PDLEVEL1, $! );
                }
                pflock( $filename, LOCK_UN );
            }
        }
    }

    pOut();
    pdebug( 'leaving w/rv: %s', PDLEVEL2, $rv );

    return $rv;
}

sub pappend ($$;$$) {

    # Purpose:  Appends the data to the end of the file,
    #           but does not move the file cursor
    # Returns:  Integer/undef
    # Usage:    $rv = pappend($filename, $content);
    # Usage:    $rv = pappend($filename, $content, $length);
    # Usage:    $rv = pappend($filename, $content, $length, $offset);

    my $filename = shift;
    my $out      = shift;
    my $wlen     = shift;
    my $offset   = shift;
    my ( $fh, $pos, $rv );

    pdebug( 'entering w/(%s)(%s)(%s)(%s)',
        PDLEVEL2, $filename, $out, $wlen, $offset );
    pIn();

    if ( defined $filename and defined $out and length $out ) {

        # Opportunistically opena file handle in append mode
        $fh = popen( $filename, O_WRONLY | O_CREAT | O_APPEND );

        # Smoke 'em if you got'em...
        if ( defined $fh ) {

            # Lock the file
            if ( pflock( $filename, LOCK_EX ) ) {

                # Save the current position
                $pos = sysseek $fh, 0, SEEK_CUR;

                # Seek to the end of the file
                if ( $pos and sysseek $fh, 0, SEEK_END ) {

                    # write the content
                    $wlen   = length $out unless defined $wlen;
                    $offset = 0           unless defined $offset;
                    $rv = syswrite $fh, $out, $wlen, $offset;
                    if ( defined $rv ) {
                        pdebug( 'wrote %d bytes', PDLEVEL2, $rv );
                    } else {
                        Paranoid::ERROR =
                            pdebug( 'failed to write to file handle: %s',
                            PDLEVEL1, $! );
                    }
                }

                # Seek back to original position
                sysseek $fh, $pos, SEEK_SET;

                # Unlock the file handle
                pflock( $filename, LOCK_UN );
            }
        }
    }

    pOut();
    pdebug( 'leaving w/rv: %s', PDLEVEL2, $rv );

    return $rv;
}

sub pread ($\$;@) {

    # Purpose:  Performs a sysread w/locking
    # Returns:  Integer/undef
    # Usage:    $bytes = pread($filename, $text, $length);
    # Usage:    $bytes = pread($filename, $text, $length, $offset);

    my $filename = shift;
    my $sref     = shift;
    my $rlen     = shift;
    my $offset   = shift;
    my $nolock   = shift;
    my ( $fh, $rv );

    pdebug( 'entering w/(%s)(%s)(%s)(%s)',
        PDLEVEL2, $filename, $sref, $rlen, $offset );
    pIn();

    if ( defined $filename ) {

        # Opportunistically open a file handle if needed,
        # otherwise, just retrieve the existing file handle
        $fh = popen( $filename, O_RDONLY );

        # Smoke 'em if you got'em...
        if ( defined $fh ) {
            if ( $nolock or pflock( $filename, LOCK_SH ) ) {
                $rlen   = PIOBLKSIZE unless defined $rlen;
                $offset = 0          unless defined $offset;
                $rv = sysread $fh, $$sref, $rlen, $offset;
                if ( defined $rv ) {
                    pdebug( 'read %d bytes', PDLEVEL2, $rv );
                } else {
                    Paranoid::ERROR =
                        pdebug( 'failed to read from file handle: %s',
                        PDLEVEL1, $! );
                }
                pflock( $filename, LOCK_UN ) unless $nolock;
            }
        }
    }

    pOut();
    pdebug( 'leaving w/rv: %s', PDLEVEL2, $rv );

    return $rv;
}

sub pnlread ($\$;@) {

    # Purpose:  Wrapper for pread
    # Returns:  RV of pread
    # Usage:    $bytes = pnlread($filename, $text, $length);
    # Usage:    $bytes = pnlread($filename, $text, $length, $offset);

    my $filename = shift;
    my $sref     = shift;
    my $rlen     = shift;
    my $offset   = shift;

    return pread( $filename, $$sref, $rlen, $offset, 1 );
}

sub ptruncate {

    # Purpose:  Truncates the specified file
    # Returns:  RV of truncate
    # Usage:    $rv = ptruncate($filename);
    # Usage:    $rv = ptruncate($filename, $pos);

    my $filename = shift;
    my $pos      = shift;
    my ( $rv, $fh, $cpos );

    pdebug( 'entering w/(%s)(%s)', PDLEVEL2, $filename, $pos );
    pIn();

    if ( defined $filename ) {
        $pos = 0 unless defined $pos;
        $fh = popen( $filename, O_RDWR | O_CREAT );

        # Smoke 'em if you got'em...
        if ( defined $fh ) {
            if ( pflock( $filename, LOCK_EX ) ) {
                $cpos = sysseek $fh, 0, SEEK_CUR;
                $rv = truncate $fh, $pos;
                if ($rv) {
                    sysseek $fh, $pos, SEEK_SET if $cpos > $pos;
                } else {
                    Paranoid::ERROR =
                        pdebug( 'failed to truncate file: %s', PDLEVEL1, $! );
                }
                pflock( $filename, LOCK_UN );
            }
        }
    }

    pOut();
    pdebug( 'leaving w/rv: %s', PDLEVEL2, $rv );

    return $rv;
}

END {

    # Attempt to clean close all filehandles
    pcloseAll();
}

1;

__END__