Dereferencing Hash of Arrays

J

Jennifer I. Drake

Hello,

I created a hash of arrays and I'm having problems dereferencing the
array and printing the array out. In one subroutine, I create the hash
and put the data into it. From that subroutine, I call another
subroutine and pass the reference to the hash. In the second
subroutine, I sort the hash and try to dereference the arrays. But,
when I try to print the arrays, nothing appears. I know that there is
data in the original array given to the hash and I know that the hash
keys are valid. Any help would be appreciated with where I've gone
wrong.

Thanks!
-Jen

#!/usr/bin/perl
use strict;
use warnings;

my %keys;
&GetData(\%keys);

###subroutine 1 - GetData###

### Retrieving information from a PostgreSQL database here.
my %data;
my $keysRef;

foreach my $secondKey (@{$secondKeysRef}) {
while (($key, @values) = $sth->fetchrow_array) {
$$keysRef{$key} = 1;
$data{$key}{$secondKey} = \@values;
}
&StoreData(\%data, $keysRef);
}


###subroutine 2 - StoreData###

my ($dataRef, $keysRef) = @_;

my $outputfile = "Output.txt";
open (OUT, ">$outputfile") or die "Cannot make $outputfile: $!\n";

foreach my $key (sort keys %{$dataRef}) { ##loop through each of the
first key

print OUT $key;

for (my $i = 0; $i<3; $i++) { ##loop through each of the second
keys - hardcoded for now, but will be a variables to control count
later

my $valuesRef = $$dataRef{$key}{$$keysRef[$i]};
print OUT "\t";
print OUT join ("\t", @$valuesRef);
}
print OUT "\n";
}
 
J

Jennifer I. Drake

I do have a the 'my ($keysRef) = @_' in my code. I tried to remove
some of the code to be more clear. I guess it has the opposite effect.
The rest of the code is quite long and contains a lot of
CGI/PostgreSQL calls that don't do anything with this issue, so I
wasn't sure if I should post all of it. I'll post the complete GetData
and StoreData subroutines.

I've checked all of the variables in the GetData subroutine to make
sure that they have values and aren't referencing empty strings. The
problem seems to lie either in the way that I am storing data or in the
way that I am dereferencing the data in the 'data' hash.

-Jen

