Re: problem with foreach statement

[ultibuzz]

hi my script is ready , it will grab a bunch of logs and filter it with values provided by MSISDN file and sort it to different hashs to sppol out mail files ( i dont implement automails because i want to check first)
there are definatly a lots of thinks i can do better but im quit happy that it works ;D
sugestions of how i can do better are welcome ;D

#!/usr/bin/perl -w

use strict;
use File::Spec;

my $spec_text = qr/Smt22/;
my $path_tmp = $0; 
(my $volume,my $directories,my $file) = File::Spec->splitpath( $path_t
+mp );
my $path = $volume . $directories;
opendir (DIRREN, $path) || die ;
my @RENDIR = readdir (DIRREN);
close (DIRREN);
my $match_file = "MSISDN.txt";
my @matches=();
# open file and load into array
open(my $match_in, '<', $match_file) or die("open failed: $!"); my @ma
+tches_in = <$match_in>; close($match_in);
foreach my $file (@RENDIR) { if ($file =~ $spec_text){ open(my $fh_in,
+ '<', $file) or die("open failed: $!"); my @lines = <$fh_in>;    clos
+e($fh_in);
foreach my $lines (@lines) {
foreach my $matches_in (@matches_in) {
    my @matche = split(',',$matches_in);
    my $matchtmp = qr/$matche[1].*(Returned error code 52|Returned err
+or code 50|Returned error code 79|Returned error code 22|Returned err
+or code 24)/;
    if($lines =~ qr/$matchtmp/) { push @matches, $lines; }}}}}
undef(@matches_in);
my @newmatch = ();
my @tmplist = ();

#split logfile line into needs and put together everything ;D
foreach my $match (@matches) { chomp $match; @newmatch = split(';',$ma
+tch);    my @tmpnewmatch = split(',',$newmatch[6]);
    #cuts the blanks @ beginning and end of each string element
    $newmatch[5] =~ s/^\s+//; $tmpnewmatch[0] =~ s/^\s+//; push @tmpli
+st, $newmatch[5] . ";" . $tmpnewmatch[0]; }

