package File::Util;

use 5.006;
use strict;
use warnings;

use vars qw(
   $VERSION    @ISA        @EXPORT_OK    %EXPORT_TAGS
   $OS         $MODES      $READLIMIT    $MAXDIVES
   $USE_FLOCK  @ONLOCKFAIL $ILLEGAL_CHR  $CAN_FLOCK
   $EBCDIC     $DIRSPLIT   $_LOCKS       $NEEDS_BINMODE
   $WINROOT    $ATOMIZER   $SL   $NL     $EMPTY_WRITES_OK
   $FSDOTS
);

use Exporter;
use AutoLoader qw( AUTOLOAD );

$VERSION    = 3.32; # Wed Nov 28 21:42:59 CST 2012
@ISA        = qw( Exporter );
@EXPORT_OK  = qw(
   NL     can_flock   ebcdic       existent      needs_binmode
   SL     strip_path  can_read     can_write     valid_filename
   OS     bitmask     return_path  file_type     escape_filename
   isbin  created     last_access  last_changed  last_modified
   size   atomize
);

%EXPORT_TAGS = ( all  => [ @EXPORT_OK ] );

BEGIN {

   # Some OS logic.
   unless ( $OS = $^O ) { require Config; eval q[$OS=$Config::Config{osname}] }

      if ( $OS =~ /^darwin/i ) { $OS = 'UNIX'      }
   elsif ( $OS =~ /^cygwin/i ) { $OS = 'CYGWIN'    }
   elsif ( $OS =~ /^MSWin/i  ) { $OS = 'WINDOWS'   }
   elsif ( $OS =~ /^vms/i    ) { $OS = 'VMS'       }
   elsif ( $OS =~ /^bsdos/i  ) { $OS = 'UNIX'      }
   elsif ( $OS =~ /^dos/i    ) { $OS = 'DOS'       }
   elsif ( $OS =~ /^MacOS/i  ) { $OS = 'MACINTOSH' }
   elsif ( $OS =~ /^epoc/    ) { $OS = 'EPOC'      }
   elsif ( $OS =~ /^os2/i    ) { $OS = 'OS2'       }
                          else { $OS = 'UNIX'      }

$EBCDIC = qq[\t] ne qq[\011] ? 1 : 0;
$NEEDS_BINMODE = $OS =~ /WINDOWS|DOS|OS2|MSWin/ ? 1 : 0;
$NL =
   $NEEDS_BINMODE               ? qq[\015\012]
      : $EBCDIC || $OS eq 'VMS' ? qq[\n]
         : $OS eq 'MACINTOSH'   ? qq[\015]
            : qq[\012];
$SL =
   { DOS => '\\', EPOC   => '/', MACINTOSH => ':',
     OS2 => '\\', UNIX   => '/', WINDOWS   => chr(92),
     VMS => '/',  CYGWIN => '/', }->{ $OS } || '/';

$_LOCKS = {};

} BEGIN {
   use constant NL => $NL;
   use constant SL => $SL;
   use constant OS => $OS;
}

$WINROOT     = qr/^(?: [[:alpha:]]{1} ) : (?: \\{1,2} )/x;
$DIRSPLIT    = qr/$WINROOT | [\\:\/]/x;
$ATOMIZER    = qr/
   (^ $DIRSPLIT ){0,1}
   (?: (.*) $DIRSPLIT ){0,1}
   (.*) /x;