###############################################
sub GetData{
###############################################

my ($keysRef, $exptIDsRef, $IDToNameRef, $keyToSUIDRef, $SUIDToKeyRef,
$where, $join, $from, $coordsRef, $retrieveBy, $selectedColumn,
$joinHashRef) = @_;

my $exptnum = scalar(@$exptIDsRef);

print "Using ", font({-color=>'red'}, "$exptnum"), " experiments and
retrieving from the ", font({-color=>'red'}, "Result"), " table for
each experiment\n", p;

my ($exptname, $exptid, $seqname);
my ($key, $spot, $suid, $val, $sth, @values, $keyOffset, %data);

my $count = 1;

my $select = "SELECT RESULT.SPOT, RESULT.LOG_RAT2N_MEAN,
RESULT.CH1I_MEAN ";

$from =~ s/, $//;

my %reverseExpts;
&selectReverse($exptIDsRef, \%reverseExpts);
my $reverseFlag = $query->param('isReverse');

my $sql = "$select $from $join AND exptid = ? $where $selectedColumn
IS NOT NULL";

my $sth = $dbh->prepare($sql);

print "Retrieving data...\n<br>";

#print "SQL Statement: $sql<br>";
eval {
foreach $exptid (@{$exptIDsRef}) {

print "$count: $$IDToNameRef{$exptid}",br;

print "Experiment ID: $exptid<br>";
$sth->execute($exptid);

while(($spot, @values) = $sth->fetchrow_array) {

if (($reverseFlag eq 'Y' && $reverseExpts{$exptid} eq 'N') ||
($reverseFlag eq 'N' && $reverseExpts{$exptid} eq 'Y')) {
for (my $i = 0; $i < scalar(@values); $i++) {
$values[$i] = -$values[$i];
}
}


$$keysRef{$spot} = 1;
$data{$spot}{$exptid} = \@values;

}

if ((!($count%$numToDump)) || ($count==$exptnum)) {
print "Caching data to disk...\n";

&StoreData(\%data, $count, $exptIDsRef, $IDToNameRef);
undef %data;

}

$count++;

}
};

if ($@) {
my $error = $@;
print h3("An error occurred in generating a query to retrieve your
data from the database");
print h4("The most likely cause of this is an incorrectly formatted
filter string.");
print h4("For your reference, the error was:<br>$error");
print "If you believe an incorrectly formatted filter string is not
the problem, please let the curators know exactly what you did so they
can reproduce the error. This will allow the programmers to work on a
fix",br;
return(1);
}

$sth->finish;

print br;

&StitchFilesTogether($exptnum, $keysRef, $exptIDsRef, $IDToNameRef);

return(undef);

}

#########################################################
sub StoreData{
#########################################################

my ($dataRef, $count, $exptIDsRef, $IDToNameRef) = @_;

my ($i, $start, $key, $num);

my %data = %$dataRef;

my $number = int(($count-1)/$numToDump) + 1;

my $filename = $$.".".$number.".tmp";

open (OUT, ">$tmpDir/$filename") or die "Cannot make $tmpDir/$filename
: $!\n",br;

$start = int(($count-1)/$numToDump) * $numToDump;

foreach $key (sort keys %data) {

print OUT $key;

for ($i = $start; $i<$count; $i++) {

my $valuesRef = $data{$key}{$$exptIDsRef[$i]};

print OUT "\t";
print OUT join ("\t", @$valuesRef);

}

print OUT "\n";

$num++;

print "$num\n<br>" if (!($num%1000));

}

close OUT;

}
 
P

Paul Lalli

Jennifer said:
I do have a the 'my ($keysRef) = @_' in my code. I tried to remove
some of the code to be more clear. I guess it has the opposite effect.
The rest of the code is quite long and contains a lot of
CGI/PostgreSQL calls that don't do anything with this issue, so I
wasn't sure if I should post all of it.

You were right to be weary about that. What you *should* have done was
created a *short* but still complete script that demonstrates your
error. That is, par your code down, removing the bits that aren't
relevant to the problem at hand, until you are left with a short script
that someone can run by copy and pasting which still demonstrates your
error.

Please read the Posting Guidelines that are posted here twice a week.
They contain valuable information that will help you get the most help
out of this newsgroup.
###############################################
sub GetData{
###############################################

my ($keysRef, $exptIDsRef, $IDToNameRef, $keyToSUIDRef, $SUIDToKeyRef,
$where, $join, $from, $coordsRef, $retrieveBy, $selectedColumn,
$joinHashRef) = @_;

my $exptnum = scalar(@$exptIDsRef);

print "Using ", font({-color=>'red'}, "$exptnum"), " experiments and
retrieving from the ", font({-color=>'red'}, "Result"), " table for
each experiment\n", p;

my ($exptname, $exptid, $seqname);
my ($key, $spot, $suid, $val, $sth, @values, $keyOffset, %data);

I'm willing to bet this is your central problem. A good general rule
is to always declare variables in the shortest scope possible.
my $count = 1;

my $select = "SELECT RESULT.SPOT, RESULT.LOG_RAT2N_MEAN,
RESULT.CH1I_MEAN ";

$from =~ s/, $//;

my %reverseExpts;
&selectReverse($exptIDsRef, \%reverseExpts);

Why are you prepending your subroutine calls with the ampersand? Do
you know what two side effects that produces? If not, you shouldn't be
using it.
my $reverseFlag = $query->param('isReverse');

my $sql = "$select $from $join AND exptid = ? $where $selectedColumn
IS NOT NULL";

my $sth = $dbh->prepare($sql);

print "Retrieving data...\n<br>";

#print "SQL Statement: $sql<br>";
eval {
foreach $exptid (@{$exptIDsRef}) {

print "$count: $$IDToNameRef{$exptid}",br;

print "Experiment ID: $exptid<br>";
$sth->execute($exptid);

while(($spot, @values) = $sth->fetchrow_array) {

Here you're re-assigning @values each time through your loop, but
you're not re-*declaring* it. That is, you're re-using the same
variable each time through...
if (($reverseFlag eq 'Y' && $reverseExpts{$exptid} eq 'N') ||
($reverseFlag eq 'N' && $reverseExpts{$exptid} eq 'Y')) {
for (my $i = 0; $i < scalar(@values); $i++) {
$values[$i] = -$values[$i];
}
}

Er, what's the point of this? Are you really just trying to make every
value in the array it's opposite? That's really so verbose as to be
difficult to read. Try:

$_ *= -1 for @values;
$$keysRef{$spot} = 1;
$data{$spot}{$exptid} = \@values;

....and here, you're storing multiple references to that same variable
at different points in your structure. So every time you changed the
contents of @values above, you changed the values previously stored in
your overall structure. Change that while loop to:
while (my ($spot, @values) = $sth->fetchrow_array) {
}

if ((!($count%$numToDump)) || ($count==$exptnum)) {
print "Caching data to disk...\n";

&StoreData(\%data, $count, $exptIDsRef, $IDToNameRef);
undef %data;

Why are you undef'ing %data? If you want %data to go away at this
point so you get a new blank version of it next time through your loop,
then properly scope your variables. Declare `my %data` in the smallest
scope in which it is needed. At the end of that scope, before the next
iteration begins, %data will be destroyed and your next iteration will
create a brand new version of it.
}

$count++;

}
};


print br;

&StitchFilesTogether($exptnum, $keysRef, $exptIDsRef, $IDToNameRef);

return(undef);

}

#########################################################
sub StoreData{
#########################################################

my ($dataRef, $count, $exptIDsRef, $IDToNameRef) = @_;
my ($i, $start, $key, $num);
my %data = %$dataRef;
my $number = int(($count-1)/$numToDump) + 1;
my $filename = $$.".".$number.".tmp";

Gah. Use interpolation to improve readability:

my $filename = "$$.$number.tmp";


I'm *guessing* that @values above was the cause of your error. After
making that change, if you still aren't seeing the results you desire,
please post a *short* but *complete* script that demonstrates the
error, along with your sample input, desired output, and actual output.

Paul Lalli
 
T

Tad McClellan

#!/usr/bin/perl
use strict;
use warnings;


Good. Very good. Thank you for your courtesy.

&GetData(\%keys);


You should not use an ampersand on subroutine calls unless you know
why you need an ampersand on your subroutine call. See perlsub.pod.

GetData(\%keys);

### Retrieving information from a PostgreSQL database here.
my %data;
my $keysRef;

foreach my $secondKey (@{$secondKeysRef}) {
while (($key, @values) = $sth->fetchrow_array) {
$$keysRef{$key} = 1;
$data{$key}{$secondKey} = \@values;
}
&StoreData(\%data, $keysRef);
}


It would be helpful to see what data structure you ended up building.

use Data::Dumper; # at top of program file

then here you can have a look at %data:

print Dumper \%data;
 
B

Brian McCauley

Paul said:
I'm willing to bet this is your central problem.

Yes, a nasty attack of premature declaration indeed.
A good general rule
is to always declare variables in the shortest scope possible.

Just to re-enforce what Paul said, this is a _general_ rule. It's not
specific to programming in Perl. It applies to programming in _general_
(whenever the concept of variable scope exists).

Any teacher, collegue, book or ($DEITY forbid) language[1] that
encourages premature declarartion should be viewed with suspicion.

[1] Pascal-like languages
 
T

Tad McClellan

Jennifer I. Drake said:
I do have a the 'my ($keysRef) = @_' in my code. I tried to remove
some of the code to be more clear. I guess it has the opposite effect.
The rest of the code is quite long and contains a lot of
CGI/PostgreSQL calls that don't do anything with this issue, so I
wasn't sure if I should post all of it. I'll post the complete GetData
and StoreData subroutines.


You should instead post a short and complete program *that we can run*
that illustrates your problem.

Please have a look at the Posting Guidelines that are posted
here frequently.


Your code is too much, and too incomplete to try and figure out, so I
don't have any help for your real problem. But I will point out
some strangeness that I noticed in a quick scan.

print "Using ", font({-color=>'red'}, "$exptnum"),
^^^^^^^^^^

perldoc -q vars

What's wrong with always quoting "$vars"?

So make that:

print "Using ", font({-color=>'red'}, $exptnum),

my ($key, $spot, $suid, $val, $sth, @values, $keyOffset, %data);
^^^^

You should restrict the scope of variables to the smallest possible,
so you should declare them right before you use them rather than
way up here.

You redeclare $sth later on, aren't you getting a warning message
about that?

print "Retrieving data...\n<br>";


Now that I see you are outputting HTML, I am worried that this is a
CGI application without any taint checking. Please think carefully
about security before going "live" with a CGI program that talks
to a database.

perldoc perlsec


for (my $i = 0; $i < scalar(@values); $i++) {


Easier to read, and harder to insert a bug, if you replace that
line with:

foreach my $i ( 0 .. $#values ) {

$values[$i] = -$values[$i];
}
}


Oh. You didn't even need that actual index.

Easier to read, and harder to insert a bug, if you let perl handle the
indexing for you and replace that whole loop with:

foreach my $value ( @values ) {
$value = -$value;
}

or

@values = map -$_, @values;

$$keysRef{$spot} = 1;

Easier to read, and harder to insert a bug, if you use the arrow
operator when you can:

$keysRef->{$spot} = 1;

See perlreftut.pod.


my $filename = $$.".".$number.".tmp";


Easier to read if you use interpolation instead of explicit concatenation:

my $filename = "$$.$number.tmp";



[ snip TOFU ]
 
J

Jennifer I. Drake

You were right to be weary about that. What you *should* have done was
created a *short* but still complete script that demonstrates your
error. That is, par your code down, removing the bits that aren't
relevant to the problem at hand, until you are left with a short script
that someone can run by copy and pasting which still demonstrates your
error.

Please read the Posting Guidelines that are posted here twice a week.
They contain valuable information that will help you get the most help
out of this newsgroup.

Again, I apologize. I'll be sure to do that in the future instead of
the way I posted. Using a short script also helped me further test the
issue, so I see the value in doing it that way.
Why are you prepending your subroutine calls with the ampersand? Do
you know what two side effects that produces? If not, you shouldn't be
using it.

A lot of the ampersands are leftovers from the original version of the
code (written in Perl 4, I believe). I've gone through and removed
them.
Here you're re-assigning @values each time through your loop, but
you're not re-*declaring* it. That is, you're re-using the same
variable each time through... ....
...and here, you're storing multiple references to that same variable
at different points in your structure. So every time you changed the
contents of @values above, you changed the values previously stored in
your overall structure. Change that while loop to:
while (my ($spot, @values) = $sth->fetchrow_array) { ....
I'm *guessing* that @values above was the cause of your error. After
making that change, if you still aren't seeing the results you desire,
please post a *short* but *complete* script that demonstrates the
error, along with your sample input, desired output, and actual output.

Paul Lalli

That was exactly the problem. I made the change and everything is
working correctly. Thank you so much for your help.

-Jennifer
 
A

anno4000

Paul Lalli said:
Jennifer I. Drake wrote:

[good advice snipped]
Why are you undef'ing %data? If you want %data to go away at this
point so you get a new blank version of it next time through your loop,
then properly scope your variables. Declare `my %data` in the smallest
scope in which it is needed. At the end of that scope, before the next
iteration begins, %data will be destroyed and your next iteration will
create a brand new version of it.

This isn't quite correct. Nothing happens at the end of a loop body
to the lexical variables defined in its scope. Only when the my()
statement is passed at run time is a new variable created. The effect
is largely the same, but there is no action-at-a-distance as your
explanation implies.

Anno
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

No members online now.

Forum statistics

Threads
473,766
Messages
2,569,569
Members
45,042
Latest member
icassiem

Latest Threads

Top