TStanley has asked for the wisdom of the Perl Monks concerning the following question:

The following code is provided for your ponderance:
#!/opt/perl5/bin/perl -w
use strict;

## Setup and precompile the errorcodes ##
my $err1=qr/Disconnected/o;
my $err2=qr/sopup\.sh/o;
my $err3=qr/switch_sh\.sh/o;
my $err4=qr/Node/o;
my $err5=qr/^NetBIOS/io;
my $err6=qr/Manual/o;
my $err7=qr/Beginning/o;
my $err8=qr/AUP rejecting duplicate transaction/o;
my $err9=qr/LAN/o;

my @Messages=("$err1","$err2","$err3","$err4","$err5","$err6","$err7",
+"$err8","$err9");

## Precompile Regular Expressions
my $A=qr/(Packet ID)\s+\(hex\)\s+(\w+)\s+(Origin)\s+([\w\s]+)/o;
my $B=qr/(Date)\s+\(mm\/dd\/yyyy\)\s+(\d{2}\/\d{2}\/\d{4})\s+(Qualifie
+r)\s+(\w+)/o;
my $C=qr/(Time)\s+(\d{1,2}:\d{2}:\d{2}\.?\d{2}?)\s+(Terminal ID)\s+(\d
++)/o;
my $D=qr/(Device ID)\s+\(hex\)\s+(\w+)\s+(Application ID)\s+(\w+)/o;
my $E=qr/(Catalog Code)\s+(\w+)\s+(Function ID)\s+\(hex\)\s+(\w+)/o;
my $F=qr/(Status)\s+(-?\d+)\s+(Severity)\s+(\d+)/o;
my $G=qr/(.*)/o;

my @LineRegexs=("$A","$B","$C","$D","$E","$F");

$/="------------------------------------------------------------------
+------------\n";


my (%hash,$count,$line);
$count=1;
open(FH,"$path")||die"Can't open $File: $!\n";

while(<FH>){
  chomp;
  my @array=split /\n/;
  foreach my $line(@array){
    chomp;
    foreach my $regex(@LineRegexs){
      if($line=~$regex){
        $hash{$count}{$1}=$2;
        $hash{$count}{$3}=$4;
      }
      next;
    }
    if($line=~$G){
      $hash{$count}{'Error Message'}=$line;
      $count++;
      next;
    }else{ next; }
  }#END OF FOREACH STATEMENT
}## END OF WHILE STATEMENT ##
close FH;

