Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Populating and accessing complicate Hashes

by jesuashok (Curate)
on Apr 24, 2006 at 03:59 UTC ( #545193=perlquestion: print w/ replies, xml ) Need Help??
jesuashok has asked for the wisdom of the Perl Monks concerning the following question:

Hi all


I have added piece of code and the Dumper Result of Hash of Hash of Hash.
=> Creating Hash of Hash of Hash
=> Printing Hash of Hash of Hash


Could anyone analyse my code and tell me how I can minimise in accesing this hash and creating this hash?
Pleae advice me that whethere my code is sufficient or not.
Please add your advice on this code To improve the performance.


Since, I got lot efficient Tips for my earlier posts, I have the hope that I will get for this writeup also.

__DATA__
PREV:RNC6.200507112330.30.RNCpm.pp 0000A15&&DO_RNC_SOURCE|130|0|20050712000000|AvgA13HoDelayPriorSessionS +ourceRncPerf|0 0000A15&&DO_RNC_SOURCE|130|0|20050711234500|AvgA13HoDelayPriorSessionS +ourceRncPerfashok|0 0000A15&&DO_RNC_SOURCE|130|0|20050712000000|AvgA13HoDelaySourceRncPerf +|0 0000N15&&DO_RNC_SOURCE|130|0|20050712000000|IpAddressSourceRncPerf|0.0 +.0.0 0000X15&&DO_RNC_SOURCE|130|0|20050712000000|MaxA13HoDelayPriorSessionS +ourceRncPerf|0 0000X15&&DO_RNC_SOURCE|130|0|20050712000000|MaxA13HoDelaySourceRncPerf +|0 0000M15&&DO_RNC_SOURCE|130|0|20050712000000|MinA13HoDelayPriorSessionS +ourceRncPerf|0 0000M15&&DO_RNC_SOURCE|130|0|20050712000000|MinA13HoDelaySourceRncPerf +|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13RejectInvalidReasonP +riorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13RejectInvalidReasonS +ourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13RejectProtSubtypeAtt +rMissingPriorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13RejectProtSubtypeAtt +rMissingSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13RejectProtSubtypeAtt +rNotRecognizedPriorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13RejectProtSubtypeAtt +rNotRecognizedSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13RejectProtSubtypeNot +RecognizedPriorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13RejectProtSubtypeNot +RecognizedSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13RejectSessionNotAuth +enticPriorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13RejectSessionNotAuth +enticSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13RejectSessionNotFoun +dPriorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13RejectSessionNotFoun +dSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13ReqTimeoutPriorSessi +onSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13ReqTimeoutSourceRncP +erf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13TotalRejectPriorSess +ionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumA13TotalRejectSourceRnc +Perf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffAttemptsP +riorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffAttemptsS +ourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureAT +InitiatedClosePriorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureAT +InitiatedCloseSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureAt +IdResponseFailurePriorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureAt +IdResponseFailureSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureAt +IdTimeoutPriorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureAt +IdTimeoutSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureHd +wIdTimeoutPriorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureHd +wIdTimeoutSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureIn +validHdwIdTypePriorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureIn +validHdwIdTypeSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureIn +validHdwIdValuePriorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureIn +validHdwIdValueSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureIn +validUatiCmpltSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureMi +scPriorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureMi +scSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureNo +RncResourceSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureNo +UatiCmpltSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureNo +UatiReqSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureRN +CInitiatedClosePriorSessionSourceRncPerf|50 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureRN +CInitiatedCloseSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureRe +trievedConfigUnacceptablePriorSessionSourceRncPerf|0 0000R15&&DO_RNC_SOURCE|130|0|20050712000000|NumDormantHandoffFailureRe +trievedConfigUnacceptableSourceRncPerf|0
The whole code is given :-
#! /usr/bin/perl ##!/usr/local/bin/perl -w # # # remediation_1xEVDO.pl # # This script is used to implement data remediation for Nortel + 1xEVDO # # Usage: remediation_1xEVDO.pl <config filename> <DC filename> # # # Example: # remediation_1xEVDO.pl NortelEVDO.cfg MTX41.1.20031029070000. +1xEVDO #use File::Basename; use Time::Local; #Global Variables %basic_references = (); %raw_hash = (); $inFilePath = "RNC6.200507120000.30.RNCpm.pp1"; $current_filename = `basename $inFilePath`; open (CDF,$inFilePath) or die "Cannot open $currDcFile:$!\n"; ($temp1,$current_time_stamp,$temp2) = ($current_filename =~ /(\w+).(\w ++).(.*)/); $previous_file_name = get_previous_filename($temp1,$current_time_stamp +,$temp2); form_basic_reference($current_time_stamp); for $file_name ( $previous_file_name, $inFilePath ) { open ( CDF , "$file_name" ) || die "Can't open file $file_name :$!:\n +"; while ( $line = <CDF> ) { chomp($line); ($time_reference,$actual_data) = split('&&',$line); $rem_type = substr($time_reference,4,1); if ( grep(/^$time_reference$/,keys %basic_references) ) { $section = $basic_references{$time_reference}; next if ($line =~ /^PREV/); @origRec = split(/\|/, $actual_data); $CDFEntity = shift @origRec; $PegValue = pop @origRec; $PegName = pop @origRec; $stTime = pop @origRec; @InstID = @origRec; $currEntPeg = join ("-", $CDFEntity, $PegName); $InstanceKey=join ("-",$PegName, @InstID); $main_hash{$CDFEntity}{$rem_type}{$InstanceKey}{$section} = [ $PegV +alue,$stTime,substr($time_reference,5,2) ]; $main_hash{$CDFEntity}{$rem_type}{'allnegativeflag1'} = 'false'; $main_hash{$CDFEntity}{$rem_type}{'allnegativeflag2'} = 'false'; } } } use Data::Dumper; foreach $val (keys %main_hash) { #Entity foreach $type ( keys %{$main_hash{$val}} ) { #rem_type $total_R_count = keys %{$main_hash{$val}{'R'}}; #print "Rem_count :$total_R_count:\n"; $diff_negative_count_2 = 0; $diff_negative_count_1 = 0; foreach $pegs ( keys %{$main_hash{$val}{$type}} ) { $T1val = defined ${$main_hash{$val}{$type}{$pegs}{'Section1' +}}[0] ? ${$main_hash{$val}{$type}{$pegs}{'Section1'}}[0] : undef; $T2val = defined ${$main_hash{$val}{$type}{$pegs}{'Section2' +}}[0] ? ${$main_hash{$val}{$type}{$pegs}{'Section2'}}[0] : undef;; $T3val = defined ${$main_hash{$val}{$type}{$pegs}{'Section3' +}}[0] ? ${$main_hash{$val}{$type}{$pegs}{'Section3'}}[0] : undef; if ( $type eq 'R' ) { $diffT1 = $T2val - $T1val if (defined $T2val && defined $T1val); $diffT2 = $T3val - $T2val if (defined $T3val && defined $T2val); ## if ($diffT1 < 0) { $diff_negative_count_1++; if ($T1val > (2**32 - 500000000)) { $diffT1 = 2**32 - $T1val + $T2val; } else { $diffT1 = $T2val; } } if ($diffT2 < 0) { $diff_negative_count_2++; if ($T2val > (2**32 - 500000000)) { $diffT2 = 2**32 - $T2val + $T3val; } else { $diffT2 = $T3val; } } ## $main_hash{$val}{$type}{$pegs}{'diff1'} = defined $diffT1 ? $diffT +1 : 'Y'; $main_hash{$val}{$type}{$pegs}{'diff2'} = defined $diffT2 ? $diffT +2 : 'Y'; } else { $main_hash{$val}{$type}{$pegs}{'diff1'} = defined $T1val ? $T1val +: 'Y'; $main_hash{$val}{$type}{$pegs}{'diff2'} = defined $T2val ? $T2val +: 'Y'; } } $main_hash{$val}{$rem_type}{'allnegativeflag1'} = 'true' if ($total_ +R_count == $diff_negative_count_1 ); $main_hash{$val}{$rem_type}{'allnegativeflag2'} = 'true' if ($total_ +R_count == $diff_negative_count_2 ); #print "Rem_count :$total_R_count: $diff_negative_count_1 : $diff_ne +gative_count_2\n"; } } #Final String Formation foreach $val (keys %main_hash) { #Entity foreach $type ( keys %{$main_hash{$val}} ) { #rem_type $printed_1 = 0; $printed_2 = 0; if ( $type eq 'R' && $main_hash{$val}{$type}{'allnegativeflag1'} eq +'true' ) { print "# Warning: No remediations for First section of $val. Syste +m might be restarted ?\n"; $printed_1 = 1; } if ( $type eq 'R' && $main_hash{$val}{$type}{'allnegativeflag2'} eq +'true' ) { print "# Warning: No remediations for Second section of $val. Syst +em might be restarted ?\n"; $printed_2 = 1; } next if ( $printed_1 == 1 && $printed_2 == 1 ); if ($printed_1 == 0 && $printed_2 == 0) { foreach $pegs ( keys %{$main_hash{$val}{$type}} ) { next if ($pegs =~ /allnegativeflag/); @returnKeyT2 = split (/-/, $pegs); $pegName = shift @returnKeyT2; $finalStringT1 = join ("\|",$val,@returnKeyT2,${$main_hash{$val}{$ +type}{$pegs}{'Section1'}}[1],$pegName,$main_hash{$val}{$type}{$pegs}{ +'diff1'}); $finalStringT2 = join ("\|",$val,@returnKeyT2,${$main_hash{$val}{$ +type}{$pegs}{'Section2'}}[1],$pegName,$main_hash{$val}{$type}{$pegs}{ +'diff2'}); #print "$finalStringT1\n"; #print "$finalStringT2\n"; } } if ($printed_1 == 1 && $printed_2 == 0) { foreach $pegs ( keys %{$main_hash{$val}{$type}} ) { next if ($pegs =~ /allnegativeflag/); @returnKeyT2 = split (/-/, $pegs); $pegName = shift @returnKeyT2; $finalStringT2 = join ("\|",$val,@returnKeyT2,${$main_hash{$val}{$ +type}{$pegs}{'Section2'}}[1],$pegName,$main_hash{$val}{$type}{$pegs}{ +'diff2'}); #print "$finalStringT2\n"; } } if ($printed_1 == 0 && $printed_2 == 1) { foreach $pegs ( keys %{$main_hash{$val}{$type}} ) { next if ($pegs =~ /allnegativeflag/); @returnKeyT2 = split (/-/, $pegs); $pegName = shift @returnKeyT2; $finalStringT1 = join ("\|",$val,@returnKeyT2,${$main_hash{$val}{$ +type}{$pegs}{'Section1'}}[1],$pegName,$main_hash{$val}{$type}{$pegs}{ +'diff1'}); #print "$finalStringT1\n"; } } } } print Dumper [ %main_hash ]; ##################### # This function forms the Basic references, which is created using the + Timestamp # for which the process goes # sub form_basic_reference # input : timestamp ##################### sub form_basic_reference { my $dateStr = shift; $Current0 = $dateStr; $Prev1 = create_reference( $dateStr , 'sub',15); $Prev2 = create_reference( $Prev1 , 'sub',15); $Current1 = create_reference( $dateStr , 'add',15); $Current2 = create_reference( $Current1 , 'add',15); $prev1 = substr($Prev1,8,4); $prev2 = substr($Prev2,8,4); $current0 = substr($Current0,8,4); $current1 = substr($Current1,8,4); $basic_references{$prev1. 'N'.'15'} = 'Section1'; $basic_references{$prev1. 'R'.'15'} = 'Section1'; $basic_references{$prev2. 'N'.'30'} = 'Section1'; $basic_references{$prev2. 'R'.'30'} = 'Section1'; $basic_references{$current0.'N'.'15'} = 'Section2'; $basic_references{$current0.'R'.'15'} = 'Section2'; $basic_references{$current0.'N'.'30'} = 'Section2'; $basic_references{$current0.'R'.'30'} = 'Section2'; $basic_references{$current1.'N'.'15'} = 'Section3'; $basic_references{$current1.'R'.'15'} = 'Section3'; } ##################### # This function forms the returns new timestamp based on the input tim +estamp # and the operation it takes as a parameter # sub create_reference # input : timestamp sub|add ##################### sub create_reference { my $dateStr = shift; my $operation = shift; my $interval = shift; #print "input :$dateStr:\n"; my $sec = 0; my ($year, $mth, $day, $hr, $min) = $dateStr =~ /^(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)$/; # Get seconds since the epoch, note months start from zero for # January to 11 for December. Add 15 minutes-worth of seconds. # my $timeVal = timelocal($sec, $min, $hr, $day, $mth - 1, $year); $timeVal += $interval * 60 if $operation eq 'add'; $timeVal -= $interval * 60 if $operation eq 'sub'; # Turn back in to separate parts, year, month etc. Note that # localtime() returns years since 1900. Construct a new date # string and return it. # my @timeParts = localtime($timeVal); my $newStr = $timeParts[5] + 1900 . sprintf("%02d", $timeParts[4] + 1) . sprintf("%02d", $timeParts[3]) . sprintf("%02d", $timeParts[2]) . sprintf("%02d", $timeParts[1]); return $newStr; } ##################### # This function returns the previous filename # by getting the current filename details # sub get_previous_filename # input : <first_part_of_file_name> <time_st +amp> <third_part_of_file_name> ##################### sub get_previous_filename { $temp1 = shift; $time_stamp = shift; $temp2 = shift; return $temp1.'.'.create_reference(create_reference($time_stamp,'sub' +),'sub').'.'.$temp2; }

"Keep pouring your ideas"

Comment on Populating and accessing complicate Hashes
Select or Download Code
Re: Populating and accessing complicate Hashes
by GrandFather (Cardinal) on Apr 24, 2006 at 04:05 UTC

    The sample data would help. I recommend that you use a __DATA__ section and replace <CDF> with <DATA> for the purposes of this post.

    Note that you really should use strict; use warnings; in all code you write!

    Where does %basic_references come from? Where is %main_hash declared?

    Update: more grumbling


    DWIM is Perl's answer to Gödel
      Hi Grandpa,

      I have updated my node as you have suggested ( added __DATA__ and changed CDF to <DATA>
      Thanks a lot.

      "Keep pouring your ideas"

        Nope, that doesn't do it. See I know what I mean. Why don't you? to see what I mean. Ideally you should post a small amount of code that can be run that generates a modest amount of output when you are asking questions like "How can I make this more efficient?" or "How can I improve this code?" so that others can reproduce your results and check that their own results are correct.


        DWIM is Perl's answer to Gödel
Re: Populating and accessing complicate Hashes
by bobf (Monsignor) on Apr 24, 2006 at 04:37 UTC

    I'm afraid I don't know what you mean when you say:

    • minimise in accesing this hash and creating this hash
    • whethere my code is sufficient or not
    • improve the performance

    For example, you can minimize accessing and creating the hash by removing the code that does those things, but I don't think that's what you mean. Sufficiency is dictated at least in part by whether or not the code meets your requirements (does it?). Re: performance, is there a specific bottleneck in your code that you're trying to refactor (i.e., have you benchmarked it?) or are you looking for general optimizations?

    If you could clarify your OP, we will be able to give you much more specific answers.

    For starters, though, you might want to consider cleaning up the innermost guts of the nested foreach loops by taking advantage of Perl's reference syntax (see perlref, perldsc, and perlreftut).

    For example, instead of using constructs like ${$main_hash{$val}{$type}{$pegs}{'Section1'}}[0] everywhere, IMO it is cleaner and possibly more efficient to add a temp variable for the innermost reference:

    my $href = $main_hash{$val}{$type}{$pegs}; my $T1val = defined $href->{'Section1'}[0] ? $href->{'Section1'}[0] : +undef;
    This will reduce the code density of the inner loop, leaving less room for typos (use strict! use warnings!) and making the code easier to read/understand/maintain.

    HTH

    Update:

    I'm confused. Why do you do this:

    $T1val = defined ${$main_hash{$val}{$type}{$pegs}{'Section1'}}[0] ? ${ +$main_hash{$val}{$type}{$pegs}{'Section1'}}[0] : undef;

    If the value is defined you assign that value to $T1val. If it is undefined you assign undef, but that is no different than what would have happened if you skipped the defined test and ternary operator. In other words, the whole line above is equivalent to this:

    $T1val = ${$main_hash{$val}{$type}{$pegs}{'Section1'}}[0];

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://545193]
Approved by GrandFather
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (3)
As of 2014-07-13 03:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (245 votes), past polls