Problem with deleting a hash key

[smrobin]

Hey Monks - this is my first post - but I have loved what I have learned so far from this site! Anyway - I am working on a report in perl that connects to a Postgres database. I have to search a ton of different tables to find the record I need. I am using several hashes to sort keys and stuff. I am also using a hash to search for each key value. If I find it, I want to delete it's key from the hash. In the end, every keys I don't find I have to print out saying that no record was found. The problem is, even though the program is not finding the key value - it is still deleting it. So Monks - any suggestions or help? Here is my code: Update - here is the complete code with all declarations.

#!/usr/bin/perl -w

use strict;
use DBI;

my $sec;
my $ix = 0;
my @rec;
my %list;
my %stuff;
my $memid;
##declare variables

open(INFILE, "input_file.csv") || die "Cannot open file!";
<INFILE>;
while(<INFILE>)
{
        $ix++;
        chomp;
        chop;
        my $rec = $_;
        #print "processing $rec\n";
        $sec = [split(/\;/,$_)];
        if ((scalar(@$sec) >0))
        {
                if (length($sec->[9]) >12)
                {
                        $memid = lc(substr($sec->[9],4,8));
                } else {
                        $memid = $sec->[9];
                        if ($memid eq '')
                        {
                                $memid = "FORCEMEMID";
                        }
                }
        $list{$memid}{$ix} = $sec;
        }
}


foreach my $lookup (sort keys %dbsrv)
{
        #print "Server: $dbsrv{$lookup}{'server'} Database: $dbsrv{$lo
+okup}{'database'}\n";

        my $server = $dbsrv{$lookup}{'server'};

        my $db = $dbsrv{$lookup}{'database'};

        my $dbh = DBI->connect("dbi:Pg:dbname =$db;host=$server","user
+name","password");

        if ($dbh)
        {
                foreach my $key (sort keys %list)
                {
                        my $hpt = $list{$key};
                #       print "$hpt\n";
                        my %rhsh = %$hpt;
                        foreach my $rpt (sort keys %rhsh)
                        {
                                #print "$rpt\n"; - Prints out the reco
+rd number
                                my $ptrx = $rhsh{$rpt};
                                my @drec = @$ptrx;
                                my $phone = $drec[1];
                                #print "$phone\n";
                                my @dbrec = getRecord($phone,$dbh);
                                if (@dbrec)
                                {
                                        if (scalar(@dbrec) > 6 )
                                        {
                                                                      
+                          for (my $ix=0; $ix < scalar(@dbrec); $ix++)
                                                {
                                                        if(! defined($
+dbrec[$ix])) {$dbrec[$ix] ='';}
                                                }
                                                print "$drec[0]|$drec[
+1]|$drec[2]|$drec[3]|$drec[4]|$drec[5]|$drec[6]|$drec[7]|$drec[8]|$dr
+ec[9]|";
                                                print "$drec[10]|$drec
+[11]|$drec[12]|$drec[13]|";
                                                print "$dbrec[0]|$dbre
+c[1]|$dbrec[2]|$dbrec[3]|$dbrec[4]|$dbrec[5]|$dbrec[6]|$dbrec[7]\n";
                                                #       delete $list{$
+key};
                                        }delete $list{$key};
                                }
                        }
                }
        }
}

print "Now print out records that could not be matched\n";
foreach my $key (keys %list)
{
        my $nref;
        my @nrec;
        my $apt;
        my $nphone;
        my $nptr;
        my %nlst;

        $nref = $list{$key};
        %nlst = %$nref;
        foreach my $nrecno (keys %nlst)
        {

                $nptr = $nlst{$nrecno};
                @nrec = @$nptr;
              
                print "$nrec[0]|$nrec[1]|$nrec[2]|$nrec[3]|$nrec[4]|$n
+rec[5]|$nrec[6]|$nrec[7]|$nrec[8]|$nrec[9]|";
                        print "$nrec[10]|$nrec[11]|$nrec[12]|$nrec[13]
+|$nrec[14]|Not Found\n";
                }
        }
}

close(INFILE);



