Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Problem with deleting a hash key

by smrobin (Initiate)
on Aug 15, 2007 at 17:41 UTC ( #632811=perlquestion: print w/ replies, xml ) Need Help??
smrobin has asked for the wisdom of the Perl Monks concerning the following question:

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; }

Comment on Problem with deleting a hash key
Download Code
Re: Problem with deleting a hash key
by cLive ;-) (Parson) on Aug 15, 2007 at 18:15 UTC

    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...

Re: Problem with deleting a hash key
by superfunkylistic (Initiate) on Aug 16, 2007 at 00:06 UTC
    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
Re: Problem with deleting a hash key
by graff (Chancellor) on Aug 16, 2007 at 04:11 UTC
    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 ( ... );

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (11)
As of 2014-10-22 13:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (118 votes), past polls