[download]
The above code is not providing the expected results from the data file that I am opening. A partial file from dumping the hash (using Data::Dumper) will show what I mean:
$VAR1 = {
          '25710' => {
                       'Error Message' => 'Status             1
   Severity           2',
                       'Severity' => '2',
                       'Status' => '1'
                     },
          '25711' => {
                       'Error Message' => 'Process started tmclean.sh'
                     },
          '25712' => {
                       'Error Message' => 'Packet ID (hex)    0xF040
   Origin             UNIX    ',
                       'Origin' => 'UNIX    ',
                       'Packet ID' => '0xF040'
                     },
          '32930' => {
                       'Error Message' => 'Catalog Code       UNIX
   Function ID (hex)  0x8011',
                       'Catalog Code' => 'UNIX',
                       'Function ID' => '0x8011'
                     },

[download]
How would I go about looping through the array of regular expressions for each line, and stop once a match is found, then move on to the next line in the file?

TStanley
--------
It is God's job to forgive Osama Bin Laden. It is our job to arrange the meeting -- General Norman Schwartzkopf

Replies are listed 'Best First'.
Re: Loading a HoH
by fruiture (Curate) on Oct 11, 2002 at 16:26 UTC

    First of all, check out `perldoc -q 'quoting.*vars'`. It will lead you to perlfaq4 and you should read that.

    Second, you're nesting loops where it doesn't make sense. If you use the diamond operator, you do not have to expect $/ to be found twice in the returned string, it will be at the end of the returned string and if it isn't even there, your ate the EOF.

    Third, what do you need all those temporary variables for? It is not wrong to have them, but they're quite redundant.

    Fourth, what is @Messages good for?

    Fifth, have a look in perlop what the /o means: you don't need it.

    Sixth, '(.*)' will always match, it doesn't make much sense to use it.

    # UNTESTED
my @line_regexs = (
  qr/(Packet ID)\s+\(hex\)\s+(\w+)\s+(Origin)\s+([\w\s]+)/,
  qr/(Date) \s+ \(mm\/dd\/yyyy\) \s+ (\d{2}\/\d{2}\/\d{4})
      \s+ (Qualifier) \s+ (\w+) /x,
  # ...
);

my ($count,%hash) = (1);

open my $fh,'<', $path or die $!;
LINE: while( <$fh> ){ chomp;

   foreach my $r ( @line_regexs ){
       if( /$r/ ){
          $hash{$count}{$1} = $2;
          $hash{$count}{$3} = $4;
          next LINE;
       }
   }
   $hash{ $count++ }{'Error Message'} = $_
}

close $fh;

    [download]
    --
    http://fruiture.de
[reply]
[d/l]
Re: Loading a HoH
by Enlil (Parson) on Oct 11, 2002 at 15:46 UTC
    This is untested but should break you out of the loop: 
    ...

foreach my $regex(@LineRegexs){
    if($line=~$regex){
      $hash{$count}{$1}=$2;
      $hash{$count}{$3}=$4;
      last;  
    }
    next;
}

...

    [download]
    As last will break you out of the innermost enclosing loop which in this case is the foreach.
[reply]
[d/l]
      As a note, calling next is rather redundant since it's the last thing in the loop. All that does is restart the loop, which was going to happen anyway.
[reply]
[d/l]
Re: Loading a HoH
by TStanley (Canon) on Oct 19, 2002 at 17:33 UTC
    After a lot of playing around with the above code, I ended up scrapping it and going with a Hash of Arrays instead. By doing this, I cut the time it takes to run by 50% (from 2:36 to 1:15). I don't have access to the code itself at the moment, so I will post my final copy of it tomorrow. And to answer fruiture's above reply, the @Messages array was something that I forgot to remove from the code that wasn't used until later on in the program itself.

    Update: And as promised, here is the code for the entire program:
    #!/opt/perl5/bin/perl -w
use strict;

my $Number;
my $ln=@ARGV;
if($ln<1 or $ln>1){ die "A single Store number is required!\n"; }else{
  $Number=sprintf("%03d",$ARGV[0]);
}
## Setup the Search Date ##
my ($day,$month,$year)=(localtime(time-60*60*(12+(localtime)[2])))[3,4
+,5];
$day=sprintf"%02d",$day;
$month=sprintf"%02d",$month+1;
$year=sprintf"%04d",$year+1900;
my $Date="$month/$day/$year";
my $RegDate=qr/$month\/$day\/$year/o;

## Setup and precompile the errorcodes ##
my $err1=qr/Disconnected/o;
my $err2=qr/sopup\.sh/o;
my $err3=qr/switch_sh\.sh/o;
my $err4=qr/Node/o;
my $err5=qr/^NetBIOS/o;
my $err6=qr/Manual/o;
my $err7=qr/Beginning/o;
my $err8=qr/^AUP rejecting duplicate transaction/o;
my $err9=qr/LAN/o;
my @Messages=qw($err1 $err2 $err3 $err4 $err5 $err6 $err7 $err8 $err9)
+;
$/="------------------------------------------------------------------
+----------
--\n";


my $File="Unity$Number.log";
my $RPT=substr($File,0,8);
my $Filepath="/HOST/INDATA/stlog/$File";
my $Rptpath="/HOST/INDATA/stlog/$RPT";

open(FH,"$Filepath")||die"Can't open $File: $!\n";
my (%hash,$count);
$count=1;

while(<FH>){
  chomp;
  my @array=split /\n/;
  foreach my $msg(@Messages){
    if($array[0]=~/^Number/){}else{
      if($array[6]=~$msg & $array[1]=~$RegDate){
        my $ref=\@array;
        $hash{$count}=$ref;
        $count++;
      }
    }
  }## END OF FOREACH STATEMENT ##
}## END OF WHILE STATEMENT ##
close FH;

open(RPT,">$Rptpath")||die"Can't open $RPT: $!\n";
print RPT "Report Date: $Date\n";
print RPT "$RPT\n";
print RPT "============================\n";
foreach my $key(keys %hash){
  for(0..6){
    print RPT "$hash{$key}[$_]\n";
  }
  print RPT $/;
}
close RPT;

    [download]

    TStanley
    --------
    It is God's job to forgive Osama Bin Laden. It is our job to arrange the meeting -- General Norman Schwartzkopf
[reply]
[d/l]

Back to Seekers of Perl Wisdom