#!/opt/perl/bin/perl -w
$versn = "1.3 - 06 AUG 2003" ;           # Code version and modify date
#
# Find blocks of lines containing the specified pattern
# (with appologies to Apollo Domain/OS's 'fpatb' command)
#
# For help and a description of the use of this script, run:
#
#   fpblock --help
#
# This code copyright 1999-2003 by
# D. W. Eaton, Artronic Development, Phoenix, AZ -- dwe@arde.com
#
# This software is made freely available under the provisions of the Perl
# "Artistic" license:  http://language.perl.com/misc/Artistic.html
#
# This code is not supported and is not warranteed to perform any particular
# function. Contact dwe@arde.com for aditional information.
# If you find bugs or make enhancements, it would be appreciated if you
# sent them on to the author at dwe@arde.com.
#
# Logical revision history:
#  1.3 -  DWE correct for pattern being in the "begin" line
#         and improve code and help information
#  1.2 -  DWE improved compatibility with Apollo Aegis'
#         fpatb output when blank lines are the block delimiters;
#         allow ^ and $ to be used to identify pattern matching
#         at beginning and end of lines if needed.
#         Known difference: if the beginning and ending lines of
#         a block are the same and are non-blank and the -x option
#         is used, fpatb shows the final block delimiter twice
#         (as the start and end of yet another block) but fpblock
#         only shows it once.
#  1.1 -  DWE improved compatibility with Apollo Aegis' output
#  1.0 -  DWE Initial version
#
use Getopt::Long;
#
# Constants
$false = 0;
$true  = 1;
$all   = 2;  # for Getopt ignore case
$stdin  = "STDIN";  # standard in
$stdout = "STDOUT"; # standard out
use vars qw($false $true $all);
#
# Exit status codes:
$ercf_ok = 0;$ermcf{$ercf_ok} = 'Exit OK';
$ercf_noinfile = 1;$ermcf{$ercf_noinfile} = 'Can\'t find input file';
$ercf_noinread = 2;$ermcf{$ercf_noinread} = 'Can\'t read input file';
$ercf_noopmake = 3;$ermcf{$ercf_noopmake} = 'Can\'t create new output file';
$ercf_user = 99;$ermcf{$ercf_user} = 'User syntax error';
#
$openfail = 0; # No open file errors yet
#
$| = $true; # Don't buffer output
#
# Option definitions
$opt_begin = 'begin';
$opt_count = 'count';
$opt_end = 'end';
$opt_except = 'except';
$opt_help = 'help';
$opt_ignore = 'ignore';
$opt_listfiles = 'listfiles';
$opt_matches = 'matches';
$opt_out = 'out';
$opt_pattern = 'pattern';
$opt_quiet = 'quiet';
$opt_showerror = 'showerror';
$opt_suppress = 'suppress';
$opt_syntax = 'syntax';
$opt_verbose = 'verbose';
$opt_version = 'version';
$opt_veryverbose = 'veryverbose';
#
# Option defaults
$opt{$opt_begin}     = '';
$opt{$opt_count}     = $false;
$opt{$opt_end}       = '';
$opt{$opt_except}    = $false;
$opt{$opt_help}      = $false;
$opt{$opt_ignore}    = $false;
$opt{$opt_listfiles} = $false;
$opt{$opt_matches}   = $false;
$opt{$opt_out}       = "";
$opt{$opt_pattern}   = '';
$opt{$opt_quiet}     = $false;
$opt{$opt_showerror} = $false;
$opt{$opt_suppress}  = $false;
$opt{$opt_syntax}    = $false;
$opt{$opt_verbose}   = $false;
$opt{$opt_version}   = $false;
$opt{$opt_veryverbose} = $false;
#
# Initialize
$lineno = 0;        # Input line number
$infile = $stdin;   # Default to get input from standard in
$outhandle = $stdout; # Default to write to standard out
$blockno = 0;       # Total block count
$holdline1 = 0;     # Not holding any blocks yet
$matchlines = 0;    # Matching line count
$matchlinblk = 0;   # Matching line count within current block
$matchblocks = 0;   # Matching block count
$blankline = '^\s*$'; # What constitutes a blank line
$outputOK = $true;  # Show normal output lines
# ---------------------- logic -------------------------
#
# Process command-line
@opts = qw(
 begin|b=s
 count|c
 end|e=s
 except|x
 help|h
 ignore|i
 listfiles|lf
 matches|m
 out|o=s
 pattern|p=s
 quiet|q
 showerror|shoerr|se
 suppress|s
 syntax
 verbose|v
 version
 veryverbose|vv
);
$Getopt::Long::bundling = $true;  # perl 5.003 and earlier will complain about this
$Getopt::Long::ignorecase = $all;
GetOptions (\%opt, @opts);