$ILLEGAL_CHR = qr/[\/\|\\$NL\r\n\t\013\*\"\?\<\:\>]/;
$FSDOTS      = qr/^\.{1,2}$/;
$READLIMIT   = 52428800; # set readlimit to a default of 50 megabytes
$MAXDIVES    = 1000;     # maximum depth for recursive list_dir calls

use Fcntl qw();

{ local $@; eval <<'__canflock__'; $CAN_FLOCK = $@ ? 0 : 1; }
flock(STDOUT, &Fcntl::LOCK_SH);
flock(STDOUT, &Fcntl::LOCK_UN);
__canflock__

# try to use file locking, define flock race conditions policy
$USE_FLOCK = 1; @ONLOCKFAIL = qw( NOBLOCKEX FAIL );

$MODES->{popen} = {
   write     => '>',  trunc    => '>',  rwupdate  => '+<',
   append    => '>>', read     => '<',  rwclobber => '+>',
   rwcreate  => '+>', rwappend => '+>>',
};

$MODES->{sysopen} = {
   read      => '&Fcntl::O_RDONLY',
   write     => '&Fcntl::O_WRONLY | &Fcntl::O_CREAT',
   append    => '&Fcntl::O_WRONLY | &Fcntl::O_APPEND | &Fcntl::O_CREAT',
   trunc     => '&Fcntl::O_WRONLY | &Fcntl::O_CREAT  | &Fcntl::O_TRUNC',
   rwcreate  => '&Fcntl::O_RDWR | &Fcntl::O_CREAT',
   rwupdate  => '&Fcntl::O_RDWR',
   rwclobber => '&Fcntl::O_RDWR | &Fcntl::O_TRUNC | &Fcntl::O_CREAT',
   rwappend  => '&Fcntl::O_RDWR | &Fcntl::O_APPEND | &Fcntl::O_CREAT',
};


# --------------------------------------------------------
# Constructor
# --------------------------------------------------------
sub new {
   my $this = {};

   bless $this, shift @_;

   my $in   = $this->_names_values( @_ );
   my $opts = $this->_remove_opts( \@_ );

   $this->{opts} = $opts || {};

   $USE_FLOCK  = $in->{use_flock}
      if exists $in->{use_flock}
      && $in->{use_flock};

   $READLIMIT  = $in->{readlimit}
      if defined $in->{readlimit}
      && $$in{readlimit} !~ /\D/;

   $MAXDIVES   = $in->{max_dives}
      if defined $in->{max_dives}
      && $$in{max_dives} !~ /\D/;

   return $this;
}


# --------------------------------------------------------
# File::Util::atomize()
# --------------------------------------------------------
sub atomize {
   my $fqfn = _myargs( @_ );

   $fqfn =~ m/$ATOMIZER/;

   my $root = $1 || '';
   my $path = $2 || '';
   my $file = $3 || '';

   return( $root, $path, $file );
}


# --------------------------------------------------------
# File::Util::list_dir()
# --------------------------------------------------------
sub list_dir {
   my $this = shift @_;
   my $opts = $this->_remove_opts( \@_ );
   my $dir  = shift @_ || '.';
   my $path = $dir;
   my $maxd = $opts->{'--max-dives'} || $MAXDIVES;
   my $r    = 0;
   my ( @dirs, @files, @items );

   return $this->_throw(
      'no input' => {
         meth    => 'list_dir',
         missing => 'a directory name',
         opts    => $opts,
      }
   ) unless length $dir;

   return $this->_throw( 'no such file' => { filename => $dir } )
      unless -e $dir;

   # whack off any trailing directory separator, except for root directories
   # -account for both posix filesystem AND micro$oft path notation
   unless ( length $dir == 1 || $dir =~ /^$WINROOT$/o ) {

      # removes one or more dirsep at the end of $dir
      $dir =~ s/(?:$DIRSPLIT){1,}$//o;
   }

   return $this->_throw (
      'called opendir on a file' => {
         filename => $dir,
         opts     => $opts,
      }
   ) unless -d $dir;

   # this directory recursion method keeps track of dives based on the parent
   # directory of $dir, rather than on $dir itself so that multiple
   # subdirectories within the same parent directory don't improperly increment
   # the number of dives made
   if ( $opts->{'--recursing'} ) {

      my $pdir = $dir; $pdir =~ s/(^.*)$DIRSPLIT.*/$1/;

      $this->{traversed}{ $pdir } = $pdir;
   }
   else { $this->{traversed} = {} }

   # enforce maximum subdirectory dives, unless $MAXDIVES is equal to zero
   if ( $MAXDIVES != 0 && ( scalar keys %{ $this->{traversed} } >= $maxd ) ) {

      return $this->_throw(
         'maxdives exceeded' => {
            meth     => 'list_dir',
            maxdives => $maxd,
            opts     => $opts,
         }
      )
   }

   $r = 1 if $opts->{'--follow'} || $opts->{'--recurse'};

   local *DIR;

   opendir DIR, $dir
      or return $this->_throw(
            'bad opendir' => {
               dirname    => $dir,
               exception  => $!,
               opts       => $opts,
            }
         );

   # read from beginning of the directory (doesn't seem necessary on any
   # platforms I've run code on, but just in case...)
   rewinddir DIR;

   @files = exists $opts->{'--pattern'}
      ? grep /$opts->{'--pattern'}/, readdir DIR
      : readdir DIR;

   @files = exists $opts->{'--rpattern'}
      ? grep /$opts->{'--rpattern'}/, @files
      : @files;

   closedir DIR
      or return $this->_throw(
         'close dir'  => {
            dir       => $dir,
            exception => $!,
            opts      => $opts,
         }
      );

   @files = grep { $_ !~ /$FSDOTS/ } @files if $opts->{'--no-fsdots'};

   for ( my $i = 0; $i < @files; ++$i ) {

      my $listing = ( $opts->{'--with-paths'} || $r == 1 )
         ? $path . SL . $files[ $i ]
         : $files[ $i ];

      if ( -d $path . SL . $files[ $i ] ) {

         push @dirs, $listing
      }
      else { push @items, $listing }
   }

   if  ( $r && !$opts->{'--override-follow'} ) {

      @dirs = grep { $this->strip_path( $_ ) !~ /$FSDOTS/ } @dirs;

      for ( my $i = 0; $i < @dirs; ++$i ) {

         my @opts = qw(
         --with-paths   --dirs-as-ref
         --files-as-ref --recursing --no-fsdots );

         # pattern should work when recursing!
         push @opts, qq(--rpattern=$opts->{'--rpattern'})
            if $opts->{'--rpattern'};

         push @opts, qq(--max-dives=$maxd);

         my @lsts = $this->list_dir( $dirs[ $i ], @opts );

         push @dirs, @{ $lsts[0] }
            if UNIVERSAL::isa( $lsts[0], 'ARRAY' ) && scalar @{ $lsts[0] };

         push @items, @{ $lsts[1] }
            if UNIVERSAL::isa( $lsts[1], 'ARRAY' ) && scalar @{ $lsts[1] };
      }
   }

   if ( $opts->{'--sl-after-dirs'} ) {

      # append directory separator to everything but the "dots"
      $_ .= SL for grep { $_ !~ /$FSDOTS/ } @dirs;
   }

   my $reta = []; my $retb = [];

   if ( $opts->{'--ignore-case'} ) {

      $reta = [ sort { uc $a cmp uc $b } @dirs  ];
      $retb = [ sort { uc $a cmp uc $b } @items ];
   }
   else {

      $reta = [ sort { $a cmp $b } @dirs  ];
      $retb = [ sort { $a cmp $b } @items ];
   }

   return scalar @$reta
      if $opts->{'--dirs-only'} && $opts->{'--count-only'};

   return scalar @$retb
      if $opts->{'--files-only'} && $opts->{'--count-only'};

   return scalar @$reta + scalar @$retb if $opts->{'--count-only'};

   return $reta, $retb if $opts->{'--as-ref'};

   $reta = [ $reta ] if $opts->{'--dirs-as-ref'};
   $retb = [ $retb ] if $opts->{'--files-as-ref'};

   return @$reta if $opts->{'--dirs-only'};
   return @$retb if $opts->{'--files-only'};

   return @$reta, @$retb;
}


# --------------------------------------------------------
# File::Util::_dropdots()
# --------------------------------------------------------
sub _dropdots {
   my $this     = shift @_;
   my $opts     = $this->_remove_opts( \@_ );
   my @copy     = @_;
   my @out      = ();
   my @dots     = ();
   my $gottadot = 0;

   while ( @copy ) {

      if ( $gottadot == 2 ) { push @out, @copy and last }

      my $dir_item = shift @copy;

      if ( $dir_item =~ /$FSDOTS/ ) {

         ++$gottadot;

         push @dots, $dir_item;

         next;
      }

      push @out, $dir_item;
   }

   return( \@dots, @out ) if $opts->{'--save-dots'};

   return @out;
}


# --------------------------------------------------------
# File::Util::load_file()
# --------------------------------------------------------
sub load_file {
   my $this       = shift @_;
   my $opts       = $this->_remove_opts( \@_ );
   my $in         = $this->_names_values( @_ );
   my @dirs       = ();
   my $fh         = undef;
   my $blocksize  = 1024; # 1.24 kb
   my $FH_passed  = 0;

   my ( $file, $root, $path, $clean_name, $content, $FHstatus, $mode  ) =
      ( '',    '',    '',    '',          '',       '',        'read' );

   if ( scalar @_ == 1 ) {

      $file = shift @_ || '';

      return $this->_throw(
         'no input',
         {
            meth    => 'load_file',
            missing => 'a file name or file handle reference',
            opts    => $opts,
         }
      ) unless length $file;

      ( $root, $path, $file ) = atomize( $file );

      @dirs = split /$DIRSPLIT/, $path;

      unshift @dirs, $root if $root;

      # cleanup file name - if path is relative, normalize it
      #    - /foo/bar/baz.txt stays as /foo/bar/baz.txt
      #    - foo/bar/baz.txt  becomes ./foo/bar/baz.txt
      #    - baz.txt          stays as baz.txt
      if ( !length $root && !length $path ) {

         $path = '.' . SL;
      }
      else { # otherwise path normalized at end

         $path .= SL;
      }

      # final clean filename assembled
      $clean_name = $root . $path . $file;
   }
   else {

      $fh       = $in->{FH}        || '';
      $FHstatus = $in->{FH_status} || '';

      # did we get a filehandle?
      if ( length $fh ) { $FH_passed = 1; } else {

         return $this->_throw(
            'no input',
            {
               meth    => 'load_file',
               missing => 'a file name or file handle reference',
               opts    => $opts,
            }
         );
      }
   }

   if ( $FH_passed ) {

      my $buffer     = 0;
      my $bytes_read = 0;

      while ( <$fh> ) {

         if ( $buffer < $READLIMIT ) {

            $bytes_read = read( $fh, $content, $blocksize );

            $buffer    += $bytes_read;
         }
         else {

            return $this->_throw(
               'readlimit exceeded',
               {
                  filename => '<FH>',
                  size     => qq{[truncated at $bytes_read]},
                  opts     => $opts,
               }
            );
         }
      }

      # return an array of all lines in the file if the call to this method/
      # subroutine asked for an array eg- my(@file) = load_file('file');
      # otherwise, return a scalar value containing all of the file's content
      return split /$NL|\r|\n/o, $content
         if $opts->{'--as-list'};

      return $content;
   }

   # if the file doesn't exist, send back an error
   return $this->_throw(
      'no such file',
      {
         filename => $clean_name,
         opts     => $opts,
      }
   ) unless -e $clean_name;

   # it's good to know beforehand whether or not we have permission to open
   # and read from this file allowing us to handle such an exception before
   # it handles us.

   # first check the readability of the file's housing dir
   return $this->_throw(
      'cant dread',
      {
         filename => $clean_name,
         dirname  => $root . $path,
         opts     => $opts,
      }
   ) unless -r $root . $path;

   # now check the readability of the file itself
   return $this->_throw(
      'cant fread',
      {
         filename => $clean_name,
         dirname  => $root . $path,
         opts     => $opts,
      }
   ) unless -r $clean_name;

   # if the file is a directory it will not be opened
   return $this->_throw(
      'called open on a dir',
      {
         filename => $clean_name,
         opts     => $opts,
      }
   ) if -d $clean_name;

   my $fsize = -s $clean_name;

   return $this->_throw(
      'readlimit exceeded',
      {
         filename => $clean_name,
         size     => $fsize,
         opts     => $opts,
      }
   ) if $fsize > $READLIMIT;

   # we need a unique filehandle
   do {
      $fh = int( rand time ) . $$;

      $fh = eval '*' . 'LOAD_FILE' . $fh

   } while fileno $fh;

   # localize the global output record separator so we can slurp it all
   # in one quick read.  We fail if the filesize exceeds our limit.
   local $/;

   # open the file for reading (note the '<' syntax there) or fail with a
   # error message if our attempt to open the file was unsuccessful
   my $cmd = '<' . $clean_name;

   # lock file before I/O on platforms that support it
   if ( $$opts{'--no-lock'} || $$this{opts}{'--no-lock'} ) {

      # if you use the '--no-lock' option you are probably inefficient
      open( $fh, $cmd ) or
         return $this->_throw(
            'bad open',
            {
               filename  => $clean_name,
               mode      => $mode,
               exception => $!,
               cmd       => $cmd,
               opts      => $opts,
            }
         );
   }
   else {
      open( $fh, $cmd ) or
         return $this->_throw(
            'bad open',
            {
               filename  => $clean_name,
               mode      => $mode,
               exception => $!,
               cmd       => $cmd,
               opts      => $opts,
            }
         );

      $this->_seize( $clean_name, $fh );
   }

   # call binmode on binary files for portability accross platforms such
   # as MS flavor OS family

   CORE::binmode( $fh ) if -B $clean_name;

   # assign the content of the file to this lexically scoped scalar variable
   # (memory for *that* variable will be freed when execution leaves this
   # method / sub

   $content = <$fh>;

   if ( $$opts{'--no-lock'} || $$this{opts}{'--no-lock'} ) {

      # if execution gets here, you used the '--no-lock' option, and you
      # are probably inefficient

      close $fh or return $this->_throw(
         'bad close',
         {
            filename  => $clean_name,
            mode      => $mode,
            exception => $!,
            opts      => $opts,
         }
      );
   }
   else {
      # release shadow-ed locks on the file
      $this->_release( $fh );

      close $fh or return $this->_throw(
         'bad close',
         {
            filename  => $clean_name,
            mode      => $mode,
            exception => $!,
            opts      => $opts,
         }
      );
   }

   # return an array of all lines in the file if the call to this method/
   # subroutine asked for an array eg- my(@file) = load_file('file');
   # otherwise, return a scalar value containing all of the file's content
   return split /$NL|\r|\n/o, $content
      if $opts->{'--as-lines'};

   return $content;
}


# --------------------------------------------------------
# File::Util::write_file()
# --------------------------------------------------------
sub write_file {
   my $this     = shift @_;
   my $opts     = $this->_remove_opts( \@_ );
   my $in       = $this->_names_values( @_ );
   my $file     = $in->{file}    || $in->{filename} || '';
   my $content  = $in->{content} || '';
   my $mode     = $in->{mode}    || 'write';
   my $bitmask  = _bitmaskify( $in->{bitmask} ) || 0777;
   my $raw_name = $file;
   my ( $root, $path, $clean_name, @dirs ) =
      ( '',    '',    '',          ()    );

   ( $root, $path, $file ) = atomize ( $file );

   local *WRITE_FILE;

   $mode = 'trunc' if $mode eq 'truncate';

   # if the call to this method didn't include a filename to which the caller
   # wants us to write, then complain about it
   return $this->_throw(
      'no input',
      {
         meth    => 'write_file',
         missing => 'a file name to create, write, or append',
         opts    => $opts,
      }
   ) unless length $file;

   # if prospective filename contains 2+ dir separators in sequence then
   # this is a syntax error we need to whine about
   {
      my $try_filename = $raw_name;

      $try_filename =~ s/$WINROOT//; # windows abs paths would throw this off

      return $this->_throw(
         'bad chars',
         {
            string  => $raw_name,
            purpose => 'the name of a file or directory',
            opts    => $opts,
         }
      ) if $try_filename =~ /(?:$DIRSPLIT){2,}/;
   }

   # if the call to this method didn't include any data which the caller
   # wants us to write or append to the file, then complain about it
   return $this->_throw(
      'no input',
      {
         meth    => 'write_file',
         missing => 'the content you want to write or append',
         opts    => $opts,
      }
   ) if (
      length $content == 0
         &&
      $mode ne 'trunc'
         &&
      !$EMPTY_WRITES_OK
         &&
      !$opts->{'--empty-writes-OK'}
   );

   # check if file already exists in the form of a directory
   return $this->_throw(
      'cant write_file on a dir',
      {
         filename => $raw_name,
         opts     => $opts,
      }
   ) if -d $raw_name;

   # determine existance of the file path, make directory(ies) for the
   # path if the full directory path doesn't exist
   @dirs = split /$DIRSPLIT/, $path;

   # if prospective file name has illegal chars then complain
   foreach ( @dirs ) {

      return $this->_throw(
         'bad chars',
         {
            string  => $_,
            purpose => 'the name of a file or directory',
            opts    => $opts,
         }
      ) if !$this->valid_filename( $_ );
   }

   # do this AFTER the above check!!
   unshift @dirs, $root if $root;

   # make sure that open mode is a valid mode
   unless ( $mode eq 'write' || $mode eq 'append' || $mode eq 'trunc' ) {

      return $this->_throw(
         'bad openmode popen',
         {
            meth     => 'write_file',
            filename => $raw_name,
            badmode  => $mode,
            opts     => $opts,
         }
      )
   }

   # cleanup file name - if path is relative, normalize it
   #    - /foo/bar/baz.txt stays as /foo/bar/baz.txt
   #    - foo/bar/baz.txt  becomes ./foo/bar/baz.txt
   #    - baz.txt          stays as baz.txt
   if ( !length $root && !length $path ) {

      $path = '.' . SL;
   }
   else { # otherwise path normalized at end

      $path .= SL;
   }

   # final clean filename assembled
   $clean_name = $root . $path . $file;

   # create path preceding file if path doesn't exist

   $this->make_dir(
      $root . $path,
      exists $in->{dbitmask}
         ? _bitmaskify( $in->{dbitmask} )
         : 0777
   ) unless -e $root . $path;

   # if file already exists, check if we can write to it
   if ( -e $clean_name ) {

      return $this->_throw(
         'cant fwrite',
         {
            filename => $clean_name,
            dirname  => $root . $path,
            opts     => $opts,
         }
      ) unless -w $clean_name;
   }
   else {

      # if file doesn't exist, see if we can create it
      return $this->_throw(
         'cant fcreate',
         {
            filename => $clean_name,
            dirname  => $root . $path,
            opts     => $opts,
         }
      ) unless -w $root . $path;
   }

   # if you use the --no-lock option, please consider the risks

   if ( $$opts{'--no-lock'} || !$USE_FLOCK ) {

      # get open mode
      $mode = $$MODES{popen}{ $mode };

      # only non-existent files get bitmask arguments
      if ( -e $clean_name ) {

         sysopen(
            WRITE_FILE,
            $clean_name,
            eval( $$MODES{sysopen}{ $mode } )
         )
         or return $this->_throw(
               'bad open',
               {
                  filename  => $clean_name,
                  mode      => $mode,
                  exception => $!,
                  cmd       => qq{$clean_name, $$MODES{sysopen}{ $mode }},
                  opts      => $opts,
               }
            );
      }
      else {

         sysopen(
            WRITE_FILE,
            $clean_name,
            eval( $$MODES{sysopen}{ $mode } ),
            $bitmask
         )
         or return $this->_throw(
            'bad open',
            {
               filename  => $clean_name,
               mode      => $mode,
               exception => $!,
               cmd       => qq[$clean_name, $$MODES{sysopen}{$mode}, $bitmask],
               opts      => $opts,
            }
         );
      }
   }
   else {
      # open read-only first to safely check if we can get a lock.
      if ( -e $clean_name ) {

         open WRITE_FILE, '<' . $clean_name or
            return $this->_throw(
               'bad open',
               {
                  filename  => $clean_name,
                  mode      => 'read',
                  exception => $!,
                  cmd       => $mode . $clean_name,
                  opts      => $opts,
               }
            );

         # lock file before I/O on platforms that support it
         my $lockstat = $this->_seize( $clean_name, *WRITE_FILE );

         return $lockstat unless $lockstat;

         sysopen(
            WRITE_FILE,
            $clean_name,
            eval( $$MODES{sysopen}{ $mode } )
         )
         or return $this->_throw(
            'bad open',
            {
               filename  => $clean_name,
               mode      => $mode,
               opts      => $opts,
               exception => $!,
               cmd       => qq[$clean_name, $$MODES{sysopen}{ $mode }],
            }
         );
      }
      else { # only non-existent files get bitmask arguments

         sysopen(
            WRITE_FILE,
            $clean_name,
            eval( $$MODES{sysopen}{ $mode } ),
            $bitmask
         )
         or return $this->_throw(
            'bad open',
            {
               filename  => $clean_name,
               mode      => $mode,
               opts      => $opts,
               exception => $!,
               cmd       => qq[$clean_name, $$MODES{sysopen}{$mode}, $bitmask],
            }
         );

         # lock file before I/O on platforms that support it
         my $lockstat = $this->_seize( $clean_name, *WRITE_FILE );

         return $lockstat unless $lockstat;
      }

      # now truncate
      if ( $mode ne 'append' ) {

         truncate( WRITE_FILE, 0 ) or return $this->_throw(
            'bad systrunc',
            {
               filename  => $clean_name,
               exception => $!,
               opts      => $opts,
            }
         );
      }
   }

   CORE::binmode( WRITE_FILE ) if $in->{binmode} || $opts->{'--binmode'};

   $in->{content} ||= ''; syswrite( WRITE_FILE, $in->{content} );

   # release lock on the file

   $this->_release( *WRITE_FILE ) unless $$opts{'--no-lock'} || !$USE_FLOCK;

   close WRITE_FILE or
      return $this->_throw(
         'bad close',
         {
            filename  => $clean_name,
            mode      => $mode,
            exception => $!,
            opts      => $opts,
         }
      );

   return 1;
}


# --------------------------------------------------------
# %$File::Util::LOCKS
# --------------------------------------------------------
$_LOCKS->{IGNORE}    = sub { $_[2] };
$_LOCKS->{ZERO}      = sub { 0 };
$_LOCKS->{UNDEF}     = sub { undef };
$_LOCKS->{NOBLOCKEX} = sub {
   return $_[2] if flock( $_[2], &Fcntl::LOCK_EX | &Fcntl::LOCK_NB ); undef
};
$_LOCKS->{NOBLOCKSH} = sub {
   return $_[2] if flock( $_[2], &Fcntl::LOCK_SH | &Fcntl::LOCK_NB ); undef
};
$_LOCKS->{BLOCKEX}   = sub {
   return $_[2] if flock( $_[2], &Fcntl::LOCK_EX ); undef
};
$_LOCKS->{BLOCKSH}   = sub {
   return $_[2] if flock( $_[2], &Fcntl::LOCK_SH ); undef
};
$_LOCKS->{WARN} = sub {
   $_[0]->_throw(
      'bad flock',
      {
         filename  => $_[1],
         exception => $!,
      },
      '--as-warning',
   ); return undef
};
$_LOCKS->{FAIL} = sub {
   $_[0]->_throw(
      'bad flock',
      {
         filename  => $_[1],
         exception => $!,
      },
   ); return 0
};


# --------------------------------------------------------
# File::Util::_seize()
# --------------------------------------------------------
sub _seize {
   my ( $this, $file, $fh ) = @_;

   return $this->_throw( 'no handle passed to _seize.' ) unless $fh;

   $file = defined $file ? $file : ''; # yes, even files named "0" are allowed

   return $this->_throw( 'no file name passed to _seize.' ) unless length $file;

   # forget seizing if system can't flock
   return $fh if !$CAN_FLOCK;

   my @policy = @ONLOCKFAIL;
   my $policy = {};

   # seize filehandle, return it if lock is successful

   while ( @policy ) {

      my $fh = &{ $_LOCKS->{ shift @policy } }( $this, $file, $fh );

      return $fh if $fh || !scalar @policy;
   }

   return $fh;
}


# --------------------------------------------------------
# File::Util::_release()
# --------------------------------------------------------
sub _release {

   my ( $this, $fh ) = @_;

   return $this->_throw( 'not a filehandle.', { argtype => ref \$fh } )
      unless $fh && ref \$fh eq 'GLOB';

   if ( $CAN_FLOCK ) { flock $fh, &Fcntl::LOCK_UN }

   return 1;
}


# --------------------------------------------------------
# File::Util::valid_filename()
# --------------------------------------------------------
sub valid_filename {
   my $f = _myargs( @_ );

   $f =~ s/$WINROOT//; # windows abs paths would throw this off

   $f !~ /$ILLEGAL_CHR/ ? 1 : undef;
}


# --------------------------------------------------------
# File::Util::strip_path()
# --------------------------------------------------------
sub strip_path { pop @{[ '', split /$DIRSPLIT/, _myargs( @_ ) ]} || '' }


# --------------------------------------------------------
# File::Util::line_count()
# --------------------------------------------------------
sub line_count {
   my($this, $file) = @_;
   my $buff   = '';
   my $lines  = 0;
   my $cmd    = '<' . $file;

   local *LINES;

   open LINES, $file or
      return $this->_throw(
         'bad open',
         {
            'filename'  => $file,
            'mode'      => 'read',
            'exception' => $!,
            'cmd'       => $cmd,
         }
      );

   while (sysread(LINES, $buff, 4096)) {
      $lines += $buff =~ tr/\n//; $buff  = '';
   }

   close(LINES); $lines;
}


# --------------------------------------------------------
# File::Util::_bitmaskify()
# --------------------------------------------------------
sub _bitmaskify {
   # save users who mistakenly pass in string values when bitmasks
   # are required (bitmasks must always be octal numbers)

   my $bmsk = _myargs( @_ );

   return unless defined $bmsk && length $bmsk;

   return $bmsk == eval $bmsk ? $bmsk : oct $bmsk;
}


# --------------------------------------------------------
# File::Util::bitmask()
# --------------------------------------------------------
sub bitmask {
   my $f = _myargs( @_ );

   defined $f and -e $f ? sprintf('%04o',(stat($f))[2] & 0777) : undef
}


# --------------------------------------------------------
# File::Util::can_flock()
# --------------------------------------------------------
sub can_flock { $CAN_FLOCK }


# File::Util::--------------------------------------------
#   can_read(),   can_write()
# --------------------------------------------------------
sub can_read  { my $f = _myargs( @_ ); defined $f ? -r $f : undef }
sub can_write { my $f = _myargs( @_ ); defined $f ? -w $f : undef }


# --------------------------------------------------------
# File::Util::created()
# --------------------------------------------------------
sub created {
   my $f = _myargs( @_ );

   defined $f and -e $f ? $^T - ((-M $f) * 60 * 60 * 24) : undef
}


# --------------------------------------------------------
# File::Util::ebcdic()
# --------------------------------------------------------
sub ebcdic { $EBCDIC }


# --------------------------------------------------------
# File::Util::escape_filename()
# --------------------------------------------------------
sub escape_filename {
   my($opts) = _remove_opts( \@_ );
   my($file,$escape,$also) = _myargs( @_ );

   return '' unless defined $file;

   $escape = '_' if !defined($escape);

   $file = strip_path($file) if $opts->{'--strip-path'};

   if ($also) { $file =~ s/\Q$also\E/$escape/g }

   $file =~ s/$ILLEGAL_CHR/$escape/g;
   $file =~ s/$DIRSPLIT/$escape/g;

   $file
}


# --------------------------------------------------------
# File::Util::existent()
# --------------------------------------------------------
sub existent { my $f = _myargs( @_ ); defined $f ? -e $f : undef }


# --------------------------------------------------------
# File::Util::touch()
# --------------------------------------------------------
sub touch {
   my $this  = shift @_;
   my $opts  = $this->_remove_opts( \@_ );
   my $in    = $this->_names_values( @_ );
   my(@dirs) = ();
   my($file) = ''; my($path) = '';
   my($mode) = 'read';

   $file = shift(@_)||'';

   @dirs = split(/$DIRSPLIT/, $file);

   if (scalar(@dirs) > 0) {

      $file = pop(@dirs); $path = join(SL, @dirs);
   }

   if (length($path) > 0) {
      $path = '.' . SL . $path if ($path !~ /(?:^\/)|(?:^\w\:)/o);
   }
   else { $path = '.'; }

   return $this->_throw(
         'no input',
         {
            'meth'      => 'touch',
            'missing'   => 'a file name or file handle reference',
            'opts'      => $opts,
         }
      ) if (length($path . SL . $file) == 0);

   # see if the file exists already and is a directory
   return $this->_throw(
      'cant touch on a dir',
      {
         'filename'  => $path . SL . $file,
         'dirname'   => $path . SL,
         'opts'      => $opts,
      }
   ) if (-e $path . SL . $file && -d $path . SL . $file);

   # if the path doesn't exist, make it
   $this->make_dir($path) unless -e $path . SL;

   # it's good to know beforehand whether or not we have permission to open
   # and read from this file allowing us to handle such an exception before
   # it handles us.

   # first check the readability of the file's housing dir
   return $this->_throw(
      'cant dread',
      {
         'filename'  => $path . SL . $file,
         'dirname'   => $path . SL,
         'opts'      => $opts,
      }
   ) unless (-r $path . SL);

   # now check the writability of the file itself
   return $this->_throw(
      'cant fwrite',
      {
         'filename'  => $path . SL . $file,
         'dirname'   => $path . SL,
         'opts'      => $opts,
      }
   ) if (-e $path . SL . $file && !-w $path . SL . $file);

   # create the file if it doesn't exist (like the *nix touch command does)
   $this->write_file(
      'filename' => $path . SL . $file,
      'content'  => '',
      '--empty-writes-OK'
   ) if !-e $path . SL . $file;

   my($now) = time();

   # return
   return utime $now, $now, $path . SL . $file;
}


# --------------------------------------------------------
# File::Util::file_type()
# --------------------------------------------------------
sub file_type {
   my $f = _myargs( @_ );

   return undef unless defined $f and -e $f;

   my @ret;

   push @ret, 'PLAIN'     if (-f $f);   push @ret, 'TEXT'      if (-T $f);
   push @ret, 'BINARY'    if (-B $f);   push @ret, 'DIRECTORY' if (-d $f);
   push @ret, 'SYMLINK'   if (-l $f);   push @ret, 'PIPE'      if (-p $f);
   push @ret, 'SOCKET'    if (-S $f);   push @ret, 'BLOCK'     if (-b $f);
   push @ret, 'CHARACTER' if (-c $f);   push @ret, 'TTY'       if (-t $f);

   push @ret, 'ERROR: Cannot determine file type' unless scalar @ret;

   return @ret;
}


# --------------------------------------------------------
# File::Util::flock_rules()
# --------------------------------------------------------
sub flock_rules {
   my($this)   = shift(@_);
   my(@rules)  = _myargs( @_ );

   return @ONLOCKFAIL unless scalar @rules;

   my(%valid) = qw/
      NOBLOCKEX   NOBLOCKEX
      NOBLOCKSH   NOBLOCKSH
      BLOCKEX     BLOCKEX
      BLOCKSH     BLOCKSH
      FAIL        FAIL
      WARN        WARN
      IGNORE      IGNORE
      UNDEF       UNDEF
      ZERO        ZERO /;

   map {
      return $this->_throw('bad flock rules', { 'bad' => $_, 'all' => \@rules })
      unless exists $valid{ $_ }
   } @rules;

   @ONLOCKFAIL = @rules;

   @ONLOCKFAIL
}


# --------------------------------------------------------
# File::Util::isbin()
# --------------------------------------------------------
sub isbin { my $f = _myargs( @_ ); defined $f ? -B $f : undef }


# --------------------------------------------------------
# File::Util::last_access()
# --------------------------------------------------------
sub last_access {
   my $f = _myargs( @_ ); $f ||= '';

   return undef unless -e $f;

   # return the last accessed time of $f
   $^T - ((-A $f) * 60 * 60 * 24)
}


# --------------------------------------------------------
# File::Util::last_modified()
# --------------------------------------------------------
sub last_modified {
   my $f = _myargs( @_ ); $f ||= '';

   return undef unless -e $f;

   # return the last modified time of $f
   $^T - ((-M $f) * 60 * 60 * 24)
}


# --------------------------------------------------------
# File::Util::last_changed()
# --------------------------------------------------------
sub last_changed {
   my $f = _myargs( @_ ); $f ||= '';

   return undef unless -e $f;

   # return the last changed time of $f
   $^T - ((-C $f) * 60 * 60 * 24)
}


# --------------------------------------------------------
# File::Util::load_dir()
# --------------------------------------------------------
sub load_dir {
   my($this) = shift(@_); my($opts) = $this->_remove_opts( \@_ );
   my($dir)  = shift(@_)||''; my(@files) = ();
   my($dir_hash) = {}; my($dir_list) = [];

   return $this->_throw
      (
         'no input',
         {
            'meth'      => 'load_dir',
            'missing'   => 'a directory name',
            'opts'      => $opts,
         }
      )
   unless length($dir);

   @files = $this->list_dir($dir,'--files-only');

   # map the content of each file into a hash key-value element where the
   # key name for each file is the name of the file
   if (!$opts->{'--as-list'} and !$opts->{'--as-listref'}) {

      foreach (@files) {

         $dir_hash->{ $_ } = $this->load_file( $dir . SL . $_ );
      }

      return($dir_hash);
   }
   else {

      foreach (@files) {

         push(@{$dir_list},$this->load_file( $dir . SL . $_ ));
      }

      return($dir_list) if ($opts->{'--as-listref'}); return(@{$dir_list});
   }

   $dir_hash;
}


# --------------------------------------------------------
# File::Util::make_dir()
# --------------------------------------------------------
sub make_dir {
   my $this = shift @_;
   my $opts = $this->_remove_opts( \@_ );
   my( $dir, $bitmask ) = @_;

   $bitmask = _bitmaskify( $bitmask ) || 0777;

   if ( $$opts{'--if-not-exists'} ) {

      if ( -e $dir ) {

         return $dir if -d $dir;

         return $this->_throw(
            'called mkdir on a file',
            {
               filename => $dir,
               dirname  => join( SL, split /$DIRSPLIT/, $dir ) . SL
            }
         );
      }
   }
   else {

      if ( -e $dir ) {

         return $this->_throw(
            'called mkdir on a file',
            {
               filename => $dir,
               dirname  => join( SL, split /$DIRSPLIT/, $dir ) . SL
            }
         ) unless -d $dir;

         return $this->_throw(
            'make_dir target exists',
            {
               dirname  => $dir,
               filetype => [ $this->file_type( $dir ) ],
            }
         );
      }
   }

   # if the call to this method didn't include a directory name to create,
   # then complain about it
   return $this->_throw(
      'no input',
      {
         meth    => 'make_dir',
         missing => 'a directory name',
      }
   ) unless defined $dir && length $dir;

   # if prospective directory name contains 2+ dir separators in sequence then
   # this is a syntax error we need to whine about
   {
      my $try_dir = $dir;

      $try_dir =~ s/$WINROOT//; # windows abs paths would throw this off

      return $this->_throw(
         'bad chars',
         {
            string  => $dir,
            purpose => 'the name of a directory',
         }
      ) if $try_dir =~ /(?:$DIRSPLIT){2,}/;
   }

   $dir =~ s/$DIRSPLIT$// unless $dir eq $DIRSPLIT;

   my @dirs_in_path = split /$DIRSPLIT/, $dir;

   # for absolute pathnames
   $dirs_in_path[0] = SL if substr $dir, 0, 1 eq SL;

   for ( my $i = 0; $i < scalar @dirs_in_path; ++$i ) {

      next if $i == 0 && $dirs_in_path[ $i ] eq SL;

      # if prospective directory name contains illegal chars then complain
      return $this->_throw(
         'bad chars',
         {
            'string'    => $dirs_in_path[ $i ],
            'purpose'   => 'the name of a directory',
         }
      ) unless $this->valid_filename( $dirs_in_path[ $i ] )
   }

   # qualify each subdir in @dirs_in_path by prepending its preceeding dir
   # names to it. Above, "/foo/bar/baz" becomes ("/", "foo", "bar", "baz")
   # and below it becomes ("/", "/foo", "/foo/bar", "/foo/bar/baz")

   if ( @dirs_in_path > 1 ) {
      for ( my $depth = 1; $depth < @dirs_in_path; ++$depth ) {

         if ( $dirs_in_path[ $depth-1 ] eq SL ) {

            $dirs_in_path[ $depth ] = SL . $dirs_in_path[ $depth ]
         }
         else {

            $dirs_in_path[ $depth ] =
               join SL, @dirs_in_path[ ( $depth - 1 ) .. $depth ]
         }
      }
   }

   my $i = 0;

   foreach ( @dirs_in_path ) {
      my $dir = $_;
      my $up  = ( $i > 0 ) ? $dirs_in_path[ $i - 1 ] : '..';

      ++$i;

      if ( -e $dir && !-d $dir ) {

         return $this->_throw(
            'called mkdir on a file',
            {
               'filename'  => $dir,
               'dirname'   => $up . SL,
            }
         );
      }

      next if -e $dir;

      # it's good to know beforehand whether or not we have permission to
      # create dirs here, which allows us to handle such an exception
      # before it handles us.
      return $this->_throw(
         'cant dcreate',
         {
            dirname  => $dir,
            parentd  => $up,
         }
      ) unless -w $up;

      mkdir( $dir, $bitmask ) or
         return $this->_throw(
            'bad make_dir',
            {
               exception => $!,
               dirname   => $dir,
               bitmask   => $bitmask,
            }
         );
   }

   return $dir;
}


# --------------------------------------------------------
# File::Util::max_dives()
# --------------------------------------------------------
sub max_dives {
   my $arg = _myargs( @_ );

   if ( defined $arg ) {

      return File::Util->new()->_throw('bad maxdives') if $arg !~ /\D/o;

      $MAXDIVES = $arg;
   }

   return $MAXDIVES;
}


# --------------------------------------------------------
# File::Util::readlimt()
# --------------------------------------------------------
sub readlimit {
   my $arg = _myargs( @_ );

   if ( defined $arg ) {

      return File::Util->new()->_throw
         (
            'bad readlimit' => { bad => $arg }
         ) if $arg !~ /\D/o;

      $READLIMIT = $arg;
   }

   return $READLIMIT;
}


# --------------------------------------------------------
# File::Util::needs_binmode()
# --------------------------------------------------------
sub needs_binmode { $NEEDS_BINMODE }


# --------------------------------------------------------
# File::Util::open_handle()
# --------------------------------------------------------
sub open_handle {
   my $this     = shift @_;
   my $opts     = $this->_remove_opts( \@_ );
   my $in       = $this->_names_values( @_ );
   my $file     = $in->{'file'}      || $in->{'filename'} || '';
   my $mode     = $in->{'mode'}      || 'write';
   my $raw_name = $file;
   my $bitmask  = _bitmaskify($in->{'bitmask'}) || 0777;

   my ( $root, $path, $clean_name, @dirs, $fh   ) =
      ( '',    '',    '',          (),    undef );

   ( $root, $path, $file ) = atomize ( $file );

   # begin user input validation/sanitation sequence

   # if the call to this method didn't include a filename to which the caller
   # wants us to write, then complain about it
   return $this->_throw(
      'no input',
      {
         meth    => 'open_handle',
         missing => 'a file name to create, write, read/write, or append',
         opts    => $opts,
      }
   ) unless length $file;

   # if prospective filename contains 2+ dir separators in sequence then
   # this is a syntax error we need to whine about
   {
      my $try_filename = $raw_name;

      $try_filename =~ s/$WINROOT//; # windows abs paths would throw this off

      return $this->_throw(
         'bad chars',
         {
            string  => $raw_name,
            purpose => 'the name of a file or directory',
            opts    => $opts,
         }
      ) if $try_filename =~ /(?:$DIRSPLIT){2,}/;
   }

   # determine existance of the file path, make directory(ies) for the
   # path if the full directory path doesn't exist
   @dirs = split /$DIRSPLIT/, $path;

   # if prospective file name has illegal chars then complain
   foreach ( @dirs ) {

      return $this->_throw(
         'bad chars',
         {
            string  => $_,
            purpose => 'the name of a file or directory',
            opts    => $opts,
         }
      ) if !$this->valid_filename( $_ );
   }

   # do this AFTER the above check!!
   unshift @dirs, $root if $root;

   # make sure that open mode is a valid mode
   if (
      !exists $opts->{'--use-sysopen'} &&
      !defined $opts->{'--use-sysopen'}
   ) {
      # native Perl open modes
      unless (
         exists $$MODES{'popen'}{ $mode } &&
         defined $$MODES{'popen'}{ $mode }
      ) {
         return $this->_throw(
            'bad openmode popen',
            {
               meth     => 'open_handle',
               filename => $raw_name,
               badmode  => $mode,
               opts     => $opts,
            }
         )
      }
   }
   else {
      # system open modes
      unless (
         exists $$MODES{'sysopen'}{ $mode } &&
         defined $$MODES{'sysopen'}{ $mode }
      ) {
         return $this->_throw(
            'bad openmode sysopen',
            {
               meth     => 'open_handle',
               filename => $raw_name,
               badmode  => $mode,
               opts     => $opts,
            }
         )
      }
   }

   # cleanup file name - if path is relative, normalize it
   #    - /foo/bar/baz.txt stays as /foo/bar/baz.txt
   #    - foo/bar/baz.txt  becomes ./foo/bar/baz.txt
   #    - baz.txt          stays as baz.txt
   if ( !length $root ) { # if no root, path will be modified...

      if ( !length $path ) { # if no path, path normalized

         $path = '.' . SL;
      }
      else { # otherwise path normalized at end

         $path .= SL;
      }
   }

   # final clean filename assembled
   $clean_name = $root . $path . $file;

   # create path preceding file if path doesn't exist
   $this->make_dir(
      $root . $path,
      exists $in->{'dbitmask'}
         ? _bitmaskify( $in->{'dbitmask'} )
         : 0777
   ) unless -e $root . $path;

   # sanity checks based on requested mode
   if (
         $mode eq 'write'     ||
         $mode eq 'append'    ||
         $mode eq 'rwcreate'  ||
         $mode eq 'rwclobber' ||
         $mode eq 'rwappend'
   ) {
      # Check whether or not we have permission to open and perform writes
      # on this file.

      if ( -e $clean_name ) {

         return $this->_throw(
            'cant fwrite',
            {
               filename => $clean_name,
               dirname  => $root . $path,
               opts     => $opts,
            }
         ) unless -w $clean_name;
      }
      else {
         # If file doesn't exist and the path isn't writable, the error is
         # one of unallowed creation.
         return $this->_throw(
            'cant fcreate',
            {
               filename => $clean_name,
               dirname  => $root . $path,
               opts     => $opts,
            }
         ) unless -w $root . $path;
      }
   }
   elsif ( $mode eq 'read' || $mode eq 'rwupdate' ) {
      # Check whether or not we have permission to open and perform reads
      # on this file, starting with file's housing directory.
      return $this->_throw(
         'cant dread',
         {
            filename => $clean_name,
            dirname  => $root . $path,
            opts     => $opts,
         }
      ) unless -r $path;

      # Seems obvious, but we can't read non-existent files
      return $this->_throw(
         'cant fread not found',
         {
            filename => $clean_name,
            dirname  => $root . $path,
            opts     => $opts,
         }
      ) unless -e $clean_name;

      # Check the readability of the file itself
      return $this->_throw(
         'cant fread',
         {
            filename => $clean_name,
            dirname  => $root . $path,
            opts     => $opts,
         }
      ) unless -r $clean_name;
   }
   else {
      return $this->_throw(
         'no input',
         {
            meth    => 'open_handle',
            missing => q{a valid IO mode. (eg- 'read', 'write'...)},
            opts    => $opts,
         }
      );
   }
   # input validation sequence finished

   # we need a unique filehandle
   do { $fh = int(rand(time)) . $$; $fh = eval('*' . 'OPEN_TO_FH' . $fh) }
   while ( fileno $fh );

   if ( $$opts{'--no-lock'} || !$USE_FLOCK ) {
      if (
         !exists $opts->{'--use-sysopen'} &&
         !defined $opts->{'--use-sysopen'}
      ) { # perl open
         # get open mode
         $mode = $$MODES{'popen'}{ $mode };

         open $fh, $mode . $clean_name or
            return $this->_throw(
               'bad open',
               {
                  filename  => $clean_name,
                  mode      => $mode,
                  exception => $!,
                  cmd       => $mode . $clean_name,
                  opts      => $opts,
               }
            );
      }
      else { # sysopen
         # get open mode
         $mode = $$MODES{'sysopen'}{ $mode };

         sysopen( $fh, $clean_name, eval( $$MODES{'sysopen'}{ $mode } ) ) or
            return $this->_throw(
               'bad open',
               {
                  filename  => $clean_name,
                  mode      => $mode,
                  exception => $!,
                  cmd       => qq{$clean_name, $$MODES{'sysopen'}{ $mode }},
                  opts      => $opts,
               }
            );
      }
   }
   else {
      if (
         !exists $opts->{'--use-sysopen'} &&
         !defined $opts->{'--use-sysopen'}
      ) { # perl open
         # open read-only first to safely check if we can get a lock.
         if ( -e $clean_name ) {

            open $fh, '<' . $clean_name or
               return $this->_throw(
                  'bad open',
                  {
                     filename  => $clean_name,
                     mode      => 'read',
                     exception => $!,
                     cmd       => $mode . $clean_name,
                     opts      => $opts,
                  }
               );

            # lock file before I/O on platforms that support it
            my $lockstat = $this->_seize( $clean_name, $fh );

            return $lockstat unless $lockstat;

            if ( $mode ne 'read' ) {

               open $fh, $$MODES{'popen'}{ $mode } . $clean_name or
                  return $this->_throw(
                     'bad open',
                     {
                        exception => $!,
                        filename  => $clean_name,
                        mode      => $mode,
                        opts      => $opts,
                        cmd       => $$MODES{'popen'}{ $mode } . $clean_name,
                     }
                  );
            }
         }
         else {
            open $fh, $$MODES{'popen'}{ $mode } . $clean_name or
               return $this->_throw(
                  'bad open',
                  {
                     exception => $!,
                     filename  => $clean_name,
                     mode      => $mode,
                     opts      => $opts,
                     cmd       => $$MODES{'popen'}{ $mode } . $clean_name,
                  }
               );

            # lock file before I/O on platforms that support it
            my $lockstat = $this->_seize( $clean_name, $fh );

            return $lockstat unless $lockstat;
         }
      }
      else { # sysopen
         # open read-only first to safely check if we can get a lock.
         if ( -e $clean_name ) {

            open $fh, '<' . $clean_name or
               return $this->_throw(
                  'bad open',
                  {
                     filename  => $clean_name,
                     mode      => 'read',
                     exception => $!,
                     cmd       => $mode . $clean_name,
                     opts      => $opts,
                  }
               );

            # lock file before I/O on platforms that support it
            my $lockstat = $this->_seize( $clean_name, $fh );

            return $lockstat unless $lockstat;

            sysopen( $fh, $clean_name, eval( $$MODES{'sysopen'}{ $mode } ) )
               or return $this->_throw(
                  'bad open',
                  {
                     filename  => $clean_name,
                     mode      => $mode,
                     opts      => $opts,
                     exception => $!,
                     cmd       => qq{$clean_name, $$MODES{'sysopen'}{ $mode }},
                  }
               );
         }
         else { # only non-existent files get bitmask arguments
            sysopen(
               $fh,
               $clean_name,
               eval( $$MODES{'sysopen'}{ $mode } ),
               $bitmask
            ) or return $this->_throw(
               'bad open',
               {
                  filename  => $clean_name,
                  mode      => $mode,
                  opts      => $opts,
                  exception => $!,
                  cmd => qq{$clean_name, $$MODES{'sysopen'}{$mode}, $bitmask},
               }
            );

            # lock file before I/O on platforms that support it
            my $lockstat = $this->_seize( $clean_name, $fh );

            return $lockstat unless $lockstat;
         }
      }
   }

   # call binmode on the filehandle if it was requested
   CORE::binmode( $fh ) if $in->{'binmode'} || $opts->{'--binmode'};

   # return file handle reference to the caller
   return $fh;
}


# --------------------------------------------------------
# File::Util::unlock_open_handle()
# --------------------------------------------------------
sub unlock_open_handle {
   my( $this, $fh ) = @_;

   return 1 if !$USE_FLOCK;

   my $ref_type = ref \$fh || '';

   return $this->_throw( 'not a filehandle' => { argtype => $ref_type } )
      unless $fh && $ref_type eq 'GLOB';

   return flock( $fh, &Fcntl::LOCK_UN ) if $CAN_FLOCK;

   return 1;
}


# --------------------------------------------------------
# File::Util::return_path()
# --------------------------------------------------------
sub return_path { my $f = _myargs( @_ ); $f =~ s/(^.*)$DIRSPLIT.*/$1/o; $f }


# --------------------------------------------------------
# File::Util::size()
# --------------------------------------------------------
sub size { my $f = _myargs( @_ ); $f ||= ''; return undef unless -e $f; -s $f }


# --------------------------------------------------------
# File::Util::trunc()
# --------------------------------------------------------
sub trunc { $_[0]->write_file('mode' => 'trunc', 'file' => $_[1]) }


# --------------------------------------------------------
# File::Util::use_flock()
# --------------------------------------------------------
sub use_flock {
   my $arg = _myargs( @_ );

   if (defined($arg)) { $USE_FLOCK = $arg }

   $USE_FLOCK
}


# --------------------------------------------------------
# File::Util::_myargs()
# --------------------------------------------------------
sub _myargs {

   shift @_ if UNIVERSAL::isa( $_[0], ( caller(0) )[0] );

   return wantarray ? @_ : $_[0]
}


# --------------------------------------------------------
# File::Util::_remove_opts()
# --------------------------------------------------------
sub _remove_opts {

   my $args = _myargs( @_ );

   return undef unless UNIVERSAL::isa( $args, 'ARRAY' );

   my @triage = @$args; @$args = ();
   my $opts   = {};

   while ( @triage ) {

      my $arg = shift @triage;

      # if an argument is '', 0, or undef, it's obviously not an --option ...
      push @$args, $arg and next unless $arg; # ...so give it back to the @$args

      # hmmm.  looks like an "--option" argument, if:
      if ( substr( $arg, 0, 2) eq '--' ) {

         # it's either a bare "--option", or it's an "--option=value" pair
         my ( $opt, $value ) = split /=/o, $arg;

         $opts->{ $opt } = defined $value ? $value : $arg
      }
      else {

         # but if it's not an "--option" type arg, give it back to the @$args
         push @$args, $arg;
      }
   }

   return $opts;
}


# --------------------------------------------------------
# File::Util::_names_values()
# --------------------------------------------------------
sub _names_values {

   my @copy    = _myargs( @_ );
   my $nvpairs = {};
   my $i       = 0;

   while ( @copy ) {

      my ( $name, $val ) = splice @copy, 0, 2;

      if ( defined $name ) {

         $nvpairs->{ $name } = defined $val ? $val : '';
      }
      else {

         ++$i;

         $nvpairs->{
            qq[un-named key no. $i]
         } = defined $val ? $val : '';
      }
   }

   return $nvpairs;
}


# --------------------------------------------------------
# File::Util::DESTROY(), end File::Util class definition
# --------------------------------------------------------
sub DESTROY {}
1;

__END__

# --------------------------------------------------------
# File::Util::_throw
# --------------------------------------------------------
sub _throw {
   my($this) = shift(@_); my($opts) = $this->_remove_opts( \@_ );
   my(%fatal_rules) = ();

   # fatalality-handling rules passed to the failing caller trump the
   # rules set up in the attributes of the object; the mechanism below
   # also allows for the implicit handling of '--fatals-are-fatal'
   map { $fatal_rules{ $_ } = $_ }
   grep(/^--fatals/o, values %$opts);

   unless (scalar keys %fatal_rules) {
      map { $fatal_rules{ $_ } = $_ }
      grep(/^--fatals/o, keys %{ $this->{'opts'} })
   }

   return(0) if $fatal_rules{'--fatals-as-status'};

   $this->{'expt'}||={};

   unless (UNIVERSAL::isa($this->{'expt'},'Exception::Handler')) {

      require Exception::Handler;

      $this->{'expt'} = Exception::Handler->new();
   }

   my $error = ''; my $in = {};

   $in->{_pak} = __PACKAGE__;

   if ( scalar @_ == 1 ) {

      $error = $_[0] ? 'plain error' : 'empty error';

      $in->{error} = $_[0] || 'error undefined';

      goto PLAIN_ERRORS;
   }
   else {

      $error = shift @_ || 'empty error';

      if ( $error eq 'plain error' ) {

         $in->{error} = shift @_;

         $in->{error} = 'error undefined'
            unless defined $in->{error} && length $in->{error};

         goto PLAIN_ERRORS;
      }
   }

   $in = shift @_ || {};

   $in->{'_pak'} = __PACKAGE__;

   map { $_ = defined($_) ? $_ : 'undefined value' } keys(%$in);

   PLAIN_ERRORS:

   my($bad_news) =
      CORE::eval
         (
            q{<<__ERRORBLOCK__}
            . &NL . &_errors($error)
            . &NL . q{__ERRORBLOCK__}
         );

## for debugging only
#   if ($@) { return $this->{'expt'}->trace($@) }

   if ($fatal_rules{'--fatals-as-warning'}) {

      warn($this->{'expt'}->trace(($@ || $bad_news))) and return
   }
   elsif ( $fatal_rules{'--fatals-as-errmsg'} || $opts->{'--return'}) {

      return($this->{'expt'}->trace(($@ || $bad_news)))
   }

   foreach (keys(%{$in})) {

      next if ($_ eq 'opts');

      $bad_news .= qq[ARG   $_ = $in->{$_}] . $NL;
   }

   if ($in->{'opts'}) {

      foreach (keys(%{$$in{'opts'}})) {

         $_ = (defined($_)) ? $_  : 'empty value';

         $bad_news .= qq[OPT   $_] . $NL;
      }
   }

   warn($this->{'expt'}->trace(($@ || $bad_news))) if ($opts->{'--warn-also'});

   $this->{'expt'}->fail(($@ || $bad_news));

   '';
}


#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#
# ERROR MESSAGES
#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#%#
sub _errors {
   use vars qw($EBL $EBR);
   ($EBL,$EBR) = ('<<', '>>');
   my($error_thrown) = shift(@_);

   # begin long table of helpful diag error messages
   my(%error_msg_table) = (
# NO SUCH FILE
'no such file' => <<'__bad_open__',
$in->{'_pak'} can't open
   $EBL$in->{'filename'}$EBR
because it is inaccessible or does not exist.

Origin:     This is *most likely* due to human error.
Solution:   Cannot diagnose.  A human must investigate the problem.
__bad_open__


# BAD FLOCK RULE POLICY
'bad flock rules' => <<'__bad_lockrules__',
Invalid file locking policy can not be implemented.  $in->{'_pak'}::flock_rules
does not accept one or more of the policy keywords passed to this method.

   Invalid Policy specified: $EBL@{[
   join ' ', map { '[undef]' unless defined $_ } @{ $in->{'all'} } ]}$EBR

   flock_rules policy in effect before invalid policy failed:
      $EBL@ONLOCKFAIL$EBR

   Proper flock_rules policy includes one or more of the following recognized
   keywords specified in order of precedence:
      BLOCK         waits to try getting an exclusive lock
      FAIL          dies with stack trace
      WARN          warn()s about the error with a stack trace
      IGNORE        ignores the failure to get an exclusive lock
      UNDEF         returns undef
      ZERO          returns 0

Origin:     This is a human error.
Solution:   A human must fix the programming flaw.
__bad_lockrules__


# CAN'T READ FILE - PERMISSIONS
'cant fread' => <<'__cant_read__',
Permissions conflict.  $in->{'_pak'} can't read the contents of this file:
   $EBL$in->{'filename'}$EBR

Due to insufficient permissions, the system has denied Perl the right to
view the contents of this file.  It has a bitmask of: (octal number)
   $EBL@{[ sprintf('%04o',(stat($in->{'filename'}))[2] & 0777) ]}$EBR

   The directory housing it has a bitmask of: (octal number)
      $EBL@{[ sprintf('%04o',(stat($in->{'dirname'}))[2] & 0777) ]}$EBR

   Current flock_rules policy:
      $EBL@ONLOCKFAIL$EBR

Origin:     This is *most likely* due to human error.  External system errors
            can occur however, but this doesn't have to do with $in->{'_pak'}.
Solution:   A human must fix the conflict by adjusting the file permissions
            of directories where a program asks $in->{'_pak'} to perform I/O.
            Try using Perl's chmod command, or the native system chmod()
            command from a shell.
__cant_read__


# CAN'T READ FILE - NOT EXISTENT
'cant fread not found' => <<'__cant_read__',
File not found.  $in->{'_pak'} can't read the contents of this file:
   $EBL$in->{'filename'}$EBR

The file specified does not exist.  It can not be opened or read from.

Origin:     This is *most likely* due to human error.  External system errors
            can occur however, but this doesn't have to do with $in->{'_pak'}.
Solution:   A human must investigate why the application tried to open a
            non-existent file, and/or why the file is expected to exist and
            is not found.
__cant_read__


# CAN'T CREATE FILE - PERMISSIONS
'cant fcreate' => <<'__cant_write__',
Permissions conflict.  $in->{'_pak'} can't create this file:
   $EBL$in->{'filename'}$EBR

$in->{'_pak'} can't create this file because the system has denied Perl
the right to create files in the parent directory.

   The -e test returns $EBL@{[-e $in->{'dirname'} ]}$EBR for the directory.
   The -r test returns $EBL@{[-r $in->{'dirname'} ]}$EBR for the directory.
   The -R test returns $EBL@{[-R $in->{'dirname'} ]}$EBR for the directory.
   The -w test returns $EBL@{[-w $in->{'dirname'} ]}$EBR for the directory
   The -W test returns $EBL@{[-w $in->{'dirname'} ]}$EBR for the directory

   Parent directory: (path may be relative and/or redundant)
      $EBL$in->{'dirname'}$EBR

   Parent directory has a bitmask of: (octal number)
      $EBL@{[ sprintf('%04o',(stat($in->{'dirname'}))[2] & 0777) ]}$EBR

   Current flock_rules policy:
      $EBL@ONLOCKFAIL$EBR

Origin:     This is *most likely* due to human error.  External system errors
            can occur however, but this doesn't have to do with $in->{'_pak'}.
Solution:   A human must fix the conflict by adjusting the file permissions
            of directories where a program asks $in->{'_pak'} to perform I/O.
            Try using Perl's chmod command, or the native system chmod()
            command from a shell.
__cant_write__


# CAN'T WRITE TO FILE - EXISTS AS DIRECTORY
'cant write_file on a dir' => <<'__bad_writefile__',
$in->{'_pak'} can't write to the specified file because it already exists
as a directory.
   $EBL$in->{'filename'}$EBR

Origin:     This is a human error.
Solution:   Resolve naming issue between the existent directory and the file
            you wish to create/write/append.
__bad_writefile__


# CAN'T TOUCH A FILE - EXISTS AS DIRECTORY
'cant touch on a dir' => <<'__bad_touchfile__',
$in->{'_pak'} can't touch the specified file because it already exists
as a directory.
   $EBL$in->{'filename'}$EBR

Origin:     This is a human error.
Solution:   Resolve naming issue between the existent directory and the file
            you wish to touch.
__bad_touchfile__


# CAN'T WRITE TO FILE
'cant fwrite' => <<'__cant_write__',
Permissions conflict.  $in->{'_pak'} can't write to this file:
   $EBL$in->{'filename'}$EBR

Due to insufficient permissions, the system has denied Perl the right
to modify the contents of this file.  It has a bitmask of: (octal number)
   $EBL@{[ sprintf('%04o',(stat($in->{'filename'}))[2] & 0777) ]}$EBR

   Parent directory has a bitmask of: (octal number)
      $EBL@{[ sprintf('%04o',(stat($in->{'dirname'}))[2] & 0777) ]}$EBR

   Current flock_rules policy:
      $EBL@ONLOCKFAIL$EBR

Origin:     This is *most likely* due to human error.  External system errors
            can occur however, but this doesn't have to do with $in->{'_pak'}.
Solution:   A human must fix the conflict by adjusting the file permissions
            of directories where a program asks $in->{'_pak'} to perform I/O.
            Try using Perl's chmod command, or the native system chmod()
            command from a shell.
__cant_write__


# BAD OPEN MODE - PERL
'bad openmode popen' => <<'__bad_openmode__',
Illegal mode specified for file open.  $in->{'_pak'} can't open this file:
   $EBL$in->{'filename'}$EBR

When calling $in->{'_pak'}::$in->{'meth'}() you specified that the file
opened in this I/O operation should be opened in $EBL$in->{'badmode'}$EBR
but that is not a recognized open mode.

Supported open modes for $in->{'_pak'}::write_file() are:
   write       - open the file in write mode, creating it if necessary, and
                 overwriting any existing contents of the file.
   append      - open the file in append mode

Supported open modes for $in->{'_pak'}::open_handle() are the same as above, but
also include the following:
   read        - open the file in read-only mode

   (and if the --use-sysopen flag is used):
   rwcreate    - open the file for update (read+write), creating it if necessary
   rwupdate    - open the file for update (read+write). Causes fatal error if
                 the file doesn't yet exist
   rwappend    - open the file for update in append mode
   rwclobber   - open the file for update, erasing all contents (truncating,
                 i.e- "clobbering" the file first)

Origin:     This is a human error.
Solution:   A human must fix the programming flaw by specifying the desired
            open mode from the list above.
__bad_openmode__


# BAD OPEN MODE - SYSOPEN
'bad openmode sysopen' => <<'__bad_openmode__',
Illegal mode specified for file sysopen.  $in->{'_pak'} can't sysopen this file:
   $EBL$in->{'filename'}$EBR

When calling $in->{'_pak'}::$in->{'meth'}() you specified that the file
opened in this I/O operation should be sysopen()'d in $EBL$in->{'badmode'}$EBR
but that is not a recognized open mode.

Supported open modes for $in->{'_pak'}::write_file() are:
   write       - open the file in write mode, creating it if necessary, and
                 overwriting any existing contents of the file.
   append      - open the file in append mode

Supported open modes for $in->{'_pak'}::open_handle() are the same as above, but
also include the following:
   read        - open the file in read-only mode

   (and if the --use-sysopen flag is used, as the application JUST did):
   rwcreate    - open the file for update (read+write), creating it if necessary
   rwupdate    - open the file for update (read+write). Causes fatal error if
                 the file doesn't yet exist
   rwappend    - open the file for update in append mode
   rwclobber   - open the file for update, erasing all contents (truncating,
                 i.e- "clobbering" the file first)

Origin:     This is a human error.
Solution:   A human must fix the programming flaw by specifying the desired
            sysopen mode from the list above.
__bad_openmode__


# CAN'T LIST DIRECTORY
'cant dread' => <<'__cant_read__',
Permissions conflict.  $in->{'_pak'} can't list the contents of this directory:
   $EBL$in->{'dirname'}$EBR

Due to insufficient permissions, the system has denied Perl the right to
view the contents of this directory.  It has a bitmask of: (octal number)
   $EBL@{[ sprintf('%04o',(stat($in->{'dirname'}))[2] & 0777) ]}$EBR

Origin:     This is *most likely* due to human error.  External system errors
            can occur however, but this doesn't have to do with $in->{'_pak'}.
Solution:   A human must fix the conflict by adjusting the file permissions
            of directories where a program asks $in->{'_pak'} to perform I/O.
            Try using Perl's chmod command, or the native system chmod()
            command from a shell.
__cant_read__


# CAN'T CREATE DIRECTORY - PERMISSIONS
'cant dcreate' => <<'__cant_dcreate__',
Permissions conflict.  $in->{'_pak'} can't create:
   $EBL$in->{'dirname'}$EBR

   $in->{'_pak'} can't create this directory because the system has denied
   Perl the right to create files in the parent directory.

   Parent directory: (path may be relative and/or redundant)
      $EBL$in->{'parentd'}$EBR

   Parent directory has a bitmask of: (octal number)
      $EBL@{[ sprintf('%04o',(stat($in->{'parentd'}))[2] & 0777) ]}$EBR

Origin:     This is *most likely* due to human error.  External system errors
            can occur however, but this doesn't have to do with $in->{'_pak'}.
Solution:   A human must fix the conflict by adjusting the file permissions
            of directories where a program asks $in->{'_pak'} to perform I/O.
            Try using Perl's chmod command, or the native system chmod()
            command from a shell.
__cant_dcreate__


# CAN'T CREATE DIRECTORY - TARGET EXISTS
'make_dir target exists' => <<'__cant_dcreate__',
make_dir target already exists.
   $EBL$in->{'dirname'}$EBR

$in->{'_pak'} can't create the directory you specified because that
directory already exists, with filetype attributes of
@{[join(', ', @{ $in->{'filetype'} })]} and permissions
set to $EBL@{[ sprintf('%04o',(stat($in->{'dirname'}))[2] & 0777) ]}$EBR

Origin:     This is *most likely* due to human error.  The program has tried
            to make a directory where a directory already exists.
Solution:   Weaken the requirement somewhat by using the "--if-not-exists"
            flag when calling the make_dir object method.  This option
            will cause $in->{'_pak'} to ignore attempts to create directories
            that already exist, while still creating the ones that don't.
__cant_dcreate__


# CAN'T OPEN
'bad open' => <<'__bad_open__',
$in->{'_pak'} can't open this file for $EBL$in->{'mode'}$EBR:
   $EBL$in->{'filename'}$EBR

   The system returned this error:
      $EBL$in->{'exception'}$EBR

   $in->{'_pak'} used this directive in its attempt to open the file
      $EBL$in->{'cmd'}$EBR

   Current flock_rules policy:
      $EBL@ONLOCKFAIL$EBR

Origin:     This is *most likely* due to human error.
Solution:   Cannot diagnose.  A Human must investigate the problem.
__bad_open__


# BAD CLOSE
'bad close' => <<'__bad_close__',
$in->{'_pak'} couldn't close this file after $EBL$in->{'mode'}$EBR
   $EBL$in->{'filename'}$EBR

   The system returned this error:
      $EBL$in->{'exception'}$EBR

   Current flock_rules policy:
      $EBL@ONLOCKFAIL$EBR

Origin:     Could be either human _or_ system error.
Solution:   Cannot diagnose.  A Human must investigate the problem.
__bad_close__


# CAN'T TRUNCATE
'bad systrunc' => <<'__bad_systrunc__',
$in->{'_pak'} couldn't truncate() on $EBL$in->{'filename'}$EBR after having
successfully opened the file in write mode.

The system returned this error:
   $EBL$in->{'exception'}$EBR

Current flock_rules policy:
   $EBL@ONLOCKFAIL$EBR

This is most likely _not_ a human error, but has to do with your system's
support for the C truncate() function.
__bad_systrunc__


# CAN'T GET FLOCK AFTER BLOCKING
'bad flock' => <<'__bad_lock__',
$in->{'_pak'} can't get a lock on the file
   $EBL$in->{'filename'}$EBR

The system returned this error:
   $EBL$in->{'exception'}$EBR

Current flock_rules policy:
   $EBL@ONLOCKFAIL$EBR

Origin:     Could be either human _or_ system error.
Solution:   Investigate the reason why you can't get a lock on the file,
            it is usually because of improper programming which causes
            race conditions on one or more files.
__bad_lock__


# CAN'T OPEN ON A DIRECTORY
'called open on a dir' => <<'__bad_open__',
$in->{'_pak'} can't call open() on this file because it is a directory
   $EBL$in->{'filename'}$EBR

Origin:     This is a human error.
Solution:   Use $in->{'_pak'}::load_file() to load the contents of a file
            Use $in->{'_pak'}::list_dir() to list the contents of a directory
__bad_open__


# CAN'T OPENDIR ON A FILE
'called opendir on a file' => <<'__bad_open__',
$in->{'_pak'} can't opendir() on this file because it is not a directory.
   $EBL$in->{'filename'}$EBR

Use $in->{'_pak'}::load_file() to load the contents of a file
Use $in->{'_pak'}::list_dir() to list the contents of a directory

Origin:     This is a human error.
Solution:   Use $in->{'_pak'}::load_file() to load the contents of a file
            Use $in->{'_pak'}::list_dir() to list the contents of a directory
__bad_open__


# CAN'T MKDIR ON A FILE
'called mkdir on a file' => <<'__bad_open__',
$in->{'_pak'} can't auto-create a directory for this path name because it
already exists as a file.
   $EBL$in->{'filename'}$EBR

Origin:     This is a human error.
Solution:   Resolve naming issue between the existent file and the directory
            you wish to create.
__bad_open__


# BAD CALL TO File::Util::readlimit
'bad readlimit' => <<'__maxdives__',
Bad call to $in->{'_pak'}::readlimit().  This method can only be called with
a numeric value (bytes).  Non-integer numbers will be converted to integer
format if specified (numbers like 5.2), but don't do that, it's inefficient.

This operation aborted.

Origin:     This is a human error.
Solution:   A human must fix the programming flaw.
__maxdives__


# EXCEEDED READLIMIT
'readlimit exceeded' => <<'__readlimit__',
$in->{'_pak'} can't load file: $EBL$in->{'filename'}$EBR
into memory because its size exceeds the maximum file size allowed
for a read.

The size of this file is $EBL$in->{'size'}$EBR bytes.

Currently the read limit is set at $EBL$READLIMIT$EBR bytes.

Origin:     This is a human error.
Solution:   Consider setting the limit to a higher number of bytes.
__readlimit__


# BAD CALL TO File::Util::max_dives
'bad maxdives' => <<'__maxdives__',
Bad call to $in->{'_pak'}::max_dives().  This method can only be called with
a numeric value (bytes).  Non-integer numbers will be converted to integer
format if specified (numbers like 5.2), but don't do that, it's inefficient.

This operation aborted.

Origin:     This is a human error.
Solution:   A human must fix the programming flaw.
__maxdives__


# EXCEEDED MAXDIVES
'maxdives exceeded' => <<'__maxdives__',
Recursion limit reached at $EBL${\ scalar(
   (exists $in->{'maxdives'} && defined $in->{'maxdives'}) ?
   $in->{'maxdives'} : $MAXDIVES) }$EBR dives.  Maximum number of subdirectory dives is set to the value returned by
$in->{'_pak'}::max_dives().  Try manually setting the value to a higher number
before calling list_dir() with option --follow or --recurse (synonymous).  Do
so by calling $in->{'_pak'}::max_dives() with the numeric argument corresponding
to the maximum number of subdirectory dives you want to allow when traversing
directories recursively.

This operation aborted.

Origin:     This is a human error.
Solution:   Consider setting the limit to a higher number.
__maxdives__


# BAD OPENDIR
'bad opendir' => <<'__bad_opendir__',
$in->{'_pak'} can't opendir on directory:
   $EBL$in->{'dirname'}$EBR

The system returned this error:
   $EBL$in->{'exception'}$EBR

Origin:     Could be either human _or_ system error.
Solution:   Cannot diagnose.  A Human must investigate the problem.
__bad_opendir__


# BAD MAKEDIR
'bad make_dir' => <<'__bad_make_dir__',
$in->{'_pak'} had a problem with the system while attempting to create the
directory you specified with a bitmask of $EBL$in->{'bitmask'}$EBR

directory: $EBL$in->{'dirname'}$EBR

The system returned this error:
   $EBL$in->{'exception'}$EBR

Origin:     Could be either human _or_ system error.
Solution:   Cannot diagnose.  A Human must investigate the problem.
__bad_make_dir__


# BAD CHARS
'bad chars' => <<'__bad_chars__',
$in->{'_pak'} can't use this string for $EBL$in->{'purpose'}$EBR.
   $EBL$in->{'string'}$EBR
It contains illegal characters.

Illegal characters are:
   \\   (backslash)
   /   (forward slash)
   :   (colon)
   |   (pipe)
   *   (asterisk)
   ?   (question mark)
   "   (double quote)
   <   (less than)
   >   (greater than)
   \\t  (tab)
   \\ck (vertical tabulator)
   \\r  (newline CR)
   \\n  (newline LF)

Origin:     This is a human error.
Solution:   A human must remove the illegal characters from this string.
__bad_chars__


# NOT A VALID FILEHANDLE
'not a filehandle' => <<'__bad_handle__',
$in->{'_pak'} can't unlock file with an invalid file handle reference:
   $EBL$in->{'argtype'}$EBR is not a valid filehandle

Origin:     This is most likely a human error, although it is remotely possible
            that this message is the result of an internal error in the
            $in->{'_pak'} module, but this is not likely if you called
            $in->{'_pak'}'s internal ::_release() method directly on your own.
Solution:   A human must fix the programming flaw.  Alternatively, in the
            second listed scenario, the package maintainer must investigate the
            problem.  Please send a usenet post with this error message in its
            entirety to Tommy Butler <tommy\@atrixnet.com>, or to usenet group:
            $EBL news://comp.lang.perl.modules $EBR
__bad_handle__


# BAD CALL TO METHOD FOO
'no input' => <<'__no_input__',
$in->{'_pak'} can't honor your call to $EBL$in->{'_pak'}::$in->{'meth'}()$EBR
because you didn't provide $EBL@{[$in->{'missing'}||'the required input']}$EBR

Origin:     This is a human error.
Solution:   A human must fix the programming flaw.
__no_input__


# PLAIN ERROR TYPE
'plain error' => <<'__plain_error__',
$in->{_pak} failed with the following message:
${\ scalar ($_[0] || ((exists $in->{'error'} && defined $in->{'error'}) ?
   $in->{'error'} : '[error unspecified]')) }
__plain_error__


# INVALID ERROR TYPE
'unknown error message' => <<'__foobar_input__',
$in->{'_pak'} failed with an invalid error-type designation.

Origin:     This is a bug!  Please inform Tommy Butler <tommy\@atrixnet.com>
Solution:   A human must fix the programming flaw.
__foobar_input__


# EMPTY ERROR TYPE
'empty error' => <<'__no_input__',
$in->{'_pak'} failed with an empty error-type designation.

Origin:     This is a human error.
Solution:   A human must fix the programming flaw.
__no_input__

   ); # end of error message table

   exists $error_msg_table{ $error_thrown }
   ? $error_msg_table{ $error_thrown }
   : $error_msg_table{'unknown error message'}
}

