package futil;
$futil::VERSION = 1.01;

=pod

   COPYRIGHT
      futil.pm was written by Tommy Butler
      Sunday, September 23, 2001 4:18:30 PM

         Copyright Tommy Butler
         Atrixnet Web Development, 2001
         All rights reserved.
         mailto:perl.scripts@atrixnet.com
         http://www.atrixnet.com

      This software is free, and you may use
      and distribute it under the same terms
      as Perl itself.

=cut


# use strict coding pragma
use strict;

# import LOCK_* constants needed to lock
# access to files before writing to them
use Fcntl ':flock';


# --------------------------------------------------------
# Constructor
# --------------------------------------------------------
sub new {
   my($class) = shift;
   my(%in)    = @_;
   my($this)  = {};
   my($name)  = __PACKAGE__;

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

   # set up class attributes
   $this->{'name'}  = $name;
   $this->{'main'}  = $in{'main'};
   $this->{'DIR'}   = $this->{'main'}{'DIR'};

   # return object reference
   return($this);
}


# --------------------------------------------------------
# futil::verify_attributes()
# --------------------------------------------------------
sub verify_attributes {
   my($this) = shift;

   die( qq[
      $this->{'name'} needs \$main->{'DIR'}
      hash ref from main config\n\n].
      $this->stack_trace() )
         if (not $this->{'DIR'});

   return(1);
}


# --------------------------------------------------------
# futil::list_dir()
# --------------------------------------------------------
sub list_dir {
   my($this)      = shift;
   my($dir)       = shift;
   my(@files)     = ();

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

   # if the call to this method didn't
   # include a directory name to open,
   # then complain about it
   die( qq[
      $this->{'name'} can't open a
      directory for listing unless
      you provide the directory name
      and path.].
      $this->stack_trace() )
         unless (length($dir) > 0);

   # if the call to this method included
   # a non-existant directory then
   # complain about it
   die( qq[
      $this->{'name'} can't open
      $dir for listing:
      No such file or directory].
      $this->stack_trace() )
         unless (-e $dir);

   # open the directory for reading or
   # die with a diagnostic error message
   # if our attempt to open the directory
   # was unsuccessful
   opendir(DIR, $dir)
      or die( qq[
      $this->{'name'} failed to opendir
      on $dir for listing: $!].
      $this->stack_trace() );

   # 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
   @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 main
   # process has finished execution
   closedir(DIR)
      or warn( qq[
      $this->{'name'} encountered an error
      while trying to closedir on $dir
      after reading: $!].
      $this->stack_trace() );

   # return an array of all files in this directory
   return(@files);
}


# --------------------------------------------------------
# futil::dump_dir()
# --------------------------------------------------------
sub dump_dir {
   my($this)      = shift;
   my($dir)       = shift;
   my($msgstr)    = qq[Directory listing for $dir];
   my($fdir)      = '';
   my($cols)      = 75;
   my($cap)       = q[+].(q[-] x $cols).q[+];
   my($toe)       = $cap;
   my(@files)     = ();

   # if the call to this method didn't
   # include a directory name to open,
   # then complain about it
   die( qq[
      $this->{'name'} can't open a
      directory for listing unless
      you provide the directory name
      and path.\n\n].
      $this->stack_trace() )
         unless (length($dir) > 0);

   # get list of files from futil::list_dir()
   @files = $this->list_dir($dir);

   # make a pretty, formatted table of
   # the directory listings
   foreach (@files) {
      $fdir .= sprintf( qq[| %s], $_ ).
                      (' ' x (int(($cols-1) - length($_)))).
                      qq[|\n];
   }

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

   $fdir = (join(/\n/, $cap, $fdir, $toe));

   # print out a listing of the directory
   # to STDERR
   warn( qq[\n$fdir\n\n] );

   return(1);
}


