#!/usr/bin/perl -w
use strict;

package Futils;
# use Handy::Dandy;
@Futils::ISA      = qw( Handy::Dandy Exporter );
@Futils::EXPORT_OK= qw( can_flock newline SL n );
$Futils::VERSION  = 2.06;                          # 8/6/2002, 5:40:21 PM
$Futils::NAME     = __PACKAGE__;
$Futils::started  = time();

=pod

   AUTHOR
        -Tommy Butler, professional contractor and open source proponent

         Atrixnet™, for Internet Business Software®
            http://atrixnet.com
            6711 Forest Park Dr
            Dallas, TX
                 76001

   COPYRIGHT
         Copyright Tommy Butler. All rights reserved

   LISCENCE
         This software is free, and you may use and distribute it under the
         GNU GPL liscence.  If you modify the code for your own purposes
         please acknowledge its original author.

   BUGS
      Please report any of the following to me
         - bugs
         - interface inconsistencies
         - suggestions
         - comments
         - complaints
         - smart remarks

=cut

BEGIN {

   require Config;

   # start by figuring out the os we're running under.  Some systems support
   # the $^O variable. If not available then require() the Config library
   unless ($Futils::OS = $^O) {

      # I am so sick of the freakin 'used once' warning! Hence...
      $Futils::OS = eval(q[$Config::Config{'osname'}]);
   }
   if ($Futils::OS=~/darwin/i) {

      $Futils::OS = 'UNIX';
   }
   elsif ($Futils::OS=~/cygwin/i) {

      $Futils::OS = 'CYGWIN';
   }
   elsif ($Futils::OS=~/Win/i) {

      $Futils::OS = 'WINDOWS';
   }
   elsif ($Futils::OS=~/vms/i) {

      $Futils::OS = 'VMS';
   }
   elsif ($Futils::OS=~/bsdos/i) {

      $Futils::OS = 'UNIX';
   }
   elsif ($Futils::OS=~/dos/i) {

      $Futils::OS = 'DOS';
   }
   elsif ($Futils::OS=~/^MacOS$/i) {

      $Futils::OS = 'MACINTOSH';
   }
   elsif ($Futils::OS=~/epoc/) {

      $Futils::OS = 'EPOC';
   }
   elsif ($Futils::OS=~/os2/i) {

      $Futils::OS = 'OS2';
   }
   else {

      $Futils::OS = 'UNIX';
   }

   # Some OS logic.  Binary mode enabled on DOS, NT and VMS
   $Futils::needs_binmode = 0;
   $Futils::needs_binmode = $Futils::OS=~/^(WINDOWS|DOS|OS2|MSWin)/o;

   $Futils::EBCDIC = qq[\t] ne qq[\011];

   if ($Futils::OS eq 'VMS') { $Futils::n = eval(q[chr(10)]) }
   elsif ($Futils::EBCDIC) { $Futils::n = eval(q[chr(13).chr(10)]) }
   else { $Futils::n = qq[\015\012] }

   # The path separator is a slash, backslash or semicolon, depending
   # on the paltform.
   $Futils::SL = {};
   $Futils::SL =
      {
         'DOS'       => '\\',
         'EPOC'      => '/',
         'MACINTOSH' => ':',
         'OS2'       => '\\',
         'UNIX'      => '/',
         'CYGWIN'    => '/',
         'VMS'       => '/',
         'WINDOWS'   => '\\',
      }->{$Futils::OS};

   # When all else fails...
   $Futils::SL ||= '/';

   # set readlimit to a default of 10 megabytes
   $Futils::readlimit   = 10000000;

   # maximum allowed directory depth for a recursive call to list_dir
   $Futils::maxdepth    = 500;

   # a global recursion iterator
   $Futils::recursed    = 0;

   # trail-ing directory separator
   $Futils::trailer     = qr/(?:$Futils::SL$)|(?:\/$)|(?:\\$)|(?:\:$)/;

   # directory split
   $Futils::dirsplit    = quotemeta($Futils::SL);
   $Futils::dirsplit    = qr/$Futils::dirsplit|\\|\/|\:/;

   # allow empty writes
   $Futils::empty_writes= 0;

=pod

   OPTIONS ON I/O RACE CONDITION POLICY
      set $Futils::onflockfail to any of the following strings:

         ex- @Futils::onflockfail = qw( wait fail );

     --fatal         fails with stack trace
     --fail          same as above
     --warn          warns() about the error with a stack trace
     --ignore        ignores the failure to get an exclusive lock
     --undef         returns undef
     --0             returns 0
   * --wait          waits to try getting an exclusive lock
   * --block         same as above

   * used in tandem with another option.
     you must specify another option to
     fall back on if blocking should fail.
     otherwise Futils will throw a fatal
     error and dump a stack trace before
     exiting the process with a 0 status

=cut

   @Futils::onflockfail = qw( --block --fail );

   # use file locking
   $Futils::use_flock = 1;

   # characters not allowed in filenames (sorry, no spaces)
   $Futils::illegal_filename_chrs =
      qr/
         (?sx)
         $Futils::SL|
         \\|
         \/|
         \:|
         \ |
         \||
         \*|
         \?|
         \"|
         \<|
         \>|
         \t|
         \n|
         \r
      /;

   $Futils::canhackit = 0;
   $Futils::canhackit = 1 unless ($] < 5.006001);

   {
      # can your perl flock()

      $Futils::defineflock  =
         $Config::Config{'d_flock'}
            ||
         $Config::Config{'d_lockf'}
            ||
         $Config::Config{'d_fcntl_can_lock'}
            ||0;

      $Futils::hasflock = 1 if (eval(<<__canflock__));
flock(STDOUT, Fcntl::LOCK_EX() | Fcntl::LOCK_NB());
flock(STDOUT, Fcntl::LOCK_UN());
__canflock__

      $Futils::hasflock = 1 if (!$@);

      $Futils::hasflock||=0; $Futils::defineflock||=0;
   }

   use Fcntl qw( ); # keep your dad-blasted crap in your own namespace!

   use vars qw( $ebl $ebr $n ); $ebl = '»'; $ebr = '«'; $n = $Futils::n;

   ($ebl,$ebr) = ('~~>','<~~') if ($Futils::OS eq 'WINDOWS')

} # end BEGIN-time loaded constants

$Futils::modes->{'popen'} =
   {
      'write'  => '>',
      'trunc'  => '>',
      'append' => '>>',
      'read'   => '<',
   };

$Futils::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()',
   };

# use exception handler library
# use expt_handler;

# --------------------------------------------------------
# Constructor
# --------------------------------------------------------
sub new {

   my($class) = shift(@_); $class = __PACKAGE__; # yeah, yeah --no hacking ;O)
   my($this)  = {};

   # bless object ref into the class' namespace
   bless($this, $class);

   # get input in hash context, no warnings
   my($opts)   = $this->shave_opts(\@_);
   my($in)     = $this->coerce_array(@_);

   $Futils::use_flock = 0 if ($opts->{'--no-flock'});

   # set up class attributes
   $this->{'name'}      = $Futils::NAME;
   $this->{'n'}         = $Futils::n;
   $this->{'SL'}        = $Futils::SL;
   $this->{'opts'}      = $opts;
   $this->{'expt'}      = expt_handler->new();

   $Futils::readlimit   = $in->{'readlimit'} if (defined($in->{'readlimit'}));
   $this->{'hasflock'}  = $Futils::hasflock;
   $this->{'object'}    = $this;

   # return object reference
   return($this);
}


# Futils::------------------------------------------------
#   newline() can_flock() n() SL()
# --------------------------------------------------------
sub can_flock { $Futils::hasflock }
sub   newline { $Futils::n }
sub        SL { $Futils::SL }
sub         n { $Futils::n }