sub findDbandServer()
{
                my $db;
                my $server;
                my $dbh = DBI->connect("dbi:Pg:dbname=#######;host=###
+####","#####","#######");
                my $pst = $dbh->prepare("Select dbname,server From tab
+le);
                $pst->execute;
                my %dbhash;
                my $ref;
                while (my @row = $pst->fetchrow_array())
                {
                   ($db, $server) = @row;
                   $dbhash{$db}{'database'} = $db;
                   $dbhash{$db}{'server'} = $server;
                }
                return %dbhash;

}
sub getRecord()
{
        my $btn = shift;
        my $dbh = shift;
#print "getRecord: Btn: $btn Dbh: $dbh\n";
        my %dbhash;
        my @row;
        my $pst = $dbh->prepare("select first,last, dest, address1, ad
+dress2,day, night,round((cast(recur as numeric) / freq ),2) as revenu
+e
                                        from table1 so join table2 cs 
+on so.svc = cs.svc
                                                                 join 
+table3 cp on cs.pkg = cp.pkg
                                                                 join 
+table4 pp on pp.pkgpart = cp.pkgpart
                                                                 join 
+table5 c on c.cust = cp.cust
                                                                 join 
+table6 ci on ci.cust = c.cust
                                        Where so.value = '$btn'");


        $pst->execute;

        @row = $pst->fetchrow_array();
        return @row;
}

[cLive ;-)]

Um. Well. There's quite a few stumbling blocks here:

• I'd change the DBI connect to throw an error if it fails rather than use a conditional after.
• explain what %list is, since you don't include the declaration code here.
• same for getRecord()
• remove fluff code - the "if (scalar(@dbrec) > 6 )" has nothing to do with whether the key is deleted. heh, maybe that's the bug though and the delete line should be on the other side of the closing brace?
• in this context, the "if (@dbrec)" conditional is pointless too

Maybe then we'll have a chance at helping you...

[graff]

You said:

The problem is, even though the program is not finding the key value - it is still deleting it.

I'm trying to figure out how you are able to reach this conclusion. I had to modify the code so that I could read it (fix indentation, remove unnecessary variable declarations, and generally simplify things), but having done that, I don't see anything in the code that would be deleting hash keys unless the hash data produced at least one non-empty return from at least one database server.

I noticed that when a db query returns a row, you want to print out the row from the db together with the data from the "input_file.csv" that was used to make the query. The query is always asking for eight fields, so if there was a matching row, the returned array should have 8 elements (even if some of them are undef/null). This means that the second "if" statement in this snippet should be unnecessary:

        if (@dbrec) {
            if ( @dbrec > 6 ) {
                $_ ||= '' for ( @dbrec );
                print join( '|', @drec[0..13], @dbrec[0..7] ), "\n";
            }
            delete $list{$key};
        }

(That's an example of how I simplified the original -- I believe this version should do the same thing as the original code, and it's a lot easier to read.) My point here is that you could remove the second "if" statement, leaving just one "if" block with 3 lines of code (a one-line "for" loop, a "print", and a "delete").

Anyway, when you say "it's not finding a match, but it's still deleting the key", is this because you are not seeing the sort of lines printed by that snippet, and you are also not seeing any lines printed from the later "for" loop?

Try stepping through the script with "perl -d" (run it under the perl debugger). Best plan would be to set a breakpoint at the line that is supposed to delete a hash key, and check the values of relevant variables when you get to that line (if you get to that line).

Adding "use Data::Dumper" to the script will also help, because that lets you run "print Dumper($hashref)" as a debugger command, so you can see what the data really looks like. I'm guessing there may be something unexpected in your "input.csv" file (or in how it actually works with the query).

One last suggestion: I think you are wasting a lot of execution time (and server resources) by preparing your query on every iteration. You would be better off with a loop structure where you prepare the query just once for each db connection, using a "?" placeholder for the variable, like this:

my $sql = <<ENDSQL;
select ...
  from ...
       ...
  where so.value = ?
ENDSQL

for my $lookup ( sort keys %dbsrv ) {
    # ... make the connection as you do now
    do { warn "server $lookup: connect failed\n"; next }
        unless $dbh;

    my $sth = $dbh->prepare( $sql );  # "prepare" once
    do { warn "server $lookup: prepare failed\n"; next }
        unless $sth;

    for my $key (sort keys %list) {
        for my $rpt ( sort keys %{$list{$key}} ) {
            my @drec = @{$list{$key}{$rpt}};
            my $phone = $drec[1];
            $sth->execute( $phone );   # "execute" repeatedly
            my @dbrec = $sth->fetchrow_array;
            if ( @dbrec ) {
                ...
            }
        }
    }
}

(update: deleted an unnecessary line of code from the second "for" loop)

In addition to being simpler, faster and more efficient, that approach is also safer / more reliable (in case the input data that you pass to the query happens to contain an apostrophe, for instance).

update: Forgot to mention: I can understand that as you loop over different servers, you don't want the script to "die" just because a connection or a query happens to fail on one of them. But you really should add some warnings that let you know when a given server did not work as expected. I just updated the last snippet above (within a few minutes after posting it) to include such warnings: do {warn "..."; next} unless ( ... );

[superfunkylistic]

Part I
The while loop looks better like this:

open (INFILE, "input_file.csv") || die "Cannot open file!";
<INFILE>;
while (<INFILE>)
{
    $ix++;

    $sec = [ split(/\;/, $_) ];
    next unless (scalar(@$sec))
    
    if (length($sec->[9]) > 12)
    {
        $memid = lc(substr $sec->[9], 4, 8);
    } else {
        $memid = $sec->[9] eq '' ? 'FORCEMEMID' : $sec->[9];
    }
    $list{$memid}{$ix} = $sec;
}


If $memid don't have the data in the last index of @$sec you don't need the chomp and the chop.
Where is declared %dbsrv?
End of Part I