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

Bill Smith <[email protected]> Sun, 30 Jan 2005 18:32:28 -0500
Newsgroups gmane.comp.lang.perl.qotw.discuss
Message-ID <002001c50723$f85e3320$ab00a8c0@hfwk801>
I had never considered David's reluctance to open attachments.  Here is my solution again (with one minor simplification suggested by Roger Burton West.)


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;