# --------------------------------------------------------
# Futils::list_dir()
# --------------------------------------------------------
sub list_dir {

   my($this)      = shift(@_);
   my($opts)      = $this->shave_opts(\@_);
   my($dir)       = shift(@_)||'.';
   my($path)      = $dir;
   my(@files)     = ();
   my(@dirs)      = ();
   my(@items)     = ();
   my($r)         = 0;

   # if the call to this method didn't include a directory name to open,
   # then complain about it
   $this->
      throw
         (
            'meth'      => 'list_dir',
            'missing'   => 'a directory name',
            'error'     => 'no input',
         )
            unless (length($dir) > 0);

   # if the call to this method included a non-existant directory then
   # complain about it
   $this->
      throw
         (
            'filename'  => $dir,
            'error'     => 'no such file',
         )
            unless (-e $dir);

   if ($opts->{'--recursing'}) { ++$Futils::recursed }
   else { $Futils::recursed = 0 }

   if ($Futils::recursed >= $Futils::maxdepth) {

      $this->{'expt'}->fail(<<__rbail__);

recursion limit reached.  Maximum recursive directory listings is set to
$Futils::maxdepth.  Try setting \$Futils::maxdepth to a higher number
before calling list_dir() with option '--follow' or '--recurse'

This operation aborted.

__rbail__

   }

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

   # whack off any trailing directory separator
   unless (length($dir) == 1)
   { $dir =~ s/$Futils::trailer//o; $path =~ s/$Futils::trailer//o; }

   # can't open a directory if the argument isn't a diretory file type
   $this->
      throw
         (
            'filename'  => $dir,
            'error'     => 'called opendir on a file',
         )
            unless (-d $dir);

   # localize filehandle that we're going to be using in this method
   local(*DIR);

   # open the directory for reading or fail with a diagnostic error message
   # if our attempt to open the directory was unsuccessful
   opendir(DIR, $dir)
      or
         $this->
            throw
               (
                  'dir'       => $dir,
                  'error'     => 'bad opendir',
                  'exception' => $!,
               );

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

   # assign the contents of the directory to this lexically scoped array
   # variable(memory for *that* variable will be freed when execution
   # leaves this method / sub
   if ($opts->{'--count-only'}) {

      my($i) = 0; my($o) = '';

      while ($o = readdir(DIR)) { ++$i unless (($o eq '.')||($o eq '..')) }

      return($i);
   }

   @files = readdir(DIR);

   # close the directory or send out a system warning with any diagnostics
   # about the error.  if all else fails, Perl will close the directory
   # for us when the top-level process has finished execution
   closedir(DIR)
      or
         $this->
            throw
               (
                  'dir'       => $dir,
                  'error'     => 'close dir',
                  'exception' => $!,
               );

   if ($opts->{'--no-fsdots'}) {

      my(@shadow) = @files;
      @files      = ();

      while (@shadow) {

         my($f) = shift(@shadow);

         push(@files,$f)
            unless
               (
                  $this->strip_path($f) eq '.'
                     or
                  $this->strip_path($f) eq '..'
               );
      }
   }

   foreach (@files) {

      my($i) = 0;

      my($listing) =
         ($opts->{'--with-paths'} or ($r==1))
            ? $path.$Futils::SL.$_
            : $_;

      if (-d $path.$Futils::SL.$_) {

         push(@dirs, $listing);
      }
      else {

         push(@items, $listing);
      }
   }

   if  (($r) and (not $opts->{'--override-follow'})) {

      my(@shadow) = @dirs;
      @dirs      = ();

      while (@shadow) {

         my($f) = shift(@shadow);

         push(@dirs,$f)
            unless
               (
                  $this->strip_path($f) eq '.'
                     or
                  $this->strip_path($f) eq '..'
               );
      }

      foreach (@dirs) {

         my(@lsts) =

            $this->
               list_dir
                  (
                     $_,
                     '--with-paths',
                     '--dirs-as-ref',
                     '--files-as-ref',
                     '--recursing',
                     '--no-fsdots',
                  );

         push(@dirs,@{$lsts[0]});
         push(@items,@{$lsts[1]});
      }
   }

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

      @dirs       = $this->dropdots(@dirs,'--save-dots');
      my($dots)   = shift(@dirs);
      @dirs       = map ( ($_.=$Futils::SL), @dirs );
      @dirs       = (@{$dots},@dirs);
   }

   my($reta) = [sort(@dirs)];
   my($retb) = [sort(@items)];

   $reta=[$reta]
      if
         (
            $opts->{'--dirs-as-ref'}
               ||
            $opts->{'--as-ref'}
         );

   $retb=[$retb]
      if
         (
            $opts->{'--files-as-ref'}
               ||
            $opts->{'--as-ref'}
         );

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

   return(@$reta,@$retb);
}


# --------------------------------------------------------
# Futils::list_dir_a()
# --------------------------------------------------------
sub list_dir_a {

   my($this)   = shift(@_);
   my($path)   = $_[0];
   my(@files)  = $this->list_dir(@_);
   my($SL)     = $Futils::SL;

   foreach (@files) {

      my($file)       = {};

      $file->{'name'} = $_;


      if (-d $path.$SL.$_) {

         unless
            (
               $file->{'name'} eq '..'
                  or
               $file->{'name'} eq '.'
            ) {

            $file->{'name'} = $file->{'name'}.$SL;
         }
      }

      $file->{'absname'}         = $path.$SL.$_;
      $file->{'size'}            = $this->fsize( $path.$SL.$_ );
      $file->{'created'}         = $this->created( $path.$SL.$_ );
      $file->{'last_mod'}        = $this->last_mod( $path.$SL.$_ );
      $file->{'last_access'}     = $this->last_access( $path.$SL.$_ );

      $_ = $file;
   }

   return(@files);
}


# --------------------------------------------------------
# Futils::dropdots()
# --------------------------------------------------------
sub dropdots {

   my($this)      = shift(@_);
   my(@out)       = ();
   my($opts)      = $this->shave_opts(\@_);
   my(@shadow)    = @_;
   my(@dots)      = ();
   my($gottadot)  = 0;

   while (@shadow) {

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

      my($thing) = shift(@shadow);

      if ($thing eq '.')  {++$gottadot;push(@dots,$thing);next}
      if ($thing eq '..') {++$gottadot;push(@dots,$thing);next}

      push(@out,$thing);
   }

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


# --------------------------------------------------------
# Futils::list_dir_wpaths()
# --------------------------------------------------------
sub list_dir_wpaths {

   my($this)   = shift(@_);
   my($path)   = $_[0]||'';
   my(@files)  = $this->list_dir(@_);

   foreach (@files) {

      $_ = $path.$Futils::SL.$_;
   }

   return(@files);
}


# --------------------------------------------------------
# Futils::print_dir()
# --------------------------------------------------------
sub print_dir {

   my($this)      = shift(@_);
   my($dir)       = shift(@_)||'';
   my($opts)      = $this->shave_opts(\@_);
   my($cls)       = 75;
   my($cap)       = q[+] . (q[-] x $cls) . q[+];
   my($toe)       = $cap;
   my(@f)         = ();
   my($msg)       = '';
   my($fdir)      = '';

   $msg  = qq[Directory listing for $dir];
   $msg .= '...' if (length($msg) > 70);
   $msg  = sprintf(' % 0.70s%s', $msg);

   # get list of files from Futils::list_dir()
   @f = $this->list_dir($dir,@{[values(%$opts)]});

   {
      # handle 'no-fancy' option
      if ($opts->{'--no-fancy'} or $opts->{'--raw'}) {

         # make a plain list of the directory
         foreach (@f) {$fdir .= $_ . $n}

         if (scalar(@f) == 0) {$fdir = 'This directory contains no items.'}

         return
            (
                 ($n x 2)
               . $fdir
               . ($n x 2)
            )
               if ($opts->{'--raw'});

         return
            (
                 ($n x 2)
               . ('-' x 75)
               . $n . $msg . $n
               . ('-' x 75)
               . ($n x 2)
               . $fdir
               . ($n x 2)
            );
      }
   }

   # make a pretty, formatted table of the directory listings
   foreach (@f) {

      $fdir .= sprintf('| %s',$_) . (' 'x(int(($cls-1)-length($_)))) . $n
   }

   $cap .=
      sprintf(qq[$n| %s], $msg)
      . ' ' x (int(($cls - 1) - length($msg)))
      . $n
      . $cap;

   $fdir = join($n, $cap, $fdir) . $toe;

   return(qq[$n$fdir$n$n]);
}


# --------------------------------------------------------
# Futils::load_dir()
# --------------------------------------------------------
sub load_dir {

   my($this)      = shift(@_);
   my($dir)       = shift(@_)||'';
   my($opts)      = $this->shave_opts(\@_);
   my(@files)     = ();
   my($dir_hash)  = {};
   my($dir_list)  = [];

   # if the call to this method didn't include a directory name to open,
   # then complain about it
   $this->
      throw
         (
            'meth'      => 'load_dir',
            'missing'   => 'a directory name',
            'error'     => 'no input',
         )
            unless (length($dir) > 0);

   # get list of files from Futils::list_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.$Futils::SL.$_ );
      }

      return($dir_hash);
   }
   else {

      foreach (@files) {

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

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

      return(@{$dir_list});
   }

   # return a reference to the hash containing all the filenames and contents
   return($dir_hash);
}


# --------------------------------------------------------
# Futils::file_type()
# --------------------------------------------------------
sub file_type {

   my($this)      = shift(@_);
   my($filename)  = shift(@_)||'';
   my($ret)       = '';

   return(q[$filename does not exist.  No such file or directory])
      if
         (not $this->fexists($filename));

   $ret .= 'plain'     if (-f $filename);
   $ret .= 'text'      if (-T $filename);
   $ret .= 'binary'    if (-B $filename);
   $ret .= 'directory' if (-d $filename);
   $ret .= 'symlink'   if (-l $filename);
   $ret .= 'pipe'      if (-p $filename);
   $ret .= 'socket'    if (-S $filename);
   $ret .= 'block'     if (-b $filename);
   $ret .= 'character' if (-c $filename);
   $ret .= 'tty'       if (-t $filename);

   return($ret || 'file type cannot be determined');

}


