#!/usr/bin/perl -w
# This is the sharp-bang, or shebang.
# It tells your shell where to find the perl interpreter.
# N.B. The shebang doesn't usually work under Windows.
# The shebang may be followed by command-line switches, such as -w;
# these will be passed to the perl interpreter.
#
#---------#---------#---------#---------#---------#---------#---------#---------
#
# title
#   collection of file subroutines
# author
#   idc@planetlarg.net 13 march 01
# description
#   A bare program that does very little. It is intended to cut down the
#   development time of a command line tool written in perl.
#   It provides all the parts common to all my command line scripts.
#   Copy and paste this for a quick way to make it look like you have been
#   working hard.
# modifications
#
#---------#---------#---------#---------#---------#---------#---------#---------
# setup
#   This is the cup of tea stage, useful for do a little sorting out before
#   getting down to some real work.

   use 5.005;
      # This line causes a compile-time error if the version of the Perl
      # interpreter is less than 5.005.
      # It's a good idea to require the version number of the interpreter
      # on which you're developing the program;
      # it might not run on earlier versions.
   use strict;
      # use strict enforces a restricted programming model on your code.
      # It is strongly recommended.
      # The most obvious effect of use strict is that global variables
      # must be referred to through fully qualified package names,
      # e.g. $Foo::Bar::baz, rather than $baz.
      # This has the practical consequence of flagging typos in lexically
      # declared (my) variables.
#---------#---------#---------#---------#---------#---------#---------#---------
# command line options
   # read any options entered with this program.

   use Getopt::Std;
      # This module standardises reading command line options.
      # The command line options we are looking for are
      #   -a   this needs an argument. The argument's value can be anything.
      #   -b   same as -a
      # they get shoved in these variables
   use vars qw($opt_a $opt_b);

   # First we move command line options from \%ENV into variables.
   my $options_ok;
   $options_ok = getopts('a:b:');

   # Check for options we don't want
   # This is done for us by the Getopts::Std module.
   # It prints an error message like this: "unknown option: X"
   print "missing arguments or unkown options encountered. \n"
      unless $options_ok;

   # after processing, the @ARGV array has been emptied.
   # options recognised by getopts (-a and -b) are moved into
   # variables with names starting with "$opt_"

   # Check for the options we require
   print "-a  is missing. \n" unless $opt_a;
   print "-b  is missing. \n" unless $opt_b;

   # print a usage message if there is a problem with the options
   usage() if not($opt_a and $opt_b);

#---------#---------#---------#---------#---------#---------#---------#---------
# main

# check a file is text
   unless ( -T $file) {
      print "   file is not text. \n" ;
   }
# check a file is not too HUUUGE
   my $max               = 10 * 1024 * 1024;  # 10 Meg size limit
   if (&file_too_fat ($file, $max)) {
      print "   file is bigger than $max bytes. \n" ;
   }

# do stuff with every file in a directory tree
   use File::Find;

   my $control_dir       = "$queue_dir/control.bak";
   print "directory: $control_dir \n";
   find ( \&do_stuff, ($control_dir) );

# shove a file's contents into an array
   @contents   = &file2array ($file);

# shove a file's contents into a scalar
   $contents   = &file2scalar ($file);
   # OR
   $contents   = join( '', (&file2array ($file)));

#---------#---------#---------#---------#---------#---------#---------#---------
# subs
#   all subroutines go below here.


# subroutine
#   file2array
# description
#   read the contents of a file and put it into an array
#   This is the slurp-whole-file method, so make sure the array won't
#   take up too much memory.
#
sub file2array {

   my $file = shift;

   open (IN, "<$file") or die "can't open file $file: $!";
   my @contents     = (); # this holds the message, 1 line per element
   @contents = <IN>;
   close IN            or die "can't close file $file: $!";
   print STDERR "\@contents    \n\n@contents  \n\n" if $DEBUG;

   return @contents;
}

# subroutine
#   file2scalar
# description
#   read the contents of a file and put it into a scalar.
#   This is the slurp-whole-file method, so make sure the scalar won't
#   take up too much memory.
#   Can you use "while (<>)..." processing instead?
sub file2scalar {

   my $file = shift;
   open (IN, "<$file") or die "can't open file $file: $!";
   undef $/;  # don't set the end-or-record seperator for slurp-whole-file mode
   my $contents = <IN>;
   close IN            or die "can't close file $file: $!";
   print STDERR "\$contents \n\n$contents \n\n" if $DEBUG;

   return $contents;
}



# subroutine
#   scalar2file
# description
#
sub scalar2file {

   my $contents = shift;

   open (OUT, ">$file") or die "can't open file $file: $!";
   print OUT $contents;
   close OUT            or die "can't close file $file: $!";
   print STDERR "\$contents    \n\n$contents  \n\n" if $DEBUG;
}




