File Coverage

blib/lib/Paranoid/IO.pm

Criterion	Covered	Total	%
statement	331	374	88.5
branch	141	214	65.8
condition	32	60	53.3
subroutine	37	41	90.2
pod	18	18	100.0
total	559	707	79.0

# Paranoid::IO -- Paranoid IO support
#
# $Id: lib/Paranoid/IO.pm, 2.10 2022/03/08 00:01:04 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 - 2021, Arthur Corliss ([e-mail])
# (tm) 2008 - 2021, 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.10 $ =~ /(\d+(?:\.\d+)+)/sm );

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

use constant PDEFPERM   => 0666;
use constant PDEFMODE   => O_CREAT | O_RDWR;
use constant PDEFBLKSZ  => 4096;
use constant PDEFFILESZ => 65536;
use constant PFLMASK    => LOCK_SH | LOCK_EX | LOCK_UN;
use constant PIGNMFLAGS => O_TRUNC | O_CREAT | O_EXCL;

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

{

    my $mblksz = PDEFBLKSZ;

    sub PIOBLKSIZE : lvalue {

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

        $mblksz;
    }

    my $mfsz = PDEFFILESZ;

    sub PIOMAXFSIZE : lvalue {

        # Purpose:  Gets/sets default max file size for I/O
        # Returns:  $mfsz
        # Usage:    PIOMAXFSIZE = bytes;

        $mfsz;
    }

    my %lstack;
    my $lsflag = 0;

    sub PIOLOCKSTACK : lvalue {

        # Purpose:  Enables/disables the flock lock stack
        # Returns:  $lsflag
        # Usage:    PIOLOCKSTACK = 1;

        $lsflag;
    }

    # %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;

        subPreamble( PDLEVEL4, '$', $fh );

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

        subPostamble( PDLEVEL4, '$', $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;

        subPreamble( PDLEVEL1, '$', $filename );

        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
            if ( defined $filename ) {
                delete $files{$filename};
                delete $lstack{$filename};
            }

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

        subPostamble( PDLEVEL1, '$', $rv );

        return $rv;
    }

    sub pcloseAll {

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

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

        subPreamble( PDLEVEL1, '@', @files );

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

        subPostamble( PDLEVEL1, '$', $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 );

        subPreamble( PDLEVEL3, '$;$$', $filename, $mode, $perms );

        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 );
                }
            }
        }

        subPostamble( 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 );

        subPreamble( PDLEVEL3, '$', $filename );

        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) ) {

                # Reopen should ignore O_TRUNC, O_CREAT, and O_EXCL on reopens
                $tmp{mode} &= ~PIGNMFLAGS if $tmp{mode} & PIGNMFLAGS;

                # 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};

                    # Delete any existing lock stack
                    delete $lstack{$filename};
                }
            }
        }

        subPostamble( 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 );

        subPreamble( PDLEVEL2, '$;$$', $filename, $mode, $perms );

        # 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 );
        }

        subPostamble( 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;

        subPreamble( PDLEVEL2, '@', @files );

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

        subPostamble( 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, $rl );
        local $!;

        subPreamble( PDLEVEL3, '$$', $filename, $lock );

        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
                $rl = $lock & PFLMASK;
                $rv = flock $fh, $lock;

                # Record change to internal state if we're tracking this file
                if ($rv) {
                    if ( defined $filename and exists $files{$filename} ) {
                        $files{$filename}{ltype} = $rl;
                    } else {
                        pdebug(
                            'flock succeeded on file opened outside of the'
                                . ' Paranoid::IO framework (%s)',
                            PDLEVEL1, $filename
                            );
                    }
                } else {
                    pdebug(
                        ( ( $lock & LOCK_NB ) ? 'non-blocking' : '' )
                        . 'flock attempt failed on %s',
                        PDLEVEL1, $filename
                        );
                }
            }
        }

        subPostamble( PDLEVEL3, '$', $rv );

        return $rv;
    }

    sub _plsflock {

        my $filename = shift;
        my $lock     = shift;
        my ( $fh, $stack, $rl, $ll, $lsl, $rv );

        subPreamble( PDLEVEL3, '$$', $filename, $lock );

        # Var Key:
        #   lock:   lock passed to function (can include LOCK_NB)
        #   rl:     real lock (stripping LOCK_NB)
        #   ll:     last lock (as performed by last _pflock()
        #   lsl:    last lock recorded in the lock stack

        # Translate glob to filename for lock stack tracking purposes
        $fh = $filename;
        $filename = _pfFhind($filename) if ref $filename eq 'GLOB';

        # Get the current lock state
        $ll = $files{$filename}{ltype}
            if defined $filename and exists $files{$filename};
        if ( defined $ll ) {

            # Get the real lock level for comparison
            $rl = $lock & PFLMASK;

            # File has been opened, at least, with popen, and has a locktype
            # entry
            $lstack{$filename} = [] unless exists $lstack{$filename};
            $stack = $lstack{$filename};
            $lsl   = $$stack[-1];

            #warn "lock: $lock\nrl: $rl\nll: $ll\nlsl: $lsl\n";
            pdebug(
                'something has gone awry during lock tracking.'
                    . 'll: %s lsl: %s',
                PDLEVEL1, $ll, $lsl
                )
                if defined $lsl
                    and $lsl != $ll;

            # Adjust as necessary
            if ( $rl == LOCK_UN ) {

                # Remove a lock from the stack
                pop @$stack;

                if ( scalar @$stack ) {

                    # Still have locks in the stack that must not be degraded
                    $rv = 1;
                    if ( $ll != $$stack[-1] ) {

                        # Apply the new level
                        $rv = _pflock( $filename, $$stack[-1] );
                    }

                } else {

                    # No locks in the stack to preserve, so go ahead and
                    # release the lock
                    $rv = _pflock( $filename, LOCK_UN );

                }

            } elsif ( $rl == LOCK_SH ) {

                # Upgrade lock to preserve previous exclusive lock on the
                # stack, if necessary
                if ( defined $lsl and $lsl == LOCK_EX ) {
                    $lock = ( LOCK_EX | ( $lock & LOCK_NB ) );
                    $rl = LOCK_EX;
                }

                $rv = $ll == $rl ? 1 : _pflock( $filename, $lock );
                push @$stack, $rl if $rv;

            } elsif ( $rl == LOCK_EX ) {
                push @$stack, $rl;
                $rv = $ll == $rl ? 1 : _pflock( $filename, $lock );
            } else {
                pdebug( 'unknown lock type: %x', PDLEVEL1, $lock );
            }

            # Report some diagnostics
            if ( scalar @$stack ) {
                pdebug( 'lock stack depth: %s', PDLEVEL4, scalar @$stack );
                if ( $ll == $$stack[-1] ) {
                    pdebug( 'preserved lock at %s', PDLEVEL4, $ll );
                } else {
                    pdebug( 'switched lock from %s to %s',
                        PDLEVEL4, $ll, $$stack[-1] );
                }
            } else {
                pdebug( 'no locks remaining', PDLEVEL4 );
            }

            # Delete empty stacks to avoid memory leaks
            delete $lstack{$filename} unless scalar @$stack;

        } else {
            if ( defined $fh and !defined $filename ) {
                $rv = _pflock( $fh, $lock );
            } else {
                pdebug( 'file %s is unknown to Paranoid::IO so far',
                    PDLEVEL1, $filename );
            }
        }

        subPostamble( PDLEVEL3, '$', $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 );

        subPreamble( PDLEVEL2, '$$', $filename, $lock );

        # NOTE:  retrieving the file handle might seem silly, but if a process
        # is forked, and the first thing they do on a file is apply an flock,
        # the first I/O operation will close and reopen the file to avoid
        # confusion with the parent process and, therefore, losing the lock.
        #
        # End sum, this is a necessary evil in order to preserve locks a
        # before any effective I/O is done in the child.
        if ( defined $filename ) {
            $fh = popen($filename);
            $rv =
                  PIOLOCKSTACK()
                ? _plsflock( $filename, $lock )
                : _pflock( $filename, $lock );
        }

        subPostamble( PDLEVEL2, '$', $rv );

        return $rv;
    }

    sub plockstat {

        # Purpose:  Returns the the status of the last lock applied via
        #           pflock()
        # Returns:  LOCK_*
        # Usage:    $lock = plockstat($filename);

        my $filename = shift;
        my $rv;

        subPreamble( PDLEVEL2, '$', $filename );

        if ( defined $filename ) {

            # Get the missing variable
            $filename = _pfFhind($filename) if ref $filename eq 'GLOB';
            if ( defined $filename and exists $files{$filename} ) {
                $rv = $files{$filename}{ltype};
            } else {
                pdebug(
                    'attempted to retrieve lock status for file not opened'
                        . ' with the Paranoid::IO framework (%s)',
                    PDLEVEL1, $filename
                    );
            }
        }

        subPostamble( 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 $!;

    subPreamble( PDLEVEL2, '$', $filename );

    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;
        }
    }

    subPostamble( 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 $!;

    subPreamble( PDLEVEL2, '$$;$', $filename, $setpos, $whence );

    if ( defined $filename ) {

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

    subPostamble( 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);
    # Usage:    $bytes = pwrite($filename, $text, $length, $offset, $nolock);

    my $filename = shift;
    my $out      = shift;
    my $wlen     = shift;
    my $offset   = shift;
    my $nolock   = shift;
    my $bytes    = defined $out ? length $out : 0;
    my ( $fh, $rv );

    subPreamble( PDLEVEL2, '$$;$$$', $filename, $bytes, $wlen, $offset,
        $nolock );

    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 );

        # Smoke 'em if you got'em...
        if ( defined $fh ) {
            if ( $nolock or 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 ) unless $nolock;
            }
        }
    }

    subPostamble( PDLEVEL2, '$', $rv );

    return $rv;
}

