Sorting Perl with Class::DBI - perl

You have the following table called Pets:
name age pet
------------------------
Carol 25 null
Stean 23 cat
Mel 24 dog
Rich 24 rabbit
In a MySQL database on the server mydbserver with the user of 'user' with a
password of 'password'.
Do the following:
1) Create a Class::DBI connection to this database with the above credentials ( DBI.pm ).
2) Create a Class for the table Pets ( Pet.pm )
3) Create a program that prints all the names of people in the Pets table and what kind (if any )
of pet he/she has sorted by name then age.
Here is the code I wrote.....
#!/usr/bin/perl
package Pet::DBI;
use DBI;
use strict;
use base 'Class::DBI';
Pet::DBI->set_db('Main','dbi:mysql:dname', 'user', 'password')
or die $DBI::errstr "\n";
1;
package Pet::Pets;
use base 'Pet::DBI';
use strict;
use warning;
Pet::Pets->table('Pets');
Pet::Pets->columns(All => qw/name age pet/);
1;
use Pet::Pets;
my #pets = Pet::Pets->retrieve_all;
for (sort {$a->name cmp $b->name} || {$a->age <=> $b->age} #Pets) {
print "Name:".$_->name ' => '."Age". $_->age"\n";
}
1;

It's basically correct, but there's a number of small problems.
It's not necessary to load DBI, Class::DBI will take care of that for you.
You should be using connection instead of set_db("Main", ...). set_db comes from Ima::DBI and it's not polite (or necessary) to peek under the hood like that.
Although this isn't directly documented in Class::DBI (it should be), its inherited from Ima::DBI, there's no need to check for DBI errors. RaiseError is on and if the connection fails it will throw an error.
You have a typo, use warning; instead of use warnings;.
Unless you have stitched three files together for the post, if the code is all in one file the 1; statements do nothing. use Pet::Pets will not work because there is no Pet/Pets.pm file. You don't have to use a class which is already in the same file.
In general, avoid using $_ if you don't have to, too many things can quietly use or change it. Instead, give the for loop a proper variable like for my $person.
sort only takes one block, but you're basically correct. It should be sort { ($a->name cmp $b->name) || ($a->age <=> $b->age) } #Pets
To avoid reading the whole, potentially very large, table into memory, the sorting should really be done in the database with an ORDER BY name ASC, age ASC and then retrieved a row at a time using an iterator. Unfortunately, retrieve_all does not support any options. You can use retrieve_from_sql to add arbitrary SQL to the end of the basic SELECT. my $all_people = Pet::Pets->retrieve_from_sql("ORDER BY name ASC, age ASC"); Then your data will already be sorted and can be read a row at a time. while( my $person = $all_people->next ) { ... }
You're missing a . in "Age". $_->age"\n".
Null values in a database come back as undef. You'll want to check if $_->pet is defined and if not use some other string like "no pet" or just a blank "".
You're printing the person's age, the question asks for their pet.
Otherwise, it should work.
But really, tell whomever gave you this homework to stop telling people to use Class::DBI. They can email me if they like, schwern#pobox.com.

Related

XML::Twig parsing same name tag in same path

