We've expanded our Perl news coverage and improved our search! Search for all things Perl across O'Reilly!

Class::DBI
by Tony Bowden | Pages: 1, 2

Instead of getting the phone number, we now get the ID from the recipient table, which is just an auto-incrementing value.

To turn this into a sensible value, we add the following line to the Call class:

  __PACKAGE__->has_a(recipient => 'My::PhoneBill::Recipient');

This tells it that the recipient method doesn't just return a simple value, but that that value should be automatically turned into an instance of the Recipient class.

Of course, calls_on still won't be correct:

  > perl calls_on 2002-10-19
  ...
  18:36:00) My::PhoneBill::Recipient=HASH(0x835b6b8) - 41 secs, 4.2 pence
  21:20:00) My::PhoneBill::Recipient=HASH(0x835a210) - 8 secs, 8.5 pence
  ...
  Total: 7 calls, 92 pence

But now all it takes is a small tweak to the script:

    printf "%s) %s - %d secs, %.1f pence\n",
      $call->calltime, $call->recipient->number, $call->duration, $call->cost;

And now everything is working perfectly again:

  > perl calls_on 2002-10-19
  ...
  18:36:00) 028 9024 4222 - 41 secs, 4.2 pence
  21:20:00) 123 - 8 secs, 8.5 pence
  ...
  Total: 7 calls, 92 pence

The calls_to script is slightly trickier, as the initial search is now on the recipient rather than the call.

So, we change the initial search to:

  my ($recipient) = My::PhoneBill::Recipient->search(number => $number)
    or die "No calls to $number\n";

Then we need to get all the calls to that recipient. For this, we need to inform Recipient of the relationship with calls. Unlike the has_a we just set up in the Call class, the recipient table doesn't store any value concerned with the call table that could be inflated on demand. Instead we need to add a has_many declaration to Recipient:

  __PACKAGE__->has_many(calls => 'My::PhoneBill::Call');

This creates a new method calls for each Recipient object, returning a list of Call objects whose recipient method is our primary key.

So, having found our recipient in the calls_to script, we can simply ask:

  my @calls = $recipient->calls;

And now the script works just as before:

  #!/usr/bin/perl
  
  use My::PhoneBill::Recipient;
  
  my $number = shift or die "Usage: $0 <number>";
  
  my ($recipient) = My::PhoneBill::Recipient->search(number => $number)
    or die "No calls to $number\n";
  my @calls = $recipient->calls;
  
  my $total_cost = 0;
  
  foreach my $call (@calls) {
    $total_cost += $call->cost;
    printf "%s %s - %d secs, %.1f pence\n",
      $call->calldate, $call->calltime, $call->duration, $call->cost;
  }
  printf "Total: %d calls, %d pence\n", scalar @calls, $total_cost;

And now we can get the old results again:

  > perl calls_to 123
  2002-09-17 11:06:00 - 5 secs, 8.5 pence
  2002-10-19 21:20:00 - 8 secs, 8.5 pence
  Total: 2 calls, 17 pence

Next we need a script to give a name to a number in our address book:

  #!/usr/bin/perl
  
  use My::PhoneBill::Recipient;
  
  my($number, $name) = @ARGV;
  die "Usage $0 <number> <name>\n" unless $number and $name;
  
  my $recip = My::PhoneBill::Recipient->find_or_create({number => $number});
  my $old_name = $recip->name;
  $recip->name($name);
  $recip->commit;
  
  if ($old_name) {
    print "OK. $number changed from $old_name to $name\n";
  } else {
    print "OK. $number is $name\n";
  }

This lets us associate a number to a name:

  > perl add_phone_number 123 "Speaking Clock"
  OK. 123 is Speaking Clock

And now with a tiny change to our calls_on script we can output the name where known:

    printf "%s) %s - %d secs, %.1f pence\n",
      $call->calltime, $call->recipient->name || $call->recipient->number,
      $call->duration, $call->cost;

  > perl calls_on 2002-10-19
  ...
  18:36:00) 028 9024 4222 - 41 secs, 4.2 pence
  21:20:00) Speaking Clock - 8 secs, 8.5 pence
  ...
  Total: 7 calls, 92 pence

To allow the calls_to script to work if we give it either a name or a number, we can use:

  my $recipient = My::PhoneBill::Recipient->search(name => $number)
               || My::PhoneBill::Recipient->search(number => $number)
               || die "No calls to $number\n";

However, as we've called search in scalar context, rather than the normal list context, we get back an interator rather than an individual Recipient object. As one name may map to multiple numbers, we need to iterate over each of these in turn:

    my @calls;
    while (my $recip = $recipient->next) {
      push @calls, $recip->calls;
    }

(Printing individual totals for each number is left as an exercise for the reader.)

  > perl calls_to "Speaking Clock"
  2002-09-17 11:06:00 - 5 secs, 8.5 pence
  2002-10-19 21:20:00 - 8 secs, 8.5 pence
  Total: 2 calls, 17 pence

Working With Other Modules

Sometimes the information we store in the database can be used to work with non-Class::DBI modules. For example, if we wanted to format the dates of our calls differently, we might like to turn them into Date::Simple objects. Again, Class::DBI makes this easy.

In the Call class, we again use has_a to declare this relationship:

  __PACKAGE__->has_a(recipient => 'My::PhoneBill::Recipient');
 *__PACKAGE__->has_a(calldate  => 'Date::Simple');

Now, when we fetch the calldate it is automatically inflated to a Date::Simple object. So, we can change the output of calls_to to print the date in a nicer format:

  printf "%s %s - %d secs, %.1f pence\n",
    $call->calldate->format("%d %b"), $call->calltime,
    $call->duration, $call->cost;
 
  > perl calls_to "Speaking Clock"
  17 Sep 11:06:00 - 5 secs, 8.5 pence
  19 Oct 21:20:00 - 8 secs, 8.5 pence
  Total: 2 calls, 17 pence

Class::DBI assumes that any non-Class::DBI class is inflated through a new method, and can be deflated through stringification. As both of these are true for Date::Simple, we didn't need to do anything more. If this is not the case - for example, if you wanted to use Time::Piece instead of Date::Simple - you need to tell Class::DBI how to do the inflating and deflating as the value goes in and comes out of the database.

  __PACKAGE__->has_a(calldate => 'Time::Piece',
    inflate => sub { Time::Piece->strptime(shift, "%Y-%m-%d") },
    deflate => 'ymd'
  );

Deflating a Time::Piece object back to an ISO date string suitable for MySQL is quite simple: you can just call its ymd() method. Thus we can specify this as a string. Inflating is more difficult, as it requires a two argument call to strptime(). Thus we need to specify this as a subroutine reference. When inflating, this is called with the value from the database as its one and only argument. Thus, we can pass that to Time::Piece's strptime method, specifying the format to instantiate from.

Using Time::Piece instead of Date::Time requires one further change to to our output script:

  printf "%s %s - %d secs, %.1f pence\n",
 *  $call->calldate->strftime("%d %b"), $call->calltime,
    $call->duration, $call->cost;

MOST CALLED NUMBERS

BT provide a service that allows you to save money on 10 numbers of your choice. So it would be useful if we were able to find out which numbers we spend the most money calling. We'll assume that any number we've only ever called once isn't worth adding to our list, as it was probably a one-off call. Thus we want the 10 numbers with the highest spend that have had more than one call.

As we said earlier, Class::DBI doesn't attempt to provide a syntax to express any arbitrary SQL, so there's no way of asking directly for this information. Instead, we'll try a simple approach.

Firstly we'll add a method to the Recipient class to tell us the total we've spent on calls to that number:

  use List::Util 'sum';

  sub total_spend {
    my $self = shift;
    return sum map $_->cost, $self->calls;
  }

Then we can create a top_ten script:

  #!/usr/bin/perl
  
  use My::PhoneBill::Recipient;
  
  my @recipients = My::PhoneBill::Recipient->retrieve_all;
  my @regulars = grep $_->calls > 1, @recipients;
  my @sorted = sort { $b->total_spend <=> $a->total_spend } @regulars;
  
  foreach my $recip (@sorted[0 .. 9]) {
    printf "%s - %d calls = %d pence\n",
      $recip->name || $recip->number,
      scalar $recip->calls,
      $recip->total_spend;
  }

This is very slow, however, once you have more than a few hundred calls stored in your database. This is mainly because we're sorting based on a method call. Replacing the sort above with a Schwartzian Transform speeds everything up significantly:

  my @sorted = map $_->[0],
    sort { $b->[1] <=> $a->[1] }
    map [ $_, $_->total_spend ], @regulars;

Now, until the database gets significantly bigger, this is probably fast enough - especially as you probably won't be running the script very often.

However, if this isn't enough, then we can always drop back to SQL. Of course, when we need to optimize for speed, we usually lose something else - in this case, portability. In this example, we're using MySQL, so I would add the relevant MySQL-specific query to Recipient.pm:

  __PACKAGE__->set_sql(top_ten => qq{
    SELECT recipient.recipid,
           SUM(call.cost) AS spend,
           COUNT(call.callid) AS calls
      FROM recipient, call
     WHERE recipient.recipid = call.recipient
     GROUP BY recipient.recipid
    HAVING calls > 1
     ORDER BY spend DESC
     LIMIT 10
  });

Then we can set up a method that returns the relevant objects for these:

  sub top_ten {
    my $class = shift;
    my $sth = $class->sql_top_ten;
       $sth->execute;
    return $class->sth_to_objects($sth);
  }

Any SQL set up using set_sql can be retrieved as a readily prepared DBI statement handle by prepending its name with sql_ - thus we fetch back this top_ten using my $sth = $class->sql_top_ten;

Although we could happily execute this and then call any of the traditional DBI commands (fetchrow_array etc.), we can also take a shortcut. As one of the columns being returned from our query is the primary key of the Recipient, we can simply feed the results into the underlying method in Class::DBI that allows searches to return a list of objects, sth_to_objects.

So, our script becomes simply:

  foreach my $recip (My::PhoneBill::Recipient->top_ten) {
    printf "%s - %d calls = %d pence\n",
      $recip->name || $recip->number,
      scalar $recip->calls,
      $recip->total_spend;
  }

As we have seen, Class::DBI makes it possible to perform many of the common database tasks completely trivially - without writing a single line of SQL. But, when you really need it, it's fairly easy to write the SQL that you need and execute it.