hash help

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

Here is my entire code:

use warnings;
use strict;
use diagnostics;


my $file_to_process = $ARGV[0];
my $file_to_create = $ARGV[1];
my $curr_acctn = 0;
my $first_time = "yes";
my @account_list = ();
my $alpha_chrg_credit = '';
my %bundle;


open FH1, ">$file_to_create" or die "Cannot create $file_to_create";
open FH, $file_to_process or die "Cannot open $file_to_process";

while (<FH>) {
  chomp;
  &rtrim($_);
  
  my @fields = split;
  my $acctn = substr($fields[0],3,10);
  
  if($acctn != $curr_acctn) {
    if($first_time eq "yes") {
      $first_time = "no";
    }  else {
       #print FH1 "**************************\n";
       #print FH1 "Charges for account number ----> $curr_acctn:\n";
       foreach my $account (@account_list) {
          my $charge_code = substr($account,20,7);
          my $chrg_credit = substr($account,0,2);
          my $date = substr($account,14,6);
          if ($chrg_credit == 42) {
              $alpha_chrg_credit = "CH";
              substr($account,0,2) = "CH ";
              substr($account,32,3) = " LAB";
          } else {
              $alpha_chrg_credit = "CR";
              substr($account,0,2) = "CR ";
              substr($account,32,3) = " LAB";
          }
          
          #print FH1 "The charge or credit is: $chrg_credit\n";
          #print FH1 "The charge code is: $charge_code\n";
          
          if ($account !~ /.{21}40[68]/) {
              if ($charge_code != 4039252 && $charge_code != 4039139 &
+& $charge_code != 4039140) {
              print FH1 "$account\n";
              }
              
          }
          if ($charge_code == 4039252) {
              
              $account = "";
              $account = "$alpha_chrg_credit 0$curr_acctn ${date}40331
+58 001 LAB\n$alpha_chrg_credit 0$curr_acctn ${date}4033240 001 LAB\n$
+alpha_chrg_credit 0$curr_acctn ${date}4039241 001 LAB";
              print FH1 "$account\n";
              
          }   
          if ($charge_code == 4367958) {
              
              $account = "";
              $account = "$alpha_chrg_credit 0$curr_acctn ${date}43679
+58 001 LAB\n$alpha_chrg_credit 0$curr_acctn ${date}4367959 001 LAB";
              print FH1 "$account\n";
              
          }
          
          #if ($charge_code == 4039139) {
           #   $bundle{$charge_code} += 1;
            #  foreach my $key (sort keys %bundle) {
             #    print "$account contained...$key => $bundle{$key}\n"
+;  
              #}  
          #}
          
          if ($charge_code == 4039140) {
              $bundle{$charge_code} += 1;
              foreach my $key (sort keys %bundle) {
                 print "$account contained...$key => $bundle{$key}\n";
+  
              }  
          }
          
       }
       @account_list = ();
       undef %bundle;
       
    }
  }
  $curr_acctn = $acctn;
  push (@account_list, $_);
  
}
close FH;
close FH1;
sub rtrim()
{
  $_ =~ s/\s+$//;  
}
[download]

The part I am stuck on is here:

if ($charge_code == 4039140) {
              $bundle{$charge_code} += 1;
              foreach my $key (sort keys %bundle) {
                 print "$account contained...$key => $bundle{$key}\n";
+  
              }  
}
[download]

Here is the logic I need to add

if all of these records ($charge_code) are present for a particular account ($acctn), they are deleted (not written out) and a record with a new charge code is created. 4039139 and 4039140 ==> 4039142 (new charge code) If 4039139 or 4039140 are found by themselves then just write out. If they are found together, then create a new charge line per grouping. I starting building a hash for these grouping, but I am sure to write it out per this logic.

So an input file could be this

4201034600031 1212104034111 001                                       
+          
4201034600031 1212104033180 001                                       
+          
4201034600031 1212104039140 001                                       
+          
4201034600031 1212104039139 001                                       
+          
4201034600031 1212104039463 001                                       
+          
4201034600031 1212104039295 001                                       
+          
4201034600031 1212104039140 001                                       
+          
4201034600031 1212104039139 001                                       
+          
4201034600031 1212104045022 001                                       
+          
4201034600031 1212104045019 001                                       
+          
4201034600031 1212104045022 001
[download]

and output file should look like this

