[SPOILER] Perl 'Easy' Quiz of the Week #2005-1

#!C:\perl\bin\perl

=pod

=head1 NAME

ricfiltr  -- Program to insert '.M' records as necessary

=head1 SYNOPSIS

S<B<perl ricfiltr.pl> [I<infile> [I<outfile>]]>

=head1 DESCRIPTION

This program examines each group of input lines with the same prefix.
If none of the lines has the suffix 'M', a line I<prefix>.M is inserted.
L<"FILES"> for details of "prefix" and "suffix".

=head1 OPTIONS

=over 4

=item infile (default: STDIN)

=item outfile (default: STDOUT)

This option is not valid unless infile is also specified.

=back

=head1 DIAGNOSTICS

Fatal Errors

=over 4

=item "usage: perl ricfiltr.pl [infile [outfile]]"

To many arguments on command line. L<"SYNOPSIS">

=item "unable to open output file I<outfile>"

You probably do not have write access to the directory.

=item "unable to open input file I<infile>"

File does not exist or current directory is set incorrectly.

=back

Warnings

=over 4

=item "Invalid input line -- line ignored"
 (invalid line)

Invalid line found in input.
It is B<NOT> coppied to output.

=back

=head1 EXAMPLES

=over 4

=item Output to STDOUT

      perl ricfiltr.pl test1

=item Output to file

       perl ricfiltr.pl test2 result2

=item Filter

       echo C.X| perl ricfiltr.pl | more

=back

=head1 ENVIROMENT

There are no known references to enviroment variables.

=head1 FILES

Input and output files have identical format.
They consist of zero or more lines sorted into alphabetical order.

Each line consists of a prefix, a period, and a suffix (without any whitespace).

The prefix consists of one or more "word characters".

The suffix consists of a single upper case letter.


=head1 TEST

The following examples have been tested only under Windows ME.


=head2 Add .M line after last line

 echo C.X > test1
 perl ricfiltr.pl test1

     C.M
     C.X

=head2 Add .M lline before first line


 echo C.G > test2
 perl ricfiltr.pl test2

     C.G
     C.M

=head2 Null input file

 perl ricfiltr.pl nul
 (No output)

=head2 File consists only of a .M record.

 echo C.M > test4
 perl ricfiltr.pl test4

     C.M

=head2 Test case provided by qotw.

 type test5        (cat test5 in unix)
     ALDA.D
     ALDA.Q
     ALDA.W
     AMTA.B
     AMTA.E
     AMTA.M
     AMTA.X
     BMX.F
     C.X
     DMZ.A

 perl ricfiltr.pl test5
     ALDA.D
     ALDA.M
     ALDA.Q
     ALDA.W
     AMTA.B
     AMTA.E
     AMTA.M
     AMTA.X
     BMX.F
     BMX.M
     C.M
     C.X
     DMZ.A
     DMZ.M

=head1 NOTES

This program implements the perl-qotw "Easy Quiz of the Week 2005-1"

This documentation is intended to conform to the manpage spec in
perldoc pod2man.

=head1 AUTHOR

Willilam K. Smith

=cut

use strict;
use warnings;

if (@ARGV > 2) {  # More than 2 arguments?
	die "
	
	usage:
	perl ricfiltr.pl [infile [outfile]]\n\n\n";
}

if ($ARGV[0]){
	open (INFILE, $ARGV[0]) or die
		"unable to open input file $ARGV[0]\n";

	if ($ARGV[1]){
		open (OUTFILE, '>', $ARGV[1]) or die 
			"unable to open output file $ARGV[1]\n";

	}else{ # No output specified.  Use default.
		*OUTFILE = *STDOUT;
	}

}else{ # No files specified.  Use defaults.
	*INFILE = *STDIN;
	*OUTFILE = *STDOUT;
}

my $oldprefix='';
my $mflag=0; # .M line has not yet been printed.
my $prefix;
while (<INFILE>){
	
	($prefix, my $suffix) = (/^(\w+)\.([A-Z])\n?$/);

	unless (defined $prefix and defined $suffix){
		warn "Invalid input line -- line ignored\n$_\n";
		next;
	}

	if ($prefix gt $oldprefix){ # Start of new group?

# 		Put .M line at end of  previous group (if needed)
		print OUTFILE "$oldprefix.M\n" unless ($mflag or $oldprefix eq '');
#		Start new group
		$mflag = 0;
		$oldprefix = $prefix;
	}
	
	unless ($mflag){  # .M line for group not already output?
		if ($suffix ge 'M'){
			$mflag = 1;
			if ($suffix gt 'M'){
#				Put .M line before current line
				print OUTFILE "$prefix.M\n"; 
			}
		}
	}

	print OUTFILE; # print input record

} # End of main loop

# .M record for end of last group (if needed)
print OUTFILE "$prefix.M\n" unless $mflag or !defined $prefix;



sub gethandles{

	return (*STDIN, *STDOUT);	
}