How can I get Perl DBI's selectrow_hashref to return a new row each iteration? - perl

I am trying to use DBI's selectrow_hashref instead of fetchrow_hashref in order to save a couple lines of code, but it keeps returning the same row of data over and over.
my $select="SELECT * FROM table";
while (my ($user_ref) = $dbh->selectrow_hashref()) {
# $user_ref is the same each time!
}
When I use fetchrow_hashref, everything is fine, and each iteration I get new data.
my $select="SELECT * FROM table";
my $sth = $dbh->prepare($select) || die "prepare: $select: $DBI::errstr";
$sth->execute() || die "execute: $select: $DBI::errstr";
while (my ($user_ref) = $sth->fetchrow_hashref()) {
# works great, new data in $user_ref each iteration
}
Pray tell, what am I doing wrong? Is selectrow_hashref only intended to retrieve a single record? It doesn't seem that way in the doc.

Is selectrow_hashref only intended to retrieve a single record?
Yes.
It doesn't seem that way in the doc.
Well, that documentation says:
It returns the first row of data from the statement.
Which seems pretty clear to me.
Are you looking for selectall_hashref instead?
Update: Actually, I think you want selectall_array:
my $select='SELECT * FROM table';
foreach my $user_ref ($dbh->selectall_array($select, { Slice => {} })) {
# $user_ref is a hash ref
say $user_ref->{some_column};
}

Related

Iterating the results returned from fetchall_arrayref