# --------------------------------------------------------
# Futils::make_dir()
# --------------------------------------------------------
sub make_dir {

   my($this,$dir,$bitmask) = @_;

   # if the call to this method didn't include a directory name to create,
   # then complain about it
   $this->
      throw
         (
            'meth'      => 'make_dir',
            'missing'   => 'a directory name',
            'error'     => 'no input',
         )
            unless (length($dir) > 0);

   # if prospective directory name contains 2+ dir separators in sequence then
   # this is a syntax error we need to whine about
   $this->
      throw
         (
            'error'     => 'bad chars',
            'string'    => $dir,
            'purpose'   => 'the name of a directory',
         )
            if ($dir =~ /(?o)$Futils::dirsplit{2,}/);

   $bitmask ||= 0777;

   if (length($bitmask) == 3) {$bitmask = '0'.$bitmask}

   $dir =~ s/\\$|\/$//o;

   my($split)        = quotemeta($Futils::SL);
   my(@dirs_in_path) = split(/$split/o,$dir);
   my(@substitute)   = @dirs_in_path;

   foreach (@dirs_in_path) {

      # if prospective directory name contains illegal chars then complain
      $this->
         throw
            (
               'error'     => 'bad chars',
               'string'    => $_,
               'purpose'   => 'the name of a directory',
            )
               if ($this->isbad($_))
   }

   my($depth) = 0;

   foreach (@substitute) {

      ++$depth;

      last if ($depth == scalar(@dirs_in_path));

      $dirs_in_path[$depth] ||= '.';

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

   my($i) = 0;

   foreach (@dirs_in_path) {

      my($dir) = $_;
      my($up)  = $dirs_in_path[$i-1] if ($i > 0);

      ++$i;

      unless ($this->fexists($dir) or -f ($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.
         $this->
            throw
               (
                  'filename'  => $dir,
                  'dirname'   => $up.$Futils::SL,
                  'error'     => 'cant dcreate',
               )
                  unless ($this->can_write($up));

         mkdir($dir, $bitmask)
            or
               $this->
                  throw
                     (
                        'error'     => 'bad make_dir',
                        'exception' => $!,
                        'dir'       => $dir,
                        'bitmask'   => $bitmask,
                     );
      }
   }

   return($dir);
}


# --------------------------------------------------------
# Futils::fexists()
# --------------------------------------------------------
sub fexists {

   my($this)     = shift(@_);
   my($filename) = shift(@_)||'';

   # if the file doesn't exist, send back a zero value
   return(-e $filename);
}


# --------------------------------------------------------
# Futils::fsize()
# --------------------------------------------------------
sub fsize {

   my($this)     = shift(@_);
   my($filename) = shift(@_)||'';

   # if the file doesn't exist, send back an error
   $this->
      throw
         (
            'filename'  => $filename,
            'error'     => 'no such file',
         )
            if (not (-e $filename));

   # return the size of $filename
   return(-s $filename);
}


# --------------------------------------------------------
# Futils::created()
# --------------------------------------------------------
sub created {

   my($this,$filename,$format) = @_;

   # if the file doesn't exist, send back an error
   $this->
      throw
         (
            'filename'  => $filename,
            'error'     => 'no such file',
         )
            if (not (-e $filename));

   # return the last modified time of $filename
   my($r) = $Futils::started - ((-M $filename) * 60 * 60 * 24);

   return($this->stamp($r,$format)) if (defined($format));

   return($r);
}


# --------------------------------------------------------
# Futils::last_mod()
# --------------------------------------------------------
sub last_mod {

   my($this,$filename,$format) = @_;

   # if the file doesn't exist, send back an error
   $this->
      throw
         (
            'filename'  => $filename,
            'error'     => 'no such file',
         )
            if (not (-e $filename));

   # return the last modified time of $filename
   my($r) = $Futils::started - ((-C $filename) * 60 * 60 * 24);

   return($this->stamp($r,$format)) if (defined($format));

   return($r);
}


# --------------------------------------------------------
# Futils::last_access()
# --------------------------------------------------------
sub last_access {

   my($this,$filename,$format) = @_;

   # if the file doesn't exist, send back an error
   $this->
      throw
         (
            'filename'  => $filename,
            'error'     => 'no such file',
         )
            if (not (-e $filename));

   # return the last accessed time of $filename
   my($r) = $Futils::started - ((-A $filename) * 60 * 60 * 24);

   return($this->stamp($r,$format)) if (defined($format));

   return($r);
}
# --------------------------------------------------------
# Futils::can_read()  Futils::can_write()
# --------------------------------------------------------
sub  can_read { -r $_[1] }
sub can_write { -w $_[1] }


# --------------------------------------------------------
# Futils::line_count()
# --------------------------------------------------------
sub line_count {

   my($this,$filename) = @_;
   my($buffer) = '';
   my($lines)  = 0;
   my($cmd)    = '<'.$filename;

   local(*LINES);

   open(LINES, $filename)
      or
         $this->
            throw
               (
                  'error'     => 'bad open',
                  'filename'  => $filename,
                  'mode'      => 'read',
                  'exception' => $!,
                  'cmd'       => $cmd,
               );

   while (sysread(LINES, $buffer, 4096)) {

      $lines   += ($buffer =~ tr/\n//);
      $buffer  = '';
   }

   close(LINES);

   return($lines);
}


# --------------------------------------------------------
# Futils::load_file()
# --------------------------------------------------------
sub load_file {

   my($this)      = shift(@_);
   my($opts)      = $this->shave_opts(\@_);
   my($in)        = $this->coerce_array(@_);
   my(@dirs)      = ();
   my($blocksize) = 1024; # 1.24 kb
   my($FH_passed) = 0;
   my($FH)        = undef;
   my($filename)  = '';
   my($path)      = '';
   my($content)   = '';
   my($FHstatus)  = '';
   my($mode)      = 'read';

   if (scalar(@_) == 1) {

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

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

      if (scalar(@dirs) > 0) {

         $filename = pop(@dirs);

         $path = join($Futils::SL, @dirs);
      }

      if (length($path) > 0) {

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

         $path = '.';
      }

      $this->
         throw
            (
               'meth'      => 'load_file',
               'missing'   => 'a file name or file handle reference',
               'error'     => 'no input',
            )
               if (length($path . $Futils::SL . $filename) == 0);
   }
   else {

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

      # did we get a filehandle?
      if (length($FH) > 0) {

         $FH_passed = 1;
      }
      else {

      $this->
         throw
            (
               'meth'      => 'load_file',
               'missing'   => 'a file name or file handle reference',
               'error'     => 'no input',
            );
      }
   }

   if ($FH_passed) {

      my($buffer)       = 0;
      my($bytes_read)   = 0;

      while (<$FH>) {

         if ($buffer < $Futils::readlimit) {

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

            $buffer += $bytes_read;
         }
         else {

            $this->
               throw
                  (
                     'filename'  => '<FH>',
                     'size'      => qq[[truncated at $bytes_read]],
                     'error'     => 'readlimit exceeded',
                  );
         }
      }

      # 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(/$this->{'n'}|\r|\n/o,$content)) if $opts->{'--as-list'};

      return($content);
   }

   # if the file doesn't exist, send back an error
   $this->
      throw
         (
            'filename'  => $path . $Futils::SL . $filename,
            'error'     => 'no such file',
         )
            if (not (-e $path . $Futils::SL . $filename));

   # 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
   $this->
      throw
         (
            'filename'  => $path . $Futils::SL.$filename,
            'dirname'   => $path . $Futils::SL,
            'error'     => 'cant dread',
         )
            unless ($this->can_read($path . $Futils::SL));

   # --> now check the readability of the file itself
   $this->
      throw
         (
            'filename'  => $path . $Futils::SL.$filename,
            'dirname'   => $path . $Futils::SL,
            'error'     => 'cant fread',
         )
            unless ($this->can_read($path . $Futils::SL . $filename));

   # if the file is a directory it will not be opened
   $this->
      throw
         (
            'filename'  => $path . $Futils::SL . $filename,
            'error'     => 'called open on a dir',
         )
            if
               (-d $path . $Futils::SL . $filename);

   $this->{'expt'}->fail( qq[
      $this->{'name'} can't open " $filename " for reading because
      it is a a block special file.] )
         if (-b $path . $Futils::SL . $filename);

   my($fsize) = $this->fsize($path . $Futils::SL . $filename);

   $this->
      throw
         (
            'filename'  => $path . $Futils::SL . $filename,
            'size'      => $fsize,
            'error'     => 'readlimit exceeded',
         )
            if
               ($fsize > $Futils::readlimit);

   # we need a unique filehandle
   $FH = int(rand(time)) . $$;
   $FH = eval('*' . 'LOAD_FILE' . $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($/,*LOAD_FILE);

   # 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) = '<' . $path . $Futils::SL . $filename;

   # lock file before I/O when possible
   if ($$opts{'--no-lock'} || $$this{'opts'}{'--no-lock'}) {

      # if you use the '--no-lock' option you are probably stupid
      open(LOAD_FILE, $cmd)
         or
            $this->
               throw
                  (
                     'filename'  => $path . $Futils::SL . $filename,
                     'mode'      => $mode,
                     'error'     => 'bad open',
                     'exception' => $!,
                     'cmd'       => $cmd,
                  );
   }
   else {

         open(LOAD_FILE, $cmd)
            or
               $this->
                  throw
                     (
                        'filename'  => $path . $Futils::SL . $filename,
                        'mode'      => $mode,
                        'error'     => 'bad open',
                        'exception' => $!,
                        'cmd'       => $cmd,
                     );

         $this->seize($path . $Futils::SL . $filename, *LOAD_FILE);
   }

   # call binmode on binary files for portability accross platforms such
   # as MS flavor OS family
   CORE::binmode(LOAD_FILE) if (-B $path . $Futils::SL . $filename);

   # 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 = <LOAD_FILE>;

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

      # if execution gets here, you used the '--no-lock' option, and you
      # are probably stupid
      close(LOAD_FILE)
         or
            $this->
               throw
                  (
                     'filename'  => $path . $Futils::SL . $filename,
                     'mode'      => $mode,
                     'error'     => 'bad close',
                     'exception' => $!,
                  );
   }
   else {

      # release shadow-ed locks on the file
      $this->release(*LOAD_FILE);

      close(LOAD_FILE)
         or
            $this->
               throw
                  (
                     'filename'  => $path . $Futils::SL . $filename,
                     'mode'      => $mode,
                     'error'     => 'bad close',
                     'exception' => $!,
                  );
   }

   # 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(/$this->{'n'}|\r|\n/o,$content)) if $opts->{'--as-list'};

   return($content);
}


# --------------------------------------------------------
# Futils::open_to_FH()
# --------------------------------------------------------
sub open_to_FH {

   my($this)      = shift(@_);
   my($opts)      = $this->shave_opts(\@_);
   my($in)        = $this->coerce_array(@_);
   my($filename)  = $in->{'file'};
   my($mode)      = $in->{'mode'} || 'write';
   my(@dirs)      = ();
   my($path)      = '';
   my($cmd)       = '';

   $filename ||= $$in{'filename'};
   $filename ||= '';

   $path = $filename;

   # if the call to this method didn't include a filename to which the caller
   # wants us to write, then complain about it
   $this->
      throw
         (
            'meth'      => 'open_to_FH',
            'missing'   => 'a file name to create, read, write, or append',
            'error'     => 'no input',
         )
            unless (length($filename) > 0);

   # if prospective directory name contains 2+ dir separators in sequence then
   # this is a syntax error we need to whine about
   $this->
      throw
         (
            'error'     => 'bad chars',
            'string'    => $filename,
            'purpose'   => 'the name of a file or directory',
         )
            if ($filename =~ /(?o)$Futils::dirsplit{2,}/);

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

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

      $this->
         throw
            (
               'error'     => 'bad chars',
               'string'    => $_,
               'purpose'   => 'the name of a file or directory',
            )
               if ($this->isbad($_));
   }

   if (scalar(@dirs) > 0) {

      $filename = pop(@dirs);

      $path = join($Futils::SL, @dirs);
   }

   if (length($path) > 0) {

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

      $path = '.';
   }

   if (not $this->fexists($path)) {

      $this->make_dir($path,0644);
   }

   # determine whether the caller wants to over-write old data in the file
   # if it already exists, create a fresh new file from the content provided,
   # or just append the content onto the end of an existing file
   if ($mode eq 'write') {

      $cmd = '>' . $path . $Futils::SL . $filename;

      # While we're here...
      # it's good to know beforehand whether or not we have permission to
      # write/append to this file allowing us to handle such an exception
      # before it handles us.

      if (-e $path . $Futils::SL . $filename) {

         # --> now check the writability of the file itself
         $this->
            throw
               (
                  'filename'  => $path . $Futils::SL . $filename,
                  'dirname'   => $path . $Futils::SL,
                  'error'     => 'cant fwrite',
               )
                  unless ($this->can_write($path.$Futils::SL.$filename));
      }
      else {

         # --> if file doesn't exist, the error is one of creation
         $this->
            throw
               (
                  'filename'  => $path . $Futils::SL . $filename,
                  'dirname'   => $path . $Futils::SL,
                  'error'     => 'cant fcreate',
               )
                  unless ($this->can_write($path . $Futils::SL));
      }
   }
   elsif ($mode eq 'append') {

      $cmd = '>>' . $path . $Futils::SL . $filename;
   }
   elsif ($mode eq 'read') {

      # 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
      $this->
         throw
            (
               'filename'  => $path . $Futils::SL . $filename,
               'dirname'   => $path . $Futils::SL,
               'error'     => 'cant dread',
            )
               unless ($this->can_read($path.$Futils::SL));

      # --> now check the readability of the file itself
      $this->
         throw
            (
               'filename'  => $path . $Futils::SL . $filename,
               'dirname'   => $path . $Futils::SL,
               'error'     => 'cant fread',
            )
               unless ($this->can_read($path.$Futils::SL.$filename));

      $cmd = '<' . $path . $Futils::SL . $filename;
   }

   # we need a unique filehandle
   my($FH) = int(rand(time())).$$;
   $FH =  eval('*'.'OPEN_TO_FH'.$FH);

   # lock file before I/O when possible
   if ($$opts{'--no-lock'} || $$this{'opts'}{'--no-lock'}) {

      # if you use the '--no-lock' option you are probably stupid
      open($FH, $cmd)
         or
            $this->
               throw
                  (
                     'filename'  => $path . $Futils::SL . $filename,
                     'mode'      => $mode,
                     'error'     => 'bad open',
                     'exception' => $!,
                     'cmd'       => $cmd,
                  );

      # return file handle reference to the caller
      return($FH);
   }
   else {

      open($FH, $cmd)
         or
            $this->
               throw
                  (
                     'filename'  => $path . $Futils::SL . $filename,
                     'mode'      => $mode,
                     'error'     => 'bad open',
                     'exception' => $!,
                     'cmd'       => $cmd,
                  );

         $this->seize($path . $Futils::SL . $filename, $FH);
      }

   # return file handle reference to the caller
   return($FH);
}


# --------------------------------------------------------
# Futils::write_file()
# --------------------------------------------------------
sub write_file {

   my($this)      = shift(@_);
   my($opts)      = $this->shave_opts(\@_);
   my($in)        = $this->coerce_array(@_);
   my($filename)  = $in->{'file'}      || '';
   my($content)   = $in->{'content'}   || '';
   my($mode)      = $in->{'mode'}      || 'write';
   my($shadow_FH) = undef;
   my($path)      = '';
   my($cmd)       = '';
   my(@dirs)      = ();
   my($have_lock) = 0;
   my($FH_passed) = 0;

   $filename ||= $$in{'filename'};
   $filename ||= '';

   $path = $filename;

   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
   $this->
      throw
         (
            'error'     => 'no input',
            'meth'      => 'write_file',
            'missing'   => 'a file name to create, write, or append',
         )
            if (length($filename) == 0);

   # if prospective filename contains 2+ dir separators in sequence then
   # this is a syntax error we need to whine about
   $this->
      throw
         (
            'error'     => 'bad chars',
            'string'    => $filename,
            'purpose'   => 'the name of a file or directory',
         )
            if ($filename =~ /$Futils::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
   $this->
      throw
         (
            'meth'      => 'write_file',
            'missing'   => 'the content you want to write or append',
            'error'     => 'no input',
         )
            if
               (
                  (length($content) == 0)
                     and
                  ($mode ne 'trunc')
                     and
                  (!$Futils::empty_writes)
               );

   # take care of idiots
   $filename =~ s/$Futils::trailer//;

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

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

      $this->
         throw
            (
               'error'     => 'bad chars',
               'string'    => $_,
               'purpose'   => 'the name of a file or directory',
            )
               if ($this->isbad($_));
   }

   if (scalar(@dirs) > 0) {

      $filename = pop(@dirs);

      $path = join($Futils::SL, @dirs);
   }

   if (length($path) > 0) {

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

      $path = '.';
   }

   if (not $this->fexists($path)) {

      $this->make_dir($path,0644);
   }

   my($openarg) = qq[$path$Futils::SL$filename];

   # it's good to know beforehand whether or not we have permission to
   # write/append to this file allowing us to handle such an exception
   # before it handles us.

   if (-e $openarg) {

      # --> now check the writability of the file itself
      $this->
         throw
            (
               'filename'  => $openarg,
               'dirname'   => $path . $Futils::SL,
               'error'     => 'cant fwrite',
            )
               unless ($this->can_write($openarg));
   }
   else {

      # --> if file doesn't exist, the error is one of creation
      $this->
         throw
            (
               'filename'  => $openarg,
               'dirname'   => $path.$Futils::SL,
               'error'     => 'cant fcreate',
            )
               unless ($this->can_write($path . $Futils::SL));
   }

   # determine whether the caller wants to over-write old data in the file
   # if it already exists, create a fresh new file from the content provided,
   # or just append the content onto the end of an existing file
   if ($$opts{'--no-lock'} || $$this{'opts'}{'--no-lock'}) {

      # get open mode
      $mode = $$Futils::modes{'popen'}{ $mode };

      # if you use the '--no-lock' option you are probably stupid
      open(WRITE_FILE, $mode . $openarg)
         or
            $this->
               throw
                  (
                     'filename'  => $openarg,
                     'mode'      => $mode,
                     'error'     => 'bad open',
                     'exception' => $!,
                     'cmd'       => $cmd,
                  );
   }
   else {

      sysopen
         (
            *WRITE_FILE,
            $openarg,
            eval($$Futils::modes{'sysopen'}{ $mode })
         )
            or
               $this->
                  throw
                     (
                        'filename'  => $openarg,
                        'mode'      => $mode,
                        'error'     => 'bad open',
                        'exception' => $!,
                        'cmd'       => qq[$openarg, $mode],
                     );

      { my($current_FH) = select(WRITE_FILE); ++$|; select($current_FH) }

      # lock file before I/O when possible
      $this->seize($openarg, *WRITE_FILE);

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

         truncate(WRITE_FILE,0)
            or
               $this->
                  throw
                     (
                        'filename'  => $openarg,
                        'error'     => 'bad systrunc',
                        'exception' => $!,
                     );
      }
   }

   # write the caller's data to the newly opened file, syswrite covers our
   # rear if the content is a binary stream and we're running on an OS that
   # needs binmode.  otherwise it isn't going to matter, except that it might
   # be faster, since it bypasses stdio
   $in->{'content'}||='';

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

   # release locks on the file
   if ($$opts{'--no-lock'} || $$this{'opts'}{'--no-lock'}) {

      # if execution gets here and you didn't pass in a locked filehandle
      # to this method, you used the '--no-lock' option and you
      # are probably stupid
      close(WRITE_FILE)
         or
            $this->
               throw
                  (
                     'filename'  => $openarg,
                     'mode'      => $mode,
                     'error'     => 'bad close',
                     'exception' => $!,
                  );
   }
   else {

      $this->release(*WRITE_FILE);

      close(WRITE_FILE)
         or
            $this->
               throw
                  (
                     'filename'  => $openarg,
                     'mode'      => $mode,
                     'error'     => 'bad close',
                     'exception' => $!,
                  );

   }

   # return a quick success code to the caller in order to pass any checks
   # being made that the operation was successful
   return(1);
}


# --------------------------------------------------------
# Futils::seize()
# --------------------------------------------------------
sub seize {

   # flock() helper for same-process race conditions
   # which aren't safely handled when left up to the native filesystem
   # locking mechanisms.  Here, flock(2) lockf(3) and fcntl(2) can't
   # save your bacon.  You have to help out a little yourself.

=pod

   OPTIONS ON I/O RACE CONDITION POLICY
      set $Futils::onflockfail to any of the following strings:

         ex- @Futils::onflockfail = qw( wait fail );

     --fatal         fails with stack trace
     --fail          same as above
     --warn          warns() about the error with a stack trace
     --ignore        ignores the failure to get an exclusive lock
     --undef         returns undef
     --0             returns 0
   * --wait          waits to try getting an exclusive lock
   * --block         same as above

   * used in tandem with another option.
     you must specify another option to
     fall back on if blocking should fail.
     otherwise Futils will throw a fatal
     error and dump a stack trace before
     exiting the process with a 0 status

=cut


   my($this)   = shift(@_);
   my($file)   = shift(@_)||'';
   my($FH)     = shift(@_)||'';
   my(@policy) = @Futils::onflockfail;
   my($policy) = $this->shave_opts(\@policy);

   $this->{'expt'}->fail(q[no file name passed to seize.])
      unless
         ($file);

   $this->{'expt'}->fail(q[no handle passed to seize.])
      unless
         ($FH);

   if ($Futils::hasflock) {

      if (flock($FH, Fcntl::LOCK_EX() | Fcntl::LOCK_NB())) {

         # at this point we know we have a non-blocking lock on $FH
         return($FH);
      }
      else {

         if
            (
               $policy->{'--block'}
                  or
               $policy->{'--wait'}
            )
         {
            if (flock($FH, Fcntl::LOCK_EX())) { return($FH) }
            else {

               if    ($policy->{'--0'})     { return(0) }
               elsif ($policy->{'--undef'}) { return(undef) }
               elsif ($policy->{'--warn'})  {

                  return
                     (
                        $this->
                           throw
                              (
                                 '--as-warning',
                                 'filename'  => $file,
                                 'error'     => 'bad lock',
                                 'exception' => $!,
                              )
                     )
               }

               $this->
                  throw
                     (
                        'filename'  => $file,
                        'error'     => 'bad lock',
                        'exception' => $!,
                     )
            }
         }
         else {

            if    ($policy->{'--0'})     { return(0) }
            elsif ($policy->{'--undef'}) { return(undef) }
            elsif ($policy->{'--warn'})  {

               $this->
                  throw
                     (
                        '--as-warning',
                        'filename'  => $file,
                        'error'     => 'bad nblock',
                        'exception' => $!,
                     );

               return(undef);
            }

            $this->
               throw
                  (
                     'filename'  => $file,
                     'error'     => 'bad nblock',
                     'exception' => $!,
                  )
         }

         return(undef)
      }
   }

   return($FH)
}


# --------------------------------------------------------
# Futils::release()
# --------------------------------------------------------
sub release {

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

   $this->{'expt'}->fail(qq[can't unlock $ebl$FH$ebr: not a valid handle])
         unless (ref(\$FH||'') eq 'GLOB');

   if ($Futils::hasflock) { flock($FH, Fcntl::LOCK_UN()) }

   return(1);
}


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


# --------------------------------------------------------
# Futils::isbad()
# --------------------------------------------------------
sub isbad { $_[1] =~ /$Futils::illegal_filename_chrs/ }


# --------------------------------------------------------
# Futils::strip_path()
# --------------------------------------------------------
sub strip_path {

   my($this)      = shift(@_);
   my($filename)  = shift(@_)||'';
   my(@dirs)      = ();

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

   return((pop(@dirs))||'');
}


# --------------------------------------------------------
# Futils::escape_filename()
# --------------------------------------------------------
sub escape_filename {

   my($this)      = shift(@_);
   my($filename)  = shift(@_)||'';
   my($opts)      = $this->shave_opts(\@_);
   my($escape)    = $opts->{'--use-chr'};
   my($also)      = $opts->{'--also'};
   my(@dirs)      = ();
   my($path)      = '';
   my($mskpath)   = '';

   $escape  = '_' if (not defined($escape));
   $also    ||= '';
   $also    = (length($also) > 0) ? '|'.$also : '';

   # take care of idiots
   $filename =~ s/$Futils::trailer//;

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

   if (scalar(@dirs) > 0) {

      $filename   = pop(@dirs);
      $path       = join($Futils::SL, @dirs);
      $mskpath    = join($escape , @dirs);
   }

   if (length($path) > 0) {

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

      $path = '.';
   }

   $filename =~ s/$Futils::illegal_filename_chrs$also/$escape/g;
   $filename =~ s/^(?:\.)+?\w//o;

   if ($opts->{'--strip-path'}) {

      # take care of relative path prefixes still present
      $filename =~ s/^\.+?//o;

      return($filename);
   }

   return($mskpath . $escape . $filename);
}


# --------------------------------------------------------
# Futils::throw()
# --------------------------------------------------------
sub throw {

   my($this) = shift(@_);
   my($opts) = $this->shave_opts(\@_);
   my($in)   = $this->coerce_array(@_);

   return(0) if ($this->{'opts'}{'--fatals-as-status'});

   $this->{'expt'}||={};
   unless (UNIVERSAL::isa($this->{'expt'},'expt_handler')) {

      $this->{'expt'} = expt_handler->new();
   }

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

      $_ = (defined($_)) ? $_ : '[undefined value]';
   }

   my($error) = (defined($in->{'error'})) ? $in->{'error'} : '[empty error]';

   unless (defined( $Futils::errors->{$error} )) {

      $Futils::errors->{$error} = $Futils::errors->{'unknown error message'}
   }

   my($bad_news)  = CORE::eval($Futils::errors->{$error});

   if ($opts->{'--as-warning'}) {

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

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

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

      $bad_news .= qq[   $_ => $in->{$_}] . $n;
   }
   foreach (keys(%{$opts})) {

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

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

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

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


# --------------------------------------------------------
# $Futils::errors  [ref to anonymous hash of error msgs]
# --------------------------------------------------------
BEGIN {

$Futils::errors = {};
$Futils::errors =

   {
# BAD CHARS
      'bad chars'    => <<'__bad_chars__',
qq[
Futils v$Futils::VERSION

Futils can't use this string for $ebl$in->{'purpose'}$ebr.
   $ebl$in->{'string'}$ebr
It contains illegal characters.

Illegal characters are:
   $ebl$Futils::SL$ebr
   $ebl\\$ebr   (backslash)
   $ebl/$ebr   (forward slash)
   $ebl:$ebr   (colon)
   $ebl $ebr   (space)
   $ebl|$ebr   (pipe)
   $ebl*$ebr   (asterisk)
   $ebl?$ebr   (question mark)
   $ebl"$ebr   (double quote)
   $ebl<$ebr   (less than)
   $ebl>$ebr   (greater than)
   $ebl\\t$ebr  (tab)
   $ebl\\r$ebr  (newline CR)
   $ebl\\n$ebr  (newline LF)


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

Raw input as passed to this method:
]
__bad_chars__
# NO SUCH FILE
      'no such file' => <<'__bad_open__',
qq[
Futils v$Futils::VERSION

Futils can't open
   $ebl$in->{'filename'}$ebr
because no such file or directory exists.

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

Raw input as passed to this method:
]
__bad_open__

# INVALID ERROR TYPE
      'unknown error message' => <<'__foobar_input__',
qq[
Futils v$Futils::VERSION

Futils failed with an invalid error-type designation.

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

Raw input as passed to this method:
]
__foobar_input__

# EMPTY ERROR TYPE
      'empty error' => <<'__no_input__',
qq[
Futils v$Futils::VERSION

Futils failed with an empty error-type designation.

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

Raw input as passed to this method:
]
__no_input__

# BAD CALL TO METHOD x
      'no input' => <<'__no_input__',
qq[
Futils v$Futils::VERSION

Futils can't honor your call to ${\$ebl}Futils::$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.

Raw input as passed to this method:
]
__no_input__

# CAN'T READ FILE
      'cant fread' => <<'__cant_read__',
qq[
Futils v$Futils::VERSION

Permissions conflict.  Futils 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

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

Raw input as passed to this method:
]
__cant_read__

# CAN'T CREATE FILE
      'cant fcreate' => <<'__cant_write__',
qq[
Futils v$Futils::VERSION

Permissions conflict.  Futils can't create this file:
   $ebl$in->{'filename'}$ebr

   Futils 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 or redundant)
      $ebl$in->{'dirname'}$ebr

   Parent directory 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 Futils.
Solution:   A human must fix the conflict by adjusting the file permissions
            of directories where a program asks Futils to perform I/O.
            Try using Perl's chmod command, or the native system chmod()
            command from a shell.

Raw input as passed to this method:
]
__cant_write__

# CAN'T WRITE TO FILE
      'cant fwrite' => <<'__cant_write__',
qq[
Futils v$Futils::VERSION

Permissions conflict.  Futils 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

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

Raw input as passed to this method:
]
__cant_write__

# CAN'T LIST DIRECTORY
      'cant dread' => <<'__cant_read__',
qq[
Futils v$Futils::VERSION

Permissions conflict.  Futils can't list the contents of this directory:
   $ebl$in->{'filename'}$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->{'filename'}))[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 Futils.
Solution:   A human must fix the conflict by adjusting the file permissions
            of directories where a program asks Futils to perform I/O.
            Try using Perl's chmod command, or the native system chmod()
            command from a shell.

Raw input as passed to this method:
]
__cant_read__

# CAN'T CREATE DIRECTORY
      'cant dcreate' => <<'__cant_write__',
qq[
Futils v$Futils::VERSION

Permissions conflict.  Futils can't create:
   $ebl$in->{'filename'}$ebr

   Futils 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 or redundant)
      $ebl$in->{'dirname'}$ebr

   Parent directory 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 Futils.
Solution:   A human must fix the conflict by adjusting the file permissions
            of directories where a program asks Futils to perform I/O.
            Try using Perl's chmod command, or the native system chmod()
            command from a shell.

Raw input as passed to this method:
]
__cant_write__

# CAN'T OPEN
      'bad open' => <<'__bad_open__',
qq[
Futils v$Futils::VERSION

Futils can't open this file for $ebl$in->{'mode'}$ebr:
   $ebl$in->{'filename'}$ebr

   The system returned this error:
      $ebl$in->{'exception'}$ebr

   Futils used this directive in its attempt to open the file
      $ebl$in->{'cmd'}$ebr

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

Raw input as passed to this method:
]
__bad_open__

# ALREADY OPEN
      'already open' => <<'__already_open__',
qq[
Futils v$Futils::VERSION

Futils can't open this file
   $ebl$in->{'filename'}$ebr

   This file is already in use somewhere else in your code.
   It is opened to descriptor number $ebl@{[
      fileno($this->{'lockbox'}{'file names'}{ $in->{'filename'} }{'handle'})
         ||
      '[descriptor irretrievable]'
   ]}$ebr

Origin:     This is a human error.
Solution:   Turn off file locking in Futils or don't open the same file more
            than one time simultaneously.  You risk data corruption.

Raw input as passed to this method:
]
__already_open__

# CAN'T GET FLOCK AFTER BLOCKING
      'bad nblock' => <<'__bad_lock__',
qq[
Futils v$Futils::VERSION

Futils can't get a non-blocking exclusive lock on the file
   $ebl$in->{'filename'}$ebr

The system returned this error:
   $ebl$in->{'exception'}$ebr

Origin:     Could be either human _or_ system error.
Solution:   Fall back to an attempt at getting a lock on the file by blocking.
            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.

Raw input as passed to this method:
]
__bad_lock__

# CAN'T GET NON-BLOCKING FLOCK
      'bad lock' => <<'__bad_lock__',
qq[
Futils v$Futils::VERSION

Futils can't get a blocking exclusive lock on the file.
   $ebl$in->{'filename'}$ebr

The system returned this error:
   $ebl$in->{'exception'}$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.

Raw input as passed to this method:
]
__bad_lock__

# CAN'T OPEN ON A DIRECTORY
      'called open on a dir' => <<'__bad_open__',
qq[
Futils v$Futils::VERSION

Futils can't call open() on this file because it is a directory
   $ebl$in->{'filename'}$ebr

Origin:     This is a human error.
Solution:   Use Futils::load_file() to load the contents of a file
            Use Futils::list_dir() to list the contents of a directory

Raw input as passed to this method:
]
__bad_open__

# CAN'T OPENDIR ON A FILE
      'called opendir on a file' => <<'__bad_open__',
qq[
Futils v$Futils::VERSION

Futils can't opendir() on this file because it is not a directory.
   $ebl$in->{'filename'}$ebr

Use Futils::load_file() to load the contents of a file
Use Futils::list_dir() to list the contents of a directory

Origin:     This is a human error.
Solution:   Use Futils::load_file() to load the contents of a file
            Use Futils::list_dir() to list the contents of a directory

Raw input as passed to this method:
]
__bad_open__

# PASSED READLIMIT
      'readlimit exceeded' => <<'__readlimit__',
qq[
Futils v$Futils::VERSION

Futils 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$Futils::readlimit$ebr bytes.

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

Raw input as passed to this method:
]
__readlimit__

# BAD OPENDIR
      'bad opendir' => <<'__bad_opendir__',
qq[
Futils v$Futils::VERSION

Futils can't opendir this on $ebl$dir$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.

Raw input as passed to this method:
]
__bad_opendir__

# BAD MAKEDIR
      'bad make_dir' => <<'__bad_make_dir__',
qq[
Futils v$Futils::VERSION

Futils 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->{'dir'}$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.

Raw input as passed to this method:
]
__bad_make_dir__

# BAD CLOSE
      'bad close' => <<'__bad_close__',
qq[
Futils v$Futils::VERSION

Futils couldn't close this file after $ebl$in->{'mode'}$ebr
   $ebl$in->{'filename'}$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.

Raw input as passed to this method:
]
__bad_close__

# CAN'T TRUNCATE
      'bad systrunc' => <<'__bad_systrunc__',
qq[
Futils v$Futils::VERSION

Futils 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

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

Raw input as passed to this method:
]
__bad_systrunc__
   }
} # close surrounding BEGIN block for Futils::errors


# --------------------------------------------------------
# Futils::DESTROY(), end Futils class package
# --------------------------------------------------------
sub DESTROY {}
1;


=pod

   PERL FILE CHECKS REFERENCE

    -r  File is readable by effective uid/gid.
    -w  File is writable by effective uid/gid.
    -x  File is executable by effective uid/gid.
    -o  File is owned by effective uid.
    -R  File is readable by real uid/gid.
    -W  File is writable by real uid/gid.
    -X  File is executable by real uid/gid.
    -O  File is owned by real uid.
    -e  File exists.
    -z  File has zero size.
    -s  File has non-zero size (returns size).
    -f  File is a plain file.
    -d  File is a directory.
    -l  File is a symbolic link.
    -p  File is a named pipe (FIFO).
    -S  File is a socket.
    -b  File is a block special file.
    -c  File is a character special file.
    -t  Filehandle is opened to a tty.
    -u  File has setuid bit set.
    -g  File has setgid bit set.
    -k  File has sticky bit set.
    -T  File is a text file.
    -B  File is a binary file (opposite of -T).
    -M  Age of file in days when script started.
    -A  Same for access time.
    -C  Same for inode change time.


   SYSTEM FLOCK SUPPORT DEFINES

   d_fcntl_can_lock
      From d_fcntl_can_lock.U:
         This variable conditionally defines the FCNTL_CAN_LOCK symbol
         and indicates whether file locking with fcntl() works.

   d_flock
      From d_flock.U:
         This variable conditionally defines HAS_FLOCK if flock() is
         available to do file locking.

   d_lockf
      From d_lockf.U:
         This variable conditionally defines HAS_LOCKF if lockf() is
         available to do file locking.

         /FLOCKING CONSTANTS/

            classic values for these constants are as listed,
            but this can vary from system to system
               LOCK_EX 2
               LOCK_UN 8
               LOCK_NB 4
               LOCK_SH 1



=cut


package expt_handler;
use strict;
$expt_handler::VERSION   = 1.01;                   # 8/6/2002, 1:42:23 PM

=pod

   AUTHOR
        -Tommy Butler, professional contractor and open source proponent

         Atrixnet™, for Internet Business Software®
            http://atrixnet.com
            6711 Forest Park Dr
            Dallas, TX
                 76001

   COPYRIGHT
         Copyright Tommy Butler. All rights reserved

   LISCENCE
         This software is free, and you may use and distribute it under the
         GNU GPL liscence.  If you modify the code for your own purposes
         please acknowledge its original author.

   BUGS
      Please report any of the following to me
         - bugs
         - interface inconsistencies
         - suggestions
         - comments
         - complaints
         - smart remarks


=cut

use vars qw( $n ); $n = qq[\n];

# --------------------------------------------------------
# Constructor
# --------------------------------------------------------
sub new {

   my($class) = shift;
   my($this)   = {};
   my($name)   = __PACKAGE__;

   # -------------------------------------------
   # bless object ref into the class' namespace
   # -------------------------------------------
   bless($this, $name);

   # this is always a handy help
   $this->{'name'} = $name;

   # return object reference
   return($this);
}


# --------------------------------------------------------
# expt_handler::quit()
# --------------------------------------------------------
sub quit {

   my($this) = shift;

   print( qq[Content-Type: text/html] . $n x 2 )
       if ( $ENV{'REQUEST_METHOD'} =~ /^HEAD|^GET|^POST/io );

   print( qq[PROCESS TERMINATED DUE TO ERRORS, see log...] );

   warn($this->trace(@_));

   exit;
}


# --------------------------------------------------------
# expt_handler::fail(), error(), belch()
# --------------------------------------------------------
sub fail {

    my($this) = shift;
    my($throw_count) = $this->{'tflag'} || 0;

    {
      # I refuse to manually initialize a standard environment
      # variable.  This is an example where the warnings pragma
      # is going too far.  It's something we live with.
        local($^W) = undef;

      # if we're running in a CGI gateway iface, we need
      # to output the necessary HTTP headers
      if ( $ENV{'REQUEST_METHOD'} =~ /^HEAD|^GET|^POST/io ) {

         print(<<__crash__) and exit;
Content-Type: text/html; charset=ISO-8859-1


<pre>
PROCESS TERMINATED DUE TO ERRORS
@{[ $this->trace(@_) ]}
</pre>
__crash__
      }
      else {

         print(<<__crash__) and exit;
PROCESS TERMINATED DUE TO ERRORS
@{[ $this->trace(@_) ]}
__crash__
      }
    }

   exit;
}
sub error { my($this) = shift; return( $this->fail(@_) ) }
sub belch { my($this) = shift; return( $this->fail(@_) ) }


# --------------------------------------------------------
# expt_handler::trace()
# --------------------------------------------------------
sub trace {

    my($this)    = shift;
    my(@errors)  = @_;
    my($errfile) = '';
    my($caught)  = 0;
    my(
        $pak,     $filename,  $linenum,  $subroutine,
        $hasargs, $wantarray, $evaltext, $req_OR_use,
        @stack,   $trace,     $i,        $ialias,
    );
    $ialias = 0;
    while (
        (
            $pak,     $filename,  $linenum,  $subroutine,
            $hasargs, $wantarray, $evaltext, $req_OR_use
        )
        = caller( $i++ )
      )
    {
        $ialias = $i - 2;

        my(@tree) = split ( /\:\:/, $subroutine );

        if ( $tree[0] ne $this->{'name'} ) {

            push (
                @stack, qq[
$ialias. $subroutine
     -called at line ($linenum) of $filename
         @{[

            ($hasargs)
               ? '-was called with args'
               : '-was called without args'
         ]}
         @{[
            ($evaltext)
               ? '-was called to evalate text'
               : '-was not called to evaluate anything'
         ]}]
            );
        }
        else {
            $caught =
              $n
              . uc(qq[exception was raised at])
              . qq[ line ($linenum) of $filename];
        }
    }

    $i = 0;

    if ( scalar(@errors) == 0 ) {

        push ( @errors, qq[[unreported error. stack frame no. $ialias...]] );
    }

    foreach (@errors) {

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

        if ( length($_) == 0 ) {

            $_ = qq[Something is wrong. stack frame no. $ialias...];
        }
        else { $_ =~ s/^(?:\r|\n)//o; $_ =~ s/(?:\r|\n)$//o; $_ = qq[$n$_$n]; }

        ++$i;
    }
    $trace  = join ( $n x 2, @errors, ) . $caught . $n x 2;
    $trace .= join ( $n x 2, @stack, $n x 4 );
    return($trace);
}


# --------------------------------------------------------
# expt_handler::DESTROY()
# --------------------------------------------------------
sub DESTROY {}
1;


package Handy::Dandy;
use strict;
$Handy::Dandy::VERSION  = 1.08;                    # 8/4/2002, 6:28:46 PM

=pod

   AUTHOR
        -Tommy Butler, professional contractor and open source proponent

         Atrixnet™, for Internet Business Software®
            http://atrixnet.com
            6711 Forest Park Dr
            Dallas, TX
                 76001

   COPYRIGHT
         Copyright Tommy Butler. All rights reserved

   LISCENCE
         This software is free, and you may use and distribute it under the
         GNU GPL liscence.  If you modify the code for your own purposes
         please acknowledge its original author.

   BUGS
      Please report any of the following to me
         - bugs
         - interface inconsistencies
         - suggestions
         - comments
         - complaints
         - smart remarks


=cut


# --------------------------------------------------------
# Constructor
# --------------------------------------------------------
sub new {

   my($class) = shift;
   my($this)  = {};
   my($name)  = __PACKAGE__;

   # -------------------------------------------
   # bless object ref into the class' namespace
   # -------------------------------------------
   bless($this, $class);

   my($in) = $this->coerce_array(@_);
   # -------------------------------------------
   # begin setting up class attributes
   # -------------------------------------------
   $this->{'name'}         = $name;

   # return object reference
   return($this);
}


# --------------------------------------------------------
# Handy::Dandy::utf8()
# --------------------------------------------------------
sub utf8 {

   my($this)            = shift;
   my($toencode)        = join('',@_);
   my($no_encode)       = 'a-zA-Z 0-9_\\-@.=';

   $toencode =~ s/([^&;$no_encode])/sprintf("%%%02X",ord($1))/ego;
   $toencode =~ s/ /+/gmo;

   return($toencode);
}


# --------------------------------------------------------
# Handy::Dandy::html_escape()
# --------------------------------------------------------
sub html_escape {

   my($this)   = shift;
   my(@chars)  = split(//,shift(@_));

   foreach (@chars) {

      $_ = '&#' .ord($_) .';';
   }

   return(join('',@chars));
}


# --------------------------------------------------------
# Handy::Dandy::convert()
# --------------------------------------------------------
sub convert_size {

   my($this)      = shift;
   my($amt)       = shift;
   my($cmd)       = shift;
   my(@specs)     = split(/ /,$cmd);
   my($from)      = $specs[0];
   my($to)        = $specs[-1];

   my($b) = 1;
   my($k) = 1000;
   my($m) = 1000000;

   # FROM conversions
   if ($from =~ /^ki/io) {

      $amt *= $k;
   }
   elsif ($from =~ /^meg/io) {

      $amt *= $m;
   }
   elsif ($from =~ /^by/io) {

      $amt *= $b;
   }

   # TO conversions
   if ($to =~ /^ki/io) {

      $amt /= $k;
   }
   elsif ($to =~ /^meg/io) {

      $amt /= $m;
   }
   elsif ($to =~ /^by/io) {

      $amt /= $b;
   }

   return($amt);
}


# --------------------------------------------------------
# Handy::Dandy::to_seconds()
# --------------------------------------------------------
sub time_units {

   my($this)   = shift(@_);
   my($unit)   = shift(@_) || '10 minutes';
   my($amt)    = 0;

   $unit =~ s/(?go)^(?: )+|(?: )+$//;

   ($unit,$amt) = split(/ /,$unit);


   if ($unit  =~ /(?o)sec/) {

      return($amt);
   }
   elsif ($unit =~ /(?o)min/) {

      # 1 minute = 60 seconds
      return($amt * 60);
   }
   elsif ($unit =~ /(?o)hour/) {

      # 1 hour       = 60 minutes
      # 60 minutes   = 3600 seconds
      return($amt * 3600);
   }
   elsif ($unit =~ /(?o)day/) {

      # 1 day        = 24 hours
      # 24 hours     = 1440 minutes
      # 1440 minutes = 86400 seconds
      return($amt * 86400);
   }
   elsif ($unit =~ /(?o)week/) {

      # 1 week             = 7.0347222 days
      # 7.0347222 days     = 168.8333333 hours
      # 168.8333333 hours  = 10130 minutes
      # 10130 minutes      = 607800 seconds
      return($amt * 607800);
   }
   elsif ($unit =~ /(?o)year/) {

      # 1 year                   = 365.2425116 days
      # 365.2425116 days         = 8765.8202778 hours
      # 8765.8202778 hours       = 525949.2166667 minutes
      # 525949.2166667 minutes   = 31556953 seconds
      return($amt * 31556953);
   }
   elsif ($unit =~ /(?o)never/) {

      return(-2)
   }
   else { return(-1) }
}


# --------------------------------------------------------
# Handy::Dandy::shave_opts()
# --------------------------------------------------------
sub shave_opts {

   my($this)   = shift;
   my($mamma)  = shift;
   my($maid)   = [@{$mamma}];
   my($opts)   = {};
   my($i)      = 0;

   while (@{$maid}) {

      my($e) = shift(@{$maid})||'';

      if ($e =~ /^\Q--\E\w/o) {

         splice(@{$mamma},$i,1);

         $opts->{$e} = $e if (length($e));
      }

      ++$i;
   }

   return($opts);
}


# --------------------------------------------------------
# Handy::Dandy::coerce_array()
# --------------------------------------------------------
sub coerce_array {

   my($this)      = shift;
   my($hashref)   = {};
   my($i)         = 0;
   my(@shadow)    = @_;

   while (@shadow) {

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

      if (defined($name)) {

         $hashref->{$name} = (defined($val)) ? $val : '';
      }
      else {

         ++$i;

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

   return($hashref);
}


# --------------------------------------------------------
# sub Handy::Dandy::touch
# --------------------------------------------------------
sub touch {

   my($this)   = shift;
   my(@items)  = @_;

   foreach(@items) {

      if (ref($_) eq 'SCALAR') {

         $$_ = '' if (not defined($$_));
      }
      elsif (ref($_) eq 'HASH') {

         %$_ = {} if (not defined(%$_));
      }
      elsif (ref($_) eq 'ARRAY') {

         @$_ = [] if (not defined(@$_));
      }
   }

   return(@items);
}


# --------------------------------------------------------
# sub Handy::Dandy::soft_touch
# --------------------------------------------------------
sub soft_touch {@_}


# ----------------------------------
# sub Handy::Dandy::isnum
# ----------------------------------
sub isnum { $_[0] !~ /\D/o }


# --------------------------------------------------------
# Handy::Dandy::trim()
# --------------------------------------------------------
sub trim {

   my($this)   = shift;

   return('') if (scalar(@_) < 2);

   my($str) = shift; $str = (defined($str)) ? $str : '';
   my($len) = shift; $len = (defined($len)) ? $len : 0;
   my($lst) = shift; $lst = (defined($lst)) ? $lst : 0;


   if ((length($str)==0) or (length($len)==0)) {

      return($str);
   }

   $len = int($len);

   if (length($str) <= $len) {

      return($str);
   }

   my($frag) = '';

   $frag =
      join
         (
            '',
            splice
               (
                  @{[split(//,$str)]},
                  $len
               ),
         );

   $str =
      sprintf
         (
            '%'.$len.'.'.$len.'s',
            $str
         );

   return (wantarray or $lst) ? ($str,$frag) : $str;
}


# --------------------------------------------------------
# Handy::Dandy::stamp()
# --------------------------------------------------------
sub stamp {

   my($this)      = shift;
   my($opts)      = $this->shave_opts(\@_);
   my($argtime)   = shift;

    my($months) = [
        'January',   'February', 'March',    'April',
        'May',       'June',     'July',     'August',
        'September', 'October',  'November', 'December',
    ];

    my($days) = [
        'Sunday',   'Monday', 'Tuesday', 'Wednesday',
        'Thursday', 'Friday', 'Saturday'
    ];

    $argtime ||= time();

    my( $sec, $min, $hour, $date, $mon, $year, $wday, $yday, $isdst ) =
      localtime($argtime);

    my($AMPM) = ( $hour >= 12 ) ? 'PM' : 'AM';

    $hour -= 12 if ( $hour > 12 );
    $hour = 12 if ( $hour == 0 );

    # 5/15/2002, 4.22.43 PM
    return
      (
        sprintf(
            q[%s/%u/%u, %s:%02u:%02u %s],
            $mon + 1, $date, $year + 1900,
            $hour, $min, $sec, $AMPM
        )
      ) if ($opts->{'--short'});

    # -June-15-2002-4.22.43-PM
    return
      (
        sprintf(
            q[-%s-%u-%u-%u.%02u.%02u-%s],
            $months->[$mon], $date, $year + 1900,
            $hour, $min, $sec, $AMPM
        )
      ) if ($opts->{'--filename'} or $opts->{'--file'});

    # Saturday, June 15, 2002, 4.22.43 PM
    return
      (
        sprintf(
            q[%s, %s %u, %u, %s:%02u:%02u %s],
            $days->[$wday], $months->[$mon], $date, $year + 1900,
            $hour,          $min,            $sec,  $AMPM
        )
      );
}


# --------------------------------------------------------
# Handy::Dandy::DESTROY()
# --------------------------------------------------------
sub DESTROY {}


# --------------------------------------------------------
# end Handy::Dandy Class, return true on import
# --------------------------------------------------------

1;

package main;

use strict;
use Config;
use Time::HiRes qw( time );

my($futils) = Futils->new();

print(qq[Content-Type: text/html; charset=ISO-8859-1\n\n]);

my(@out) = `perl -v`;

push(@out, qq[\n\n], `perl -V`, qq[\n\n]);

if (defined(%Config::Config)) {

   my(%con) = (%Config::Config);

   $con{'osname'}||=$^O||'[osname variable not available]';

   foreach (sort(keys(%con))) {

      if (defined($con{$_})) {

         if (length($con{$_}) == 0) {

            $con{$_} = '[defined empty]';

            push(@out,qq[$_ => $con{$_}\n]);
         }
         else {

            push(@out,qq[$_ => $con{$_}\n]);
         }
      }
      else {

         push(@out,qq[$_ => [undefined]\n]);
      }
   }
}
else {

   push(@out,qq[\n\%Config::Config not defined or unavailable.\n\n]);
}


$Futils::maxdepth = 1000;

push
   (
      @out,
      $Futils::n x 2
      . q[@INC is ]
      . join($Futils::n, @INC)
      . $Futils::n x 2
      . q[@INC CONTAINS...]
   );

foreach (@INC) {

   next if ($_ eq '.');

   push
      (
         @out,
         $futils->print_dir
            (
               $_,
               '--dirs-only',
               '--with-paths',
               '--follow',
               '--no-fsdots',
            )
     )
}


print(<<__endtemplate__);
<?xml version="1.0" encoding='ISO-8859-1'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
   "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html
 xmlns="http://www.w3.org/1999/xhtml"
 xml:lang="en"
 lang="en">
   <head>
     <title>perl binary details</title>
     <meta
      http-equiv="Content-Type"
      content="text/html; charset=iso-8859-1" />
      <link
      rel="stylesheet"
      type="text/css"
      href="http://www.atrixnet.com/css/style.css" />
   </head>
   <body>
      <h1>perl binary details</h1>
      <p>&#160;</p>
      <div class="px700">
         <pre>
@{[ join('',@out) ]}
this page generated in @{[sprintf('%.2f',((time-$^T)))]} seconds
         </pre>
      </div>
      <p>&#160;</p>
   </body>
</html>

__endtemplate__

exit;