$scriptleaf = $0;
$scriptleaf =~ s/^.*\///; # strip leading path to see who we are

if ($opt{$opt_count} || $opt{$opt_matches})
{
 if ($opt{$opt_count} && $opt{$opt_matches})
 {
  print STDERR "ERROR: -c and -m are mutually exclusive options\n";
  &syntax_message ();
  exit ($ercf_user);
 }
 else
 {
  # Then some other values are implied
  $opt{$opt_quiet} = $true;
  $opt{$opt_verbose} = $false;
  $outputOK = $false;  # Suppress normal output lines
 }
}

if ($opt{$opt_out})
{
 # Then use an alternate output file
 $outhandle = "NXTOUTPUT";
 if (! open ($outhandle, ">$opt{$opt_out}"))
 {
  # Wanted to write file but couldn't
  &err_msg ("Can't create output file $opt{$opt_out}:  $!\n") ;
  exit ($ercf_noopmake) ; # Quit if we can't open the output file
 }
}

#
if ($opt{$opt_veryverbose})
{
 # Force verbose (if it was not already called out)
 $opt{$opt_verbose} = $true;
}
#
if ($opt{$opt_version})  
{
 print STDERR "$scriptleaf v$versn\n";
 exit ($ercf_user); # Quit after showing version
}
else
{
 unless ($opt{$opt_quiet} || $opt{$opt_help} || $opt{$opt_syntax})
 {
  &dooutput ($outhandle,"$scriptleaf - $versn\n");
 }
}
#
if ($opt{$opt_help} || $opt{$opt_syntax})
{
 &syntax_message ();
 exit ($ercf_user);
}
if ($opt{$opt_showerror})
{
 &show_error_codes(%ermcf); # Sho error codes
 exit ($ercf_user);
}

#
# Verify required options are present, and other checks

# Start pattern:
if (! $opt{$opt_begin})
{
 # Default start to blank line
 $opt{$opt_begin} = $blankline;
 $holdline1 = 1;     # This is a default match for line 1
}

# Termination pattern:
if (! $opt{$opt_end})
{
 if ($opt{$opt_begin})
 {
  # Default end to same as start
  $opt{$opt_end} = $opt{$opt_begin};
 }
 else
 {
  # Default end to blank line
  $opt{$opt_end} = $blankline;
 }
}

# The pattern needed (duh):
if (! $opt{$opt_pattern})
{
 # Error
 print STDERR "$scriptleaf ERROR: pattern required\n";
 &syntax_message ();
 exit ($ercf_user);
}
elsif ($opt{$opt_verbose})
{
 print "Searching for '$opt{$opt_pattern}'\n";
}

# More checks:
if (! defined ($ARGV [0]))
{
 $ARGV[0] = $stdin; # Try to fool it to use STDIN if no files
}