I have a sql wherein I am fetching few records, sorted by full name.
My requirement is to extract chunks of similar names and then do some operation on it.
Say, the sql returns some records containing names like [name1,name1,name2,name3,name3]
I need to split them to [name1,name1] , [name2] , [name3,name3]
I am able to do it, but I am not happy with my implementation as I have to call doSomethingWithNames()twice.
while (my $paRecs = $pStatementHandle->fetchall_arrayref({}, 3)){
foreach my $phRec(#{$paRecs}){
my $pCurrentName = $phRec->{'FULL_NAME'};
if ((scalar(#aParentRecords) eq 0) or ($aParentRecords[-1] eq $pCurrentName)){
push(#aParentRecords, $pCurrentName);
} else {
doSomethingWithNames(\#aParentRecords);
#aParentRecords= ();
push(#aParentRecords, $pCurrentName);
}
}
};
doSomethingWithNames(\#aParentRecords); # This should be inside while loop
I believe am running into this issue because while doesn't go into the loop for
the last iteration as fetch* returns undef.
Sounds basic PERL stuff, but tried many loop constructs with no luck.
Any pointer will be a great help
The trick is to postpone existing the loop by converting it into an infinite loop. This requires checking the loop-terminating condition (!$rows) twice, though.
my $rows = [];
my $prev_name = '';
my #group;
while (1) {
$rows = $sth->fetchall_arrayref({}, 3) if !#$rows;
if (!$rows || $rows->[0]->{FULL_NAME} ne $prev_name)
if (#group) {
do_something(\#group);
#group = ();
}
last if !$rows;
}
$prev_name = $rows->[0]->{FULL_NAME};
push #group, shift(#$rows);
}

Perl return list of array refs of unknown length

I have a sub in Perl that needs to return a list of array refs to fit in with the rest of the package. The problem is that I don't know in advance how many array refs I will generate. My usual method of pushing the array refs that I generate into an array and returning a reference to that doesn't work with the rest of the code, which I can't change without breaking some legacy stuff.
sub subTrackTable {
my ($self, $experimentName, $subTrackAttr) = #_;
# return nothing if no subtracks required
if ($subTrackAttr eq 'no_sub') {
return;
}
# get distinct values for subtrack attr (eg antibody) from db
my $dbh = $self->dbh();
my $sh = $dbh->prepare("SELECT DISTINCT * blah sql");
$sh->execute();
my #subtrackTable;
while (my ($term, $value) = $sh->fetchrow_array()) {
my $subtrack = [':$value', $value];
push (#subtrackTable, $subtrack);
}
$sh->finish();
# this is hard-coded for one experiment and does what I want
# Want to loop through #subtrackTable and return a list of all the array refs it contains
# Returning nested array refs doesn't work with external code
return ([":H3K4me3", "H3K4me3"],[":H4K20me3", "H4K20me3"]);
}
The problem is that because I am dynamically getting values from a database, I don't know how many there will be. Just returning \#subtrackTable, which would be my usual strategy breaks the rest of the code. If I knew in advance how many there would be I could also do something like
my $a1 = [":$value1", $value1];
my $a2 = [":$value2", $value2];
...
my $an = [":$valuen", $valuen];
return($a1, $a2,...$an);
but I can't see how to make this work with an unknown number of arrayrefs.
Help appreciated!
It looks like you just need to
return #subtrackTable;
Also, this line
my $subtrack = [':$value', $value];
must be changed to use double quotes, like this
my $subtrack = [ ":$value", $value ];

Convert a DBIx::Class::Result into a hash

Using DBIx::Class, I found a solution to my issue, thankfully. But I'm sure there has to be a nicer way.
my $record = $schema->resultset("food")->create({name=>"bacon"});
How would I turn this record into a simple hashref instead of having to make this call right after.
my record = $schema->resultset("food")->search({name=>"bacon"})->hashref_array();
Ideally I want to be able to write a code snippet as simple as
{record=> $record}
instead of
{record => {name => $record->name, $record->food_id, ...}}
This would drive me insane with a table that has alot more columns.
I assume you're talking about DBIx::Class?
my $record = $schema->resultset("food")->create({name=>"bacon"});
my %record_columns = $record->get_columns;
# or, to get a HashRef directly
my $cols = { $record->get_columns };
# or, as you've asked for
my $foo = { record => { $record->get_columns } };
What you're looking for is included in DBIx::Class as DBIx::Class::ResultClass::HashRefInflator.

Perl -> Avoiding unnecessary method calls

I have to read log files of a store. The log shows the item id and the word "sold" after it. So I made a script to read this file, counting how many times a word "sold" appears for each item id. Turns out that there are many "owners" for the items. That is, there is a relation between "owner_id" (a data in my DB) and "item_id". Im interested in knowing how many items owners sell per day, so I create a "%item_id_owner_map":
my %item_id_sold_times;
my %item_id_owner_map;
open my $infile, "<", $file_location or die("$!: $file_location");
while (<$infile>) {
if (/item_id:(\d+)\s*,\s*sold/) {
my $item_id = $1;
$item_id_sold_times{$item_id}++;
my $owner_ids =
Store::Model::Map::ItemOwnerMap->fetch_by_keys( [$item_id] )
->entry();
for my $owner_id (#$owner_ids) {
$item_id_owner_map{$owner_id}++;
}
}
}
close $infile;
The "Store::Model::Map::ItemOwnerMap->fetch_by_keys( [$item_id] )->entry();" method takes item_id or ids as input, and gives back owner_id as output.
Everything looks great but actually, you will see that every time Perl finds a regex match (that is, every time the "if" condition applies), my script will call "Store::Model::Map::ItemOwnerMap->fetch_by_keys" method, which is very expensive, as these log files are very very long.
Is there a way to make my script more efficient? If possible, I only want to call my Model method once.
Best!
Separate your logic into two loops:
while (<$infile>) {
if (/item_id:(\d+)\s*,\s*sold/) {
my $item_id = $1;
$item_id_sold_times{$item_id}++;
}
}
my #matched_items_ids = keys %item_id_sold_times;
my $owner_ids =
Store::Model::Map::ItemOwnerMap->fetch_by_keys( \#matched_item_ids )
->entry();
for my $owner_id (#$owner_ids) {
$item_id_owner_map{$owner_id}++;
}
I don't know if the entry() call is correct, but the general shape of that code should do it for you.
In general databases are good at fetching sets of rows, so you're right to minimise the calls to fetch from the DB.

program exhibiting bizarre behavior when reading words out from a file

So I have two files, one that contains my text, and another which I want to contain filter words. The one shown here is supposed to be the one with the curse words. Basically, what I'm doing is iterating through each of the words in the text file, and trying to compare them against the curse words.
sub filter {
$word_to_check = $_;
open ( FILE2, $ARGV[1]) || die "Something went wrong. \n";
while(<FILE2>) {
#cursewords = split;
foreach $curse (#cursewords) {
print $curse."\n";
if($word_to_check eq $curse) { return "BAD!";}
}
}
close ( FILE2 );
}
Here are the "curse words":
what is
Here is the text file:
hey dude what is up
But here's what's going wrong. As you can see, I've put a print statement to see if the curse words are getting checked correctly.
hey what
is
dude what
is
what what
is
is what
is
up what
is
I literally have no idea why this could be happening. Please let me know if I should post more code.
EDIT:
AHA! thanks evil otto. It seems I was getting confused with another print statement I had put in before. Now the problem remains: I think I'm not checking for string equality correctly. Here's where filter is getting called:
foreach $w( #text_file_words )
{
if(filter($w) eq "BAD!")
{
#do something here
}
else { print "good!"; }
}
EDIT 2: Nevermind, more stupidity on my part. I need to get some sleep, thanks evil otto.
change
$word_to_check = $_;
to
$word_to_check = shift;
You needed to collect arguments as an array in perl...
sub myFunction{
($wordToCheck) = #_; #this is the arg array, if you have more than one arg you just separate what's between the parenthesis with commas.
}