# --------------------------------------------------------
# futil::load_dir()
# --------------------------------------------------------
sub load_dir {
   my($this)      = shift;
   my($dir)       = shift;
   my(@files)     = ();
   my($dir_hash)  = {};

   # if the call to this method didn't
   # include a directory name to open,
   # then complain about it
   die( qq[
      $this->{'name'} can't open a
      directory for listing unless
      you provide the directory name
      and path.].
      $this->stack_trace() )
         unless (length($dir) > 0);

   # get list of files from futil::list_dir()
   @files = $this->list_dir($dir);

   # 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
   foreach (@files) {
      if (not(-d $_)) {
         $dir_hash->{ $_ } = $this->load_file( $dir.'/'.$_ );
      }
   }

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


# --------------------------------------------------------
# futil::load_file()
# --------------------------------------------------------
sub load_file {
   my($this)     = shift;
   my($filename) = shift;
   my($content)  = '';

   # localize filehandle that we're
   # going to be using in this method
   # as well as the global output record
   # separator so we can slurp it all in
   # one quick read (hope it's not big!)
   local(*FILE, $/);

   # if the call to this method didn't
   # include a filename to open, then
   # complain about it
   die( qq[
      $this->{'name'} can't open a
      file for reading unless you
      provide the filename and path.].
      $this->stack_trace() )
         unless (length($filename) > 0);

   # open the file for reading (note
   # the '<' syntax there) or die with
   # a diagnostic error message if our
   # attempt to open the file was unsuccessful
   open(FILE, qq[<$filename])
      or die( qq[
      $this->{'name'} failed to open $filename
      for reading: $!].
      $this->stack_trace() );

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

   # close the file or send out a system
   # warning with any diagnostics about the
   # error.  if all else fails, Perl will
   # close the file for us when the main
   # process has finished execution
   close(FILE)
      or warn( qq[
      $this->{'name'} encountered an error
      while trying to close $filename
      after reading: $!].
      $this->stack_trace() );

   # 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');
   if (wantarray()) {
      return(split(/\n/,$content));
   }

   # otherwise, return a scalar value
   # containing all of the file's content
   return($content);
}


# --------------------------------------------------------
# futil::write_file()
# --------------------------------------------------------
sub write_file {
   my($this)     = shift;
   my(%in)       = @_;
   my($filename) = $in{'filename'};
   my($content)  = $in{'content'};
   my($mode)     = $in{'mode'} || 'write';
   my($cmd)      = '';

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

   # if the call to this method didn't
   # include a filename to which the caller
   # wants us to write, then complain about it
   die( qq[
      $this->{'name'} can't write your
      data to file unless you provide
      a filename for creation or appending.].
      $this->stack_trace() )
         unless (length($filename) > 0);

   # 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
   die( qq[
      $this->{'name'} can't write your
      data to file unless you provide
      the content you want to write or
      append.].
      $this->stack_trace() )
         unless (length($content) > 0);

   # determine whether the caller wants
   # to create a fresh new file from
   # the content provided over-writing
   # old data in the file (if any is present),
   # or if the caller wants to just append
   # the content onto the end of the file
   if ($mode eq 'write') {
      $cmd = qq[>$filename];
   }
   elsif ($mode eq 'append') {
      $cmd = qq[>>$filename];
   }

   # get an exclusive lock on the file to
   # which we're going to write or append
   flock(FILE, LOCK_EX);

   # open the file for writing or appending
   # depending on the mode argument for this
   # operation. (note the '>' or '>>' syntax
   # in the two control statements above)
   # die with a diagnostic error message if our
   # attempt to open the file was unsuccessful
   open(FILE, $cmd)
      or die( qq[
      $this->{'name'} encountered an error
      while trying to open $filename for
      writing: $!].
      $this->stack_trace() );

   # write the caller's data to the newly
   # opened file
   print(FILE $in{'content'});

   # unlock the file to which we have
   # just written or appended
   flock(FILE, LOCK_UN);

   # close the file or send out a system
   # warning with any diagnostics about the
   # error.  if all else fails, Perl will
   # close the file for us when the main
   # process has finished execution
   close(FILE)
      or warn( qq[
      $this->{'name'} encountered an error
      while trying to close $filename
      after writing: $!].
      $this->stack_trace() );

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


# --------------------------------------------------------
# futil::stack_trace()
# --------------------------------------------------------
sub stack_trace {
   my($this) = shift;
   my( $pak,      $filename,
       $linenum,  $subroutine,
       $hasargs,  $wantarray,
       $evaltext, $req_OR_use,
       @stack,    $stack_trace,
       $i );

   while (
          (
            $pak,      $filename,
            $linenum,  $subroutine,
            $hasargs,  $wantarray,
            $evaltext, $req_OR_use
           ) = caller($i++)
          )  {

      $stack[$i] = qq[
         $i.) subroutine $subroutine
              at line ($linenum) of $filename];
   }

   $stack_trace = join(/\n/, reverse(@stack));

   return($stack_trace);
}


# --------------------------------------------------------
# futil::DESTROY()
# --------------------------------------------------------
sub DESTROY {}
# --------------------------------------------------------
# End RT Class objects always return a true value
# --------------------------------------------------------

1;

__DATA__

=pod

    -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.

=cut