# subroutine
#   file_too_fat
# description
#   file size check. how big is it?
#   A huge file causes an error.
#   return true if too big, false otherwise.
#
sub file_too_fat {

   my $file = shift;
   my $max  = shift;
   my (
               $dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
               $size, $atime, $mtime, $ctime, $blksize, $blocks
   ) = stat "$file";
   print STDERR "   \$size      $size  \n" if $DEBUG;
   print STDERR "   \$max       $max   \n" if $DEBUG;
   return 1 if $size > $max;
   return 0;
}

# subroutine
#   latest_modified
# description
#  find the, er, latest file in a directory and return its name.
#  Latest means the one that was most recently modified.
#  Every file is examined.
#  readdir returns ONLY the file basename, not the path.
#
sub latest_modified {

   my $dir = shift;           # directory to examine
   opendir (DIR, $dir) or die "can't open directory $dir: $!";

   my $latest_mtime  = 0;     # most recent last modified time
   my $latest_file   = '';    # name of file with $latest_mtime
   my $file          = '';    # name of current file being examined
   while (defined ($file   = readdir (DIR))) {
      next if $file =~ m/^\.\.?$/; # skip . (this) and .. (parent) entries
      my (
                  $dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
                  $size, $atime, $mtime, $ctime, $blksize, $blocks
      ) = stat "$dir/$file";
      if ($latest_mtime < $mtime) {
         $latest_mtime  = $mtime;
         $latest_file   = $file;
      }
      print STDERR "   \$file    \t$file  \n" if $DEBUG;
      print STDERR "   \$mtime   \t$mtime \n" if $DEBUG;
   }
   return $latest_file;
}



# subroutine
#   head_file
# description
#   return the first lines of a file
#   since we are reading variable length records, we cannot
#   use seek or other binary approaches.
#
sub head_file {

   my $file           = shift;         # path to file to tail
   my $lines_wanted   = shift;         # no. of lines to copy
   my @lines          = '';            # the first few lines of the file
   my $count          = 0;             # line number (0 is first line)

   open (FILE, "$file") or die "can't open $file: $!";
   while (<FILE>) {
      if ($count  < $lines_wanted) {
         push @lines, $_;
      }
      $count++;
   }
   close (FILE) or die "can't close $file: $!";
   return @lines;
}


# subroutine
#   tail_file
# description
#   return the last lines of a file
#   since we are reading variable length records, we cannot
#   whizz straight to the end of the file then backtrack using seek.
#
sub tail_file {

   my $file           = shift;         # path to file to tail
   my $lines_wanted   = shift;         # no. of lines to copy
   my $total_lines    = &lines_in_file ("$file");
   my $start_point    = $total_lines - $lines_wanted; # copy start point
   my @lines          = '';            # the last few lines of the file
   my $count          = 0;             # line number

   open (FILE, "$file") or die "can't open $file: $!";
   while (<FILE>) {
      if ($count  >= $start_point) {
         push @lines, $_;
      }
      $count++;
   }
   close (FILE) or die "can't close $file: $!";
   return @lines;
}


# subroutine
#   log_warning
# description
#
sub log_message {
    my $file    = shift;
    my $message = shift;
    open (OUT, ">>$file")   or die "can't open file $file: $!";
    # 2 is exlusive lock
    flock (OUT, 2)          or die "can't lock file $file: $!";
    print OUT $message;
    # 8 is unlock
    flock (OUT, 8)          or die "can't unlock file $file: $!";
    close OUT               or die "can't close file $file: $!";
}



#---------#---------#---------#---------#---------#---------#---------#---------

# subroutine
#   usage
# description
#   describe how this script should be used.
#   This is one way of producing a set of instructions, using simple indentation.
#   For more complex document, use mark-up. See the perldoc section below.
#
sub usage {

   use Text::Wrap;
   $Text::Wrap::columns = 60;
   my $pre1             = "   ";
   my $pre2             = "   ";
   my $name             = "$0 - Accept and print command line options.";
   my $synopsis         = "$0  -a value  -b value";
   my $description      = "
A bunch of file subs for pasting.
";
   my $examples         = "
Ain't none.
";

   print
               "NAME \n",
               wrap ($pre1, $pre2, $name), "\n",
               "SYNOPSIS \n",
               wrap ($pre1, $pre2, $synopsis), "\n",
               "DESCRIPTION \n",
               fill ($pre1, $pre2, $description), "\n",
               "EXAMPLES \n",
               wrap ($pre1, $pre2, $examples), "\n",
   ;
   exit 1;
}


__END__

documentation

The "__END__" string is a token. It is the logical end of program text.
You can put anything you want after this token, such as an
instruction manual page; it will be ignored by the compiler.