# So, should still have more arguments, must be filename(s)
while ($nextfile = shift(@ARGV))
{
 if ($opt{$opt_listfiles} && $nextfile ne $stdin)
 {
  &dooutput ($outhandle,"File: $nextfile\n");
 }

 #
 # - - - read input - - -
 # Get input
 $openok = $false;
 if ($nextfile ne $stdin)
 {
  $infile = "NXTINPUT";
  if (open ($infile, "<$nextfile"))
  {
   $openok = $true;
  }
  else
  {
   print STDERR "ERROR: (can't open file '$nextfile')" ;
   $openfail++; # Bump count of times we could not open input
  }
 }
 else
 {
  $infile = $stdin;
  $openok = $true;
 }
 # - - - - - - Do the work - - - - - -
 if ($openok)
 {
  # OK to process this one:
  while (defined ($line = <$infile>))
  {
   $lineno++;
   chomp($line);

   if ($line =~ /$opt{$opt_pattern}/ ||
       ($opt{$opt_ignore} && $line =~ /$opt{$opt_pattern}/i))
   {
    $matchlines++; # Count match
    $matchlinblk++; # Count match in this block
    if ($opt{$opt_verbose} )
    {
     # Then show the specific matches to verbose users
     &dooutput ($outhandle,"[line $lineno]: $line\n");
    }
   }

   if ($holdline1)
   {
    # Already holding a potential block
    if ($line =~ /$opt{$opt_end}/)
    {
     # Found end of this block, decide if it is "good"
     $heldlines .= "$line\n" unless ($opt{$opt_suppress});
     &checkblock;
     $heldlines = "";    # Go back to non-hold mode
     $holdline1 = 0;     # Stop holding
     if ($line =~ /$opt{$opt_pattern}/ ||
         ($opt{$opt_ignore} && $line =~ /$opt{$opt_pattern}/i))
     {
      $matchlinblk = 1;   # Start a new block, pattern is in this line
     }
     else
     {
      $matchlinblk = 0;   # Clear match lines in this block
     }
    }
   }

   # Now look to see if this also starts a new block:
   if ($line =~ /$opt{$opt_begin}/)
   {
    # Found start pattern, start holding
    if ($line =~ /$opt{$opt_pattern}/ ||
        ($opt{$opt_ignore} && $line =~ /$opt{$opt_pattern}/i))
    {
     $matchlinblk = 1;   # Start a new block, pattern is in this line
    }
    else
    {
     $matchlinblk = 0;     # Clear match lines in this block
    }
    $holdline1 = $lineno; # Remember first line number
    if (! $blockno || $opt{$opt_begin} ne $blankline)
    {
     $heldlines .= "$line\n" unless ($opt{$opt_suppress});
    }
   }
   elsif ($holdline1)
   {
    # Gather lines if we are in that "potential" mode
    $heldlines .= "$line\n";
   }
  }; # End while-lines-in-file

  # Did we have remaining stuff to consider?
  if ($heldlines)
  {
   # See if the last block needs to be processed
   if ($opt{$opt_end} eq $blankline)
   {
    # Yep ...
    &checkblock;
   }
   $heldlines = "";    # Go back to non-hold mode
   $holdline1 = 0;     # Stop holding
  }

  if ($infile ne $stdin)
  {
   close ($infile); # Close this input file
  }
 }
}

# - - - input all read - - -

# - - - wrapup - - -
if ($matchblocks)
{
 # Yep, we found some blocks
 if ($opt{$opt_count})
 {
  &dooutput ($outhandle,"$matchblocks\n");
 }
 if ($opt{$opt_matches})
 {
  &dooutput ($outhandle,"$matchlines\n");
 }
 if ($outputOK && ! $opt{$opt_quiet})
 {
  $msg1 = "matching block";
  if ($matchblocks != 1)
  {
   $msg1 .= "s";
  }
  $msg1 .= " found";
  if ($matchblocks < $blockno)
  {
   $msg1 .= " of $blockno blocks";
  }
  &dooutput ($outhandle,"$matchblocks $msg1.\n");
 }
}
else
{
 if ($outputOK && ! $opt{$opt_quiet})
 {
  &dooutput ($outhandle,"No matching blocks found.\n");
 }
}
# - - -

#
# All done
if ($outputOK)
{
 &dooutput ($outhandle,"\n") unless ($opt{$opt_quiet});
}

# See if we need to close output
if ($outhandle ne $stdout)
{
 # Close alternate output file
 close ($outhandle) ;
}
if ($openfail)
{
 print STDERR "ERROR: Unable to open $openfail input file(s)\n";
 exit ($ercf_noinread);
}
else
{
 exit ($ercf_ok);
}
exit ($ercf_ok);
### END.

# --------------------------- subroutines ----------------------------
# Do the output
#  &dooutput ($handle,"output")
sub dooutput
{
 my ($handle,$output) = @_;

 print $handle "$output";
}
# --------------------
# Check a 'held' block to see if it contains the pattern
# If so, print the block (and headers)
#  &checkblock;
# (uses global data)
sub checkblock
{
 $blockno++; # Count total blocks
 if ($matchlinblk)
 {
  # Ah, yes it contains our pattern
  if (! $opt{$opt_except})
  {
   &showblock;        # Show it
  }
 }
 else
 {
  # It does not contain our pattern
  if ($opt{$opt_except})
  {
   # But we didn't want it to
   &showblock;        # Show it
  }
 }
}
# --------------------
# Show a 'held' block that matches the pattern
# Print the block (and headers)
#  &showblock;
# (uses global data)
sub showblock
{
 $matchblocks++;
 $displine1 = $holdline1;
 $displine2 = $lineno;
 if ($opt{$opt_suppress})
 {
  # If suppressing begin and end lines, alter lines displayed
  $displine1++;
  $displine2--;
 }
 unless ($opt{$opt_quiet})
 {
  if ($outputOK)
  {
   &dooutput ($outhandle,"Block $blockno");
   &dooutput ($outhandle," lines $displine1 - $displine2:\n");
  }
 }
 if ($outputOK)
 {
  &dooutput ($outhandle,"$heldlines");
 }
 unless ($opt{$opt_quiet})
 {
  &dooutput ($outhandle,"\n"); # Separate blocks
 }
}
# --------------------
#
# Print syntax message
sub syntax_message
{
 my ($progname);

 chomp ($progname = `basename $0`);
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+
Version $versn
   
Name: $progname - Find pattern block

Find blocks of lines containing the specified pattern
(with appologies to Apollo Domain/OS's 'fpatb' command
which spawned the idea for this script)
+;
 }
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+
Syntax:
 
+;
 }
 # Always show this line:
 print STDERR "   $progname  [ options ]  [pathname(s)]\n";
 if ($opt{$opt_syntax} && $opt{$opt_verbose}) 
 {
  print STDERR  qq+
   Operational options:
   --$opt_begin=b,--$opt_count,--$opt_end=e,--$opt_ignore,--$opt_listfiles,--$opt_matches,--$opt_out=f,
   --$opt_pattern=p,--$opt_suppress,--$opt_except
   Assistance options:
   --$opt_help,--$opt_quiet,--$opt_showerror,--$opt_syntax,--$opt_verbose,--$opt_version,--$opt_veryverbose 
+;
 }     
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+
Where 'options' are:

   --$opt_begin=pat, -b pat
       Block separator. Default is a blank line.
       If -b is specified but -e is not, this pattern
       is used for both the beginning and end of a block.
   --$opt_count, -c
       Show only a count of the number of matching blocks
   --$opt_end=pat, -e pat
       End block separator. Default is a blank line.
       If -b is specified but -e is not, the -b pattern
       is used for both the beginning and end of a block.
   --$opt_ignore, -i
       Ignore case when doing pattern match.
   --$opt_listfiles, --lf
       List (each) file name before displaying patterns.
   --$opt_matches, -m
       Show only a count of the number of matching lines
   --$opt_out, -o
       Pathname for an output file other than STDOUT.
   --$opt_pattern, -p
       Pattern (perl regular expression) which must be found
       within the block (use '\^' for beginning of line and
       '\$' for end of line if needed, escape perl special
       characters with '\\' and/or use single quotes around
       the pattern if required).
   --$opt_suppress, -s
       Suppress showing the begin and end lines when showing
       lines of blocks in which a match was found. (With this
       option, if the only match was on the begin or end line
       itself, the block will not be shown.)
   --$opt_except, -x
       Show all blocks except those which contain a match for
       the specified pattern.

  Help and assistance options:

   --$opt_help, -h
       Print this help message
   --$opt_quiet, -q
       Do not show supporting info lines, just results
   --$opt_showerror, --shoerr, --se
       Show brief descriptions of error exit codes from this routine
   --$opt_syntax
       Only show the syntax line of this help, not all the other info
       (use with --$opt_verbose for slightly more syntax info)
   --$opt_veryverbose, --vv
       Same as verbose mode.
   --$opt_verbose, -v
       Verbose mode. Show the pattern being matched, then the
       actual matching lines first, and finally the block
       (with matches repeated).
   --$opt_version
       Display the version number of this routine

By default, input is from STDIN and output is to STDOUT. The
string "STDIN" may be one of the input pathnames specified.

EXAMPLES
--------

Find all blocks of lines which start with "begpat", end with "endpat"
and contain the pattern "pat":

   $progname  --begin=begpat --end=endpat --pattern=pat
+;
 }
}
# ----------
# Sho error codes
#  &show_error_codes(%ermcf);
# where: %ermcf is a hash of the error exits and reasons
sub show_error_codes
{
 my (%ermcf) = @_;
 my ($key);
  
 print STDERR  qq+
Error exit codes:
+;
 foreach $key (sort keys %ermcf)
 {
  printf STDERR ("%5s  =  %s\n",$key,$ermcf{$key});
 }
} 
# ----------