I am trying to help out a client who was unhappy with an EMR (Electronic Medical Records) system and wanted to switch but the company said they couldn't extract patient demographic data from the database (we asked if they can get us name, address, dob in a csv file of some sort, very basic stuff) - yet they claim they couldn't do that. (crazy considering they are using a sql database).
Anyway - the way they handed over the patients were in xml files and there are about 40'000+ of them. But they contain a lot more than the demographics.
After doing some research and having done extensive Perl programming 15 years ago (I admit it got rusty over the years) - I thought this should be a good task to get done in Perl - and I came across the XML::Twig module which seems to be able to do the trick.
Unfortunately the xml code that is of interest looks like this:
<==snip==>
<patient extension="Patient ID Number"> // <--Patient ID is 5 digit number)
<name>
<family>Patient Family name</family>
<given>Patient First/Given name</given>
<given>Patient Middle Initial</given>
</name>
<birthTime value=YEARMMDD"/>
more fields for address etc.are following in the xml file.
<==snip==>
Here is what I coded:
my $twig=XML::Twig->new( twig_handlers => {
'patient/name/family' => \&get_family_name,
'patient/name/given' => \&get_given_name
});
$twig->parsefile('test.xml');
my #fields;
sub get_family_name {my($twig,$data)=#_;$fields[0]=$data->text;$twig->purge;}
sub get_given_name {my($twig,$data)=#_;$fields[1]=$data->text;$twig->purge;}
I have no problems reading out all the information that have unique tags (family, city, zip code, etc.) but XML:Twig only returns the middle initial for the tag.
How can I address the first occurrence of "given" and assign it to $fields[1] and the second occurrence of "given" to $fields[2] for instance - or chuck the middle initial.
Also how do I extract the "Patient ID" or the "birthTime" value with XML::Twig - I couldn't find a reference to that.
I tried using $data->findvalue('birthTime') but that came back empty.
I looked at: Perl, XML::Twig, how to reading field with the same tag which was very helpful but since the duplicate tags are in the same path it is different and I can't seem to find an answer. Does XML::Twig only return the last value found when finding a match while parsing a file? Is there a way to extract all occurrences of a value?
Thank you for your help in advance!
It is very easy to assume from the documentation that you're supposed to use callbacks for everything. But it's just as valid to parse the whole document and interrogate it in its entirety, especially if the data size is small
It's unclear from your question whether each patient has a separate XML file to themselves, and you don't show what encloses the patient elements, but I suggest that you use a compromise approach and write a handler for just the patient elements which extracts all of the information required
I've chosen to build a hash of information %patient out of each patient element and push it onto an array #patients that contains all the data in the file. If you have only one patient per file then this will need to be changed
I've resolved the problem with the name/given elements by fetching all of them and joining them into a single string with intervening spaces. I hope that's suitable
This is completely untested as I have only a tablet to hand at present, so beware. It does stand a chance of compiling, but I would be surprised if it has no bugs
use strict;
use warnings 'all';
use XML::Twig;
my #patients;
my $twig = XML::Twig->new(
twig_handlers => { patient => \&get_patient }
);
$twig->parsefile('test.xml');
sub get_patient {
my ($twig, $pat) = #_;
my %patient;
$patient{id} = $pat>att('extension');
my $name = $pat->first_child('name');yy
$patient{family} = $name->first_child_trimmed_text('family');
$patient{given} = join ' ', $name->children_trimmed_text('given');
$patient{dob} = $pat->first_child('birthTime')->att('value');
push #patients, \%patient;
}

assigning a scalar the result of an SQL query

It seems to me that there simply has to be a better way of doing this, but i still haven't found one. And i'm sure i'm not the only one who could use a way to do this: Run an SQL query that only produces one field in one row, then assign that field to a scalar. (In my case, if the query results in more than one field/row, then i have bigger things to worry about than the script breaking).
For example, to get the timestamp from the SQL server, one could use:
my $timestamp;
my $cmd = $dbh->prepare('SELECT cast(now() AS timestamp);') or die $!;
$cmd->execute();
while (my #asd = $cmd->fetchrow_array) { $timestamp = $asd[0] }
Dirty, but it works. But using 4 lines seem a bit much for a simple assignment, especially considering how well perl and postgresql can communicate with eachother via DBI. Sure, i could write a subroutine for it, but isn't there something native that allows me to fetch data as easily as i submit data with $dbh->do() ?
And yes, i did try google.
Usually I write:
$value = $dbh->selectall_arrayref($sql)->[0]->[0];
There's always selectrow_array:
selectrow_array
#row_ary = $dbh->selectrow_array($statement);
#row_ary = $dbh->selectrow_array($statement, \%attr);
#row_ary = $dbh->selectrow_array($statement, \%attr, #bind_values);
This utility method combines prepare, execute and fetchrow_array into a single call.
So something like this:
my $timestamp = $dbh->selectrow_array('select cast(now() as timestamp)');
There's also selectrow_arrayref and selectrow_hashref for similar situations.
From perldoc DBI:
"selectrow_arrayref"
$ary_ref = $dbh->selectrow_arrayref($statement);
$ary_ref = $dbh->selectrow_arrayref($statement, \%attr);
$ary_ref = $dbh->selectrow_arrayref($statement, \%attr, #bind_values);
This utility method combines "prepare", "execute" and
"fetchrow_arrayref" into a single call. It returns the first row of
data from the statement. The $statement parameter can be a previously
prepared statement handle, in which case the "prepare" is skipped.
If any method fails, and "RaiseError" is not set, "selectrow_array"
will return undef.
That will get you most of the way. You still need to do some error checking, but you would be doing that anyway.
Wouldn't fetchrow_array actually only return a scalar as you're only asking for one column?

Using hash as a reference is deprecated

I searched SO before asking this question, I am completely new to this and have no idea how to handle these errors. By this I mean Perl language.
When I put this
%name->{#id[$#id]} = $temp;
I get the error Using a hash as a reference is deprecated
I tried
$name{#id[$#id]} = $temp
but couldn't get any results back.
Any suggestions?
The correct way to access an element of hash %name is $name{'key'}. The syntax %name->{'key'} was valid in Perl v5.6 but has since been deprecated.
Similarly, to access the last element of array #id you should write $id[$#id] or, more simply, $id[-1].
Your second variation should work fine, and your inability to retrieve the value has an unrelated reason.
Write
$name{$id[-1]} = 'test';
and
print $name{$id[-1]};
will display test correctly
%name->{...}
has always been buggy. It doesn't do what it should do. As such, it now warns when you try to use it. The proper way to index a hash is
$name{...}
as you already believe.
Now, you say
$name{#id[$#id]}
doesn't work, but if so, it's because of an error somewhere else in the code. That code most definitely works
>perl -wE"#id = qw( a b c ); %name = ( a=>3, b=>4, c=>5 ); say $name{#id[$#id]};"
Scalar value #id[$#id] better written as $id[$#id] at -e line 1.
5
As the warning says, though, the proper way to index an array isn't
#id[...]
It's actually
$id[...]
Finally, the easiest way to get the last element of an array is to use index -1. The means your code should be
$name{ $id[-1] }
The popular answer is to just not dereference, but that's not correct. In other words %$hash_ref->{$key} and %$hash_ref{$key} are not interchangeable. The former is required to access a hash reference nested as an element in another hash reference.
For many moons it has been common place to nest hash references. In fact there are several modules that parse data and store it in this kind of data structure. Instantly depreciating the behavior without module updates was not a good thing. At times my data is trapped in a nested hash and the only way to get it is to do something like.
$new_hash_ref = $target_hash_ref->{$key1}
$new_hash_ref2 = $target_hash_ref->{$key2}
$new_hash_ref3 = $target_hash_ref->{$key3}
because I can't
foreach my $i(keys(%$target_hash_ref)) {
foreach(%$target_hash_ref->{$i} {
#do stuff with $_
}
}
anymore.
Yes the above is a little strange, but creating new variables just to avoid accessing a data structure in a certain way is worse. Am I missing something?
If you want one item from an array or hash use $. For a list of items use # and % respectively. Your use of # as a reference returned a list instead of an item which perl may have interpreted as a hash.
This code demonstrates your reference of a hash of arrays.
#!/usr/bin perl -w
my %these = ( 'first'=>101,
'second'=>102,
);
my #those = qw( first second );
print $these{$those[$#those]};
prints '102'

Get number of records in table before given entry / get record absolute ID

I know the _id (ObjectID) of some entry; is there any way to get its relative position from the table start / number of records before it, without writing any code?
*(the stuff was required for debugging some application which ha*d* messy 'no deletions' policy along with incremental record numbers and in-memory collections)*
UPD: still looking for native way to do such things, but here's some perl sweets:
#!/usr/bin/perl -w
use MongoDB;
use MongoDB::OID;
use strict;
my $ppl = MongoDB::Connection->new(username=>"root", password=>"toor")->webapp->users->find();
my $c = 0;
while (my $user = $ppl->next) {
$c++;
print "$user->{_id} $c\n" if ( $user->{'_id'} =~/4...6|4...5/);
}
This is not possible. There is no information in an ObjectID that you can reliably use to know how many older documents are in the same collection. The "inc" part of the ObjectId comes close but exact values depend on driver implementation (and can even be random) and would require all writes to come from the same machine to a mongod that's managing a single collection.
TL;DR : No

Where is my associative array and how do I access it using Perl DBI?

I'm working with perl, and using DBI. Up to now, I've been using ->fetchall_arrayref to get the results of a database query, and just accessing the array by numeric keys. However, I much prefer to be able to access records by the field names (associative fetch) than numeric.
How do I do this, and what is the correct syntax for accessing the keys?
I would prefer something like:
$data[0]['name']
Instead of:
$data[0][1]
Working Solution
my %data;
#{$data{$id}}{('name')} = 'something';
Read the DBI docs. Particularly, fetchall_hashref.
And you should also learn Perl syntax, as it's not the same as PHP.
You can use selectall_arrayref for this. Here's example from the DBI manpage:
You may often want to fetch an array of rows where each row is stored as a hash.
That can be done simple using:
my $emps = $dbh->selectall_arrayref(
"SELECT ename FROM emp ORDER BY ename",
{ Slice => {} }
);
foreach my $emp ( #$emps ) {
print "Employee: $emp->{ename}\n";
}
If you do fetchall_hashref() then you get the hash you are looking for. The keys will be the field names from the database. I am a little late, and Joe got it, but it will be.
$data->{0}->{'field'};