# removes duplicates and print out MD Del list
my @list= do { my %seen; grep !$seen{$_}++, @tmplist }; undef(@matches
+); undef(@newmatch); undef(@tmplist);
open(INFILE, '<', "MSISDN.txt") or die("open failed: $!");
open(MDDELOUT, '>', "MD_delete_list.txt") or die("open failed: $!");
while (<INFILE>) { my @mdmsisdn = split(',',$_); $mdmsisdn[1] =~ s/^\s
++//; foreach my $mddel (@list) { my @newmddel = split(';',$mddel); 
    if ($newmddel[0]==$mdmsisdn[1]) { print MDDELOUT "$mdmsisdn[0] ; $
+mddel \n"; }}} close(INFILE); close(MDDELOUT);

#put the list into an array to easyly search for msisdn, will pe put i
+n different hashes one for each errorcode
my %adv22=(); my %adv24=(); my %adv50=(); my %adv52=(); my %adv79=();
foreach my $list (@list) { (my $msisdn,my $adverror)= split(';',$list)
+; 
    if ($adverror eq "ADV: Returned error code 22") { $adv22{$msisdn}=
+$adverror; }
    elsif ($adverror eq "ADV: Returned error code 24") { $adv24{$msisd
+n}=$adverror; }
    elsif ($adverror eq "ADV: Returned error code 50") { $adv50{$msisd
+n}=$adverror; }
    elsif ($adverror eq "ADV: Returned error code 52") { $adv52{$msisd
+n}=$adverror; }
    elsif ($adverror eq "ADV: Returned error code 79") { $adv79{$msisd
+n}=$adverror; }
    else { print "no ADV Errors ;D" }
} undef(@list);

#open errorfiles and check if msisdn is already known then sorting to 
+existing or not
open(my $exmsisdn79, '<', "adv79.txt") or die("open failed: $!"); my @
+exerrors79 = <$exmsisdn79>; close($exmsisdn79);
my @tmpnew79=(); my @tmpold79=();
foreach my $adv79key (keys %adv79) {
   if ( grep { $adv79key == $_ } @exerrors79 ) { print "$adv79key is a
+n old error\n"; push @tmpold79, $adv79key . "\n"; } 
   else { print "$adv79key is a new error\n"; push @tmpnew79, $adv79ke
+y . "\n"; }}

open(my $exmsisdn52, '<', "adv52.txt") or die("open failed: $!"); my @
+exerrors52 = <$exmsisdn52>; close($exmsisdn52);
my @tmpnew52=(); my @tmpold52=();
foreach my $adv52key (keys %adv52) {
   if ( grep { $adv52key == $_ } @exerrors52 ) { print "$adv52key is a
+n old error\n"; push @tmpold52, $adv52key . "\n"; } 
   else { print "$adv52key is a new error\n"; push @tmpnew52, $adv52ke
+y . "\n"; }}

open(my $exmsisdn50, '<', "adv50.txt") or die("open failed: $!"); my @
+exerrors50 = <$exmsisdn50>; close($exmsisdn50);
my @tmpnew50=(); my @tmpold50=();
foreach my $adv50key (keys %adv50) {
   if ( grep { $adv50key == $_ } @exerrors50 ) { print "$adv50key is a
+n old error\n"; push @tmpold50, $adv50key . "\n"; } 
   else { print "$adv50key is a new error\n"; push @tmpnew50, $adv50ke
+y . "\n"; }}

open(my $exmsisdn24, '<', "adv24.txt") or die("open failed: $!"); my @
+exerrors24 = <$exmsisdn24>; close($exmsisdn24);
my @tmpnew24=(); my @tmpold24=();
foreach my $adv24key (keys %adv24) {
   if ( grep { $adv24key == $_ } @exerrors24 ) { print "$adv24key is a
+n old error\n"; push @tmpold24, $adv24key . "\n"; } 
   else { print "$adv24key is a new error\n"; push @tmpnew24, $adv24ke
+y . "\n"; }}

open(my $exmsisdn22, '<', "adv22.txt") or die("open failed: $!"); my @
+exerrors22 = <$exmsisdn22>; close($exmsisdn22);
my @tmpnew22=(); my @tmpold22=();
foreach my $adv22key (keys %adv22) {
   if ( grep { $adv22key == $_ } @exerrors22 ) { print "$adv22key is a
+n old error\n"; push @tmpold22, $adv22key . "\n"; } 
   else { print "$adv22key is a new error\n"; push @tmpnew22, $adv22ke
+y . "\n"; }}

#put new errors in arry to existing errors dupe check it and write bac
+k to file
foreach my $tmpexout79 (@tmpnew79) { push @exerrors79,$tmpexout79; } m
+y @newexout79= do { my %seen79; grep !$seen79{$_}++, @exerrors79 }; u
+ndef(@exerrors79);
foreach my $tmpexout52 (@tmpnew52) { push @exerrors52,$tmpexout52; } m
+y @newexout52= do { my %seen52; grep !$seen52{$_}++, @exerrors52 }; u
+ndef(@exerrors52);
foreach my $tmpexout50 (@tmpnew50) { push @exerrors50,$tmpexout50; } m
+y @newexout50= do { my %seen50; grep !$seen50{$_}++, @exerrors50 }; u
+ndef(@exerrors50);
foreach my $tmpexout24 (@tmpnew24) { push @exerrors24,$tmpexout24; } m
+y @newexout24= do { my %seen24; grep !$seen24{$_}++, @exerrors24 }; u
+ndef(@exerrors24);
foreach my $tmpexout22 (@tmpnew22) { push @exerrors22,$tmpexout22; } m
+y @newexout22= do { my %seen22; grep !$seen22{$_}++, @exerrors22 }; u
+ndef(@exerrors22);

open(OUT22, '>', "adv22.txt") or die("open failed: $!"); foreach my $n
+ewout22 (@newexout22) { print OUT22 $newout22; } undef(@newexout22);
open(OUT24, '>', "adv24.txt") or die("open failed: $!"); foreach my $n
+ewout24 (@newexout24) { print OUT24 $newout24; } undef(@newexout24);
open(OUT50, '>', "adv50.txt") or die("open failed: $!"); foreach my $n
+ewout50 (@newexout50) { print OUT50 $newout50; } undef(@newexout50);
open(OUT52, '>', "adv52.txt") or die("open failed: $!"); foreach my $n
+ewout52 (@newexout52) { print OUT52 $newout52; } undef(@newexout52);
open(OUT79, '>', "adv79.txt") or die("open failed: $!"); foreach my $n
+ewout79 (@newexout79) { print OUT79 $newout79; } undef(@newexout79);

#printing out final records to mail ;D
open(OUTMAIL22, '>', "adv22_mail.txt") or die("open failed: $!"); prin
+t OUTMAIL22 "Here goes the text needed befor MSISDN \n NEW MSISDNs\n\
+n"; foreach my $mail22 (@tmpnew22) { print OUTMAIL22 "$mail22"; } pri
+nt OUTMAIL22 "\n EXISTING MSISDNs\n"; foreach my $mailold22 (@tmpold2
+2) { print OUTMAIL22 "$mailold22"; } close(OUTMAIL22); undef(@tmpold2
+2); undef(@tmpnew22);
open(OUTMAIL24, '>', "adv24_mail.txt") or die("open failed: $!"); prin
+t OUTMAIL24 "Here goes the text needed befor MSISDN \n NEW MSISDNs\n\
+n"; foreach my $mail24 (@tmpnew24) { print OUTMAIL24 "$mail24"; } pri
+nt OUTMAIL24 "\n EXISTING MSISDNs\n"; foreach my $mailold24 (@tmpold2
+4) { print OUTMAIL24 "$mailold24"; } close(OUTMAIL24); undef(@tmpold2
+4); undef(@tmpnew24);
open(OUTMAIL50, '>', "adv50_mail.txt") or die("open failed: $!"); prin
+t OUTMAIL50 "Here goes the text needed befor MSISDN \n NEW MSISDNs\n\
+n"; foreach my $mail50 (@tmpnew50) { print OUTMAIL50 "$mail50"; } pri
+nt OUTMAIL50 "\n EXISTING MSISDNs\n"; foreach my $mailold50 (@tmpold5
+0) { print OUTMAIL50 "$mailold50"; } close(OUTMAIL50); undef(@tmpold5
+0); undef(@tmpnew50);
open(OUTMAIL52, '>', "adv52_mail.txt") or die("open failed: $!"); prin
+t OUTMAIL52 "Here goes the text needed befor MSISDN \n NEW MSISDNs\n\
+n"; foreach my $mail52 (@tmpnew52) { print OUTMAIL52 "$mail52"; } pri
+nt OUTMAIL52 "\n EXISTING MSISDNs\n"; foreach my $mailold52 (@tmpold5
+2) { print OUTMAIL52 "$mailold52"; } close(OUTMAIL52); undef(@tmpold5
+2); undef(@tmpnew52);
open(OUTMAIL79, '>', "adv79_mail.txt") or die("open failed: $!"); prin
+t OUTMAIL79 "Here goes the text needed befor MSISDN \n NEW MSISDNs\n\
+n"; foreach my $mail79 (@tmpnew79) { print OUTMAIL79 "$mail79"; } pri
+nt OUTMAIL79 "\n EXISTING MSISDNs\n"; foreach my $mailold79 (@tmpold7
+9) { print OUTMAIL79 "$mailold79"; } close(OUTMAIL79); undef(@tmpold7
+9); undef(@tmpnew79);

[graff]

sugestions of how i can do better are welcome

OK, here goes...

1. Try using perltidy on this script, and then try writing your code according to that general style as a habit. When I did "perltidy 520234.pl -o 520234_tidy.pl", the output file was 252 lines instead of the original 99, but on the whole it was a lot more legible.
2. You seem to be doing a lot of "copy/paste/modify" style coding -- lots of little blocks of lines that are all very similar to each other with just a few regular differences among the various copies. For each set of repeated code blocks, you would probably be better off using a subroutine or an outer loop over the distinct parameter values. Not only would this reduce the line count by 50% or more, but it would make the script easier to maintain and upgrade.
3. Among the parameters that vary across your repeated code blocks are array names like "@newexout79", file handle names like "OUTMAIL79", etc. These cry out for a hash data structure, which would make it a lot easier to reduce the code into a single loop over a list (i.e. the elements of the list can be the keys of the hash data structure).
4. Your first set of nested "foreach" loops is doing a lot of extra work at the innermost layer, which could be done once before starting the outermost loop. Also, it looks like you could be pushing multiple copies of a single line from some data file onto the "@matches" array, if the line happens to match multiple elements of the "@matches_in" array. (This probably isn't a problem, but there's no way to know without seeing the data.)
5. (nitpicks) You use "close" where you should use "closedir"; also, you assume (implicitly) that "$path" (derived from $0) is the current working directory (CWD), but you might want to use "chdir" to make that explicit.

Having said that, here is a "tidy" version of your code, which uses a single HoH and a single set of related arrays and file handles (instead of five distinct sets of everything), and applies most of the other suggestions listed above -- it's about 120 lines, down from the 252 of the original "tidy" version. I haven't tested it, of course, but it does pass "perl -cw", and I think it'll do the same thing as your original code. (I could be wrong about that, but this should at least give you an idea about how you can eliminate unnecessary duplication in your code.)

Read more... (5 kB)

[ultibuzz]

hi, my code in use is much more formated than the posted one ,D but your code definatly rocks thx for the advises and inspirience. after i was finished with the code and tested it ,then publish here, i began writing a module / class for it because i defenatly will need this type of process a few more times in other progrmas that will handel mostly the same data ;D im quit new to perl so it takes me some more time to get into this hash in a hash and referencing it puting stuff in subs and so on ;D , but im working on it to get better ;D ,

[ultibuzz]

your HoH gode is really really nice i tested it and its around 2-6 minuts faster.
to give some suroundings:
the script needs to filter several times a day several logs this logs are quit big between 1.000.000 - 2.600.000 lines.
now i have one problem understanding these HoH code
1. i need error 50 and 52 in one file and i have no clue how i can do it with this HoH
2. for each error i need to write a different text
3. i need to write for error 79 all MSISDN in a seperate textfile but again i dont know how to get them out of the HoH

help is definatly welcome ;D because i really stuck here

[graff]

You can look at the man pages perlreftut, perlref and perldsc for more info on using HoH and similar data structures. As for your specific "changes":

1. i need error 50 and 52 in one file and i have no clue how i can do it with this HoH
2. for each error i need to write a different text
3. i need to write for error 79 all MSISDN in a seperate textfile but again i dont know how to get them out of the HoH

If you have a HoH where the primary key is the error code (22 24 50 52 79), the secondary keys can include not only the "msisdn" values from the log files, but also things like text strings that you want to associate with each type of error, the name of the file where you want to write information about each type, etc.

Starting from my version of the code posted above, you could skip the use of the "@errorcodes" array, and instead initialize the "%adv" HoH as follows:

my %adv = (
            '22' => { filename => "adv22.txt",
                      message  => "Text for error code 22" },
            '24' => { filename => "adv24.txt",
                      message  => "This about error 24" },
            '50' => { filename => "adv50_and_52.txt",
                      message  => "Text for error 50" },
            '52' => { filename => "adv50_and_52.txt",
                      message  => "This is about error 52" },
            '79' => { filename => "adv79.txt",
                      message  => "Special text for code 79" },
           };
}

Then, when you get to the part near the bottom of the script where you loop over the various error codes to handle the "adv*.txt" files and send out mail messages, you can look up the filename and the message text for each error code in "$adv{$errcode}{filename}" and "$adv{$errcode}{message}".

Meanwhile, the "$msisdn" strings that are also being used as secondary hash keys in %adv will continue to work (so long as these strings never turn out to be "filename" or "message", which would overwrite the initial values assigned above).