CH 01034600031 1212104034111 001 LAB
CH 01034600031 1212104033180 001 LAB
CH 01034600031 1212104039142 001 LAB
CH 01034600031 1212104039463 001 LAB
CH 01034600031 1212104039295 001 LAB
CH 01034600031 1212104039142 001 LAB
CH 01034600031 1212104045022 001 LAB
CH 01034600031 1212104045019 001 LAB
CH 01034600031 1212104045022 001 LAB
[download]

THANKS PERLMONKS

Comment on hash help Select or Download Code

Replies are listed 'Best First'.
Re: hash help by graff (Chancellor) on May 04, 2011 at 04:10 UTC
Actually, if you run the code as posted with `perl -d` and the sample input you showed us, the problem would seem to be here: `if($acctn != $curr_acctn) { ...` [download] Given the posted sample data, and the logic for assigning values to "$acctn" and "$curr_acctn", that "if" condition is only true for the first line of input (and on that iteration, the only thing you do inside the "if" block is `$first_time = "no";` The debugger shows this if you set a break point at line #29, which is the first line inside the block of that is supposed to do all the real work: `foreach my $account (@account_list) { ...` [download] The program runs to "completion" without ever reaching that line, because the $acctn is always equal to $curr_acctn (except on the first iteration, where line 29 doesn't come into play). Since nothing inside that block is ever reached, nothing gets printed to the output file. If you're seeing some different problem, you must be using code and/or data that are different from what you've posted here. It took me a while to figure out how your sample input relates to the desired output. Something like the following might suffice -- I'm not sure I really understand all the details of the intended application, but this creates the desired output for the given input: #!/usr/bin/perl use strict; ( @ARGV == 2 and -f $ARGV[0] ) or die "Usage: $0 input.file output.file\n"; my $outname = pop @ARGV; open( OUT, ">", $outname ) or die "$outname; $!\n"; my $prev_rec; while (<>) { s/^42/CH /; s/\s+$/ LAB\n/; if ( ! $prev_rec ) { $prev_rec = $_; next; } if (( /4039140\s/ and $prev_rec =~ /4039139\s/ ) or ( /4039139\s/ and $prev_rec =~ /4039140\s/ )) { s/40391(?:39\|40)(?=\s)/4039142/; print OUT; $prev_rec = ''; } else { print OUT $prev_rec; $prev_rec = $_; } } print OUT $prev_rec if ( $prev_rec ); [download] That obviously pays no attention to lots of policy details implicit in the OP, but perhaps it provides a template that you can build on.	[reply] [d/l] [select]
Re^2: hash help by cesear (Novice) on May 04, 2011 at 12:34 UTC
The code works for me. It may be I am running on windows and you on unix. Any ideas an how to modify the hash to get this to work? another sample input 4201034500194 1212104039252 001 + 4201034300473 1212104034111 001 + 4201034300473 1212104033180 001 + 4201034300473 1212104039098 001 + 4201034300473 1212104039097 001 + 4201034300473 1212104039098 001 + 4201034300473 1212104039098 001 + 4201034600043 1212104034111 001 + 4201034600043 1212104033180 001 + 4201034600043 1212104039049 001 + 4201034600043 1212104039396 001 + 4201034600043 1212104039443 001 + 4201034600043 1212104039295 001 + 4201034600043 1212104039995 001 + 4201034500194 1212104033298 001 + 4201034500194 1212104039252 001 + 4201034500194 1212104039539 001 + 4601034500194 1211104039140 001 + 4201034100433 1212104367958 001 + 4201034300473 1212104039097 001 [download] output as my code is written now CH 01034500194 1212104033158 001 LAB CH 01034500194 1212104033240 001 LAB CH 01034500194 1212104039241 001 LAB CH 01034300473 1212104034111 001 LAB CH 01034300473 1212104033180 001 LAB CH 01034300473 1212104039098 001 LAB CH 01034300473 1212104039097 001 LAB CH 01034300473 1212104039098 001 LAB CH 01034300473 1212104039098 001 LAB CH 01034600043 1212104034111 001 LAB CH 01034600043 1212104033180 001 LAB CH 01034600043 1212104039049 001 LAB CH 01034600043 1212104039396 001 LAB CH 01034600043 1212104039443 001 LAB CH 01034600043 1212104039295 001 LAB CH 01034600043 1212104039995 001 LAB CH 01034500194 1212104033298 001 LAB CH 01034500194 1212104033158 001 LAB CH 01034500194 1212104033240 001 LAB CH 01034500194 1212104039241 001 LAB CH 01034500194 1212104039539 001 LAB CH 01034100433 1212104367958 001 LAB CH 01034100433 1212104367958 001 LAB CH 01034100433 1212104367959 001 LAB [download]	[reply] [d/l] [select]