#!/opt/perl/bin/perl -w
$vernum = "1.2 - 17 MAR 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.
#
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);
#
# Option defaults
$opt{'begin'}     = '';
$opt{'count'}     = $false;
$opt{'end'}       = '';
$opt{'except'}    = $false;
$opt{'help'}      = $false;
$opt{'ignore'}    = $false;
$opt{'listfiles'} = $false;
$opt{'matches'}   = $false;
$opt{'out'}       = "";
$opt{'pattern'}   = '';
$opt{'quiet'}     = $false;
$opt{'suppress'}  = $false;
$opt{'verbose'}   = $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
 suppress|s
 verbose|v
 );
$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{'count'} || $opt{'matches'})
{
 if ($opt{'count'} && $opt{'matches'})
 {
  print STDERR "ERROR: -c and -m are mutually exclusive options\n";
  &syntax_message ();
  exit (1);
 }
 else
 {
  # Then some other values are implied
  $opt{'quiet'} = $true;
  $opt{'verbose'} = $false;
  $outputOK = $false;  # Suppress normal output lines
 }
}

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

unless ($opt{'quiet'})
{
 &dooutput ($outhandle,"$scriptleaf - $vernum\n");
}

if ($opt{'help'})
{
 &syntax_message ();
 exit (1);
}

#
# Verify required options are present, and other checks

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

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

# The pattern needed (duh):
if (! $opt{'pattern'})
{
 # Error
 print STDERR "$scriptleaf ERROR: pattern required\n";
 &syntax_message ();
 exit (1);
}
elsif ($opt{'verbose'})
{
 print "Searching for '$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{'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')" ;
  }
 }
 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{'pattern'}/ ||
       ($opt{'ignore'} && $line =~ /$opt{'pattern'}/i))
   {
    $matchlines++; # Count match
    $matchlinblk++; # Count match in this block
    if ($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{'end'}/)
    {
     # Found end of this block, decide if it is "good"
     $heldlines .= "$line\n" unless ($opt{'suppress'});
     &checkblock;
     $heldlines = "";    # Go back to non-hold mode
     $holdline1 = 0;     # Stop holding
     $matchlinblk = 0;   # Clear match lines in this block
    }
   }

   # Now look to see if this also starts a new block:
   if ($line =~ /$opt{'begin'}/)
   {
    # Found start pattern, start holding
    $matchlinblk = 0;     # Clear match lines in this block
    $holdline1 = $lineno; # Remember first line number
    if (! $blockno || $opt{'begin'} ne $blankline)
    {
     $heldlines .= "$line\n" unless ($opt{'suppress'});
    }
   }
   elsif ($holdline1)
   {
    # Gather lines if we are in that "potential" mode
    $heldlines .= "$line\n";
   }
  }

  # Did we have remaining stuff to consider?
  if ($heldlines)
  {
   # See if the last block needs to be processed
   if ($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{'count'})
 {
  &dooutput ($outhandle,"$matchblocks\n");
 }
 if ($opt{'matches'})
 {
  &dooutput ($outhandle,"$matchlines\n");
 }
 if ($outputOK && ! $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{'quiet'})
 {
  &dooutput ($outhandle,"No matching blocks found.\n");
 }
}
# - - -

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

# See if we need to close output
if ($outhandle ne $stdout)
{
 # Close alternate output file
 close ($outhandle) ;
}
exit (0);
### 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{'except'})
  {
   &showblock;        # Show it
  }
 }
 else
 {
  # It does not contain our pattern
  if ($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{'suppress'})
 {
  # If suppressing begin and end lines, alter lines displayed
  $displine1++;
  $displine2--;
 }
 unless ($opt{'quiet'})
 {
  if ($outputOK)
  {
   &dooutput ($outhandle,"Block $blockno");
   &dooutput ($outhandle," lines $displine1 - $displine2:\n");
  }
 }
 if ($outputOK)
 {
  &dooutput ($outhandle,"$heldlines");
 }
 unless ($opt{'quiet'})
 {
  &dooutput ($outhandle,"\n"); # Separate blocks
 }
}
# --------------------
#
# Print syntax message
sub syntax_message
{
 my ($progname);

 chomp ($progname = `basename $0`);
 print STDERR  qq
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)

Syntax:

   $progname  [ options ] [pathname(s)]

Where 'options' are:

   -b,--begin
       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.
   -c,--count
       Show only a count of the number of matching blocks
   -e,--end
       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.
   -h, --help
       Print this help message
   -i, --ignore
       Ignore case when doing pattern match.
   --lf,--listfiles
       List (each) file name before displaying patterns.
   -m,--matches
       Show only a count of the number of matching lines
   -o --out
       Pathname for an output file other than STDOUT.
   -p, --pattern
       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).
   -q, --quiet
       Do not show supporting info lines, just results
   -s, --suppress
       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.)
   -v, --verbose
       Verbose mode. Show the pattern being matched, then the
       actual matching lines first, and finally the block
       (with matches repeated).
   -x,--except
       Show all blocks except those which contain a match for
       the specified pattern.

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

;
}