sub pnlwrite {

    # Purpose:  Wrapper for pwrite w/o internal flocking
    # Returns:  RV of pwrite
    # Usage:    $bytes = pnlwrite($filename, $text, $length);
    # Usage:    $bytes = pnlwrite($filename, $text, $length, $offset);

    my $filename = shift;
    my $out      = shift;
    my $wlen     = shift;
    my $offset   = shift;

    return pwrite( $filename, $out, $wlen, $offset, 1 );
}

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 $nolock   = shift;
    my ( $fh, $pos, $rv );

    subPreamble( PDLEVEL2, '$$;$$', $filename, $out, $wlen, $offset,
        $nolock );

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

        # Opportunistically open a 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 ( $nolock or 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 ) unless $nolock;
            }
        }
    }

    subPostamble( PDLEVEL2, '$', $rv );

    return $rv;
}

sub pnlappend {

    # Purpose:  Wrapper for pappend w/o internal flocking
    # Returns:  RV of pappend
    # Usage:    $bytes = pnlappend($filename, $text, $length);
    # Usage:    $bytes = pnlappend($filename, $text, $length, $offset);

    my $filename = shift;
    my $out      = shift;
    my $wlen     = shift;
    my $offset   = shift;

    return pappend( $filename, $out, $wlen, $offset, 1 );
}

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 );

    subPreamble( PDLEVEL2, '$\$;$$$', $filename, $sref, $rlen, $offset,
        $nolock );

    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;
            }
        }
    }

    subPostamble( PDLEVEL2, '$', $rv );

    return $rv;
}

sub pnlread ($\$;@) {

    # Purpose:  Wrapper for pread w/o internal flocking
    # 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);
    # Usage:    $rv = ptruncate($filename, $pos, 1);

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

    subPreamble( PDLEVEL2, '$;$$', $filename, $pos, $nolock );

    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 ( $nolock or 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 ) unless $nolock;
            }
        }
    }

    subPostamble( PDLEVEL2, '$', $rv );

    return $rv;
}

END {

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

1;

__END__