perlmeditation
friedo
Alex, short for Alexander, is a project I'm working on which involves a lot of batch processing jobs. The Boss wanted the logging information to go to the MySQL database instead of plain files, so I could make a pretty web interface for him to monitor the progress of various backend processes. (Yeah, I could have made a pretty web interface for flat files also, but such is The Boss.) Many log systems have different levels to indicate the severity of a message (or whether to even log it at all.) This system started out that way, but soon the "levels" really changed into "categories" which were not necessarily good or bad, so The Boss could run SQL queries against the log table to get information about a particular category of messages. I decided to experiment with closures and auto-generation of methods, and put all the categories into the database, so The Boss could add new ones himself. Upon instantiation, my log object would build a method for each category it found in the database. It works perfectly, but I'd like to hear any comments as this is the first time I've deployed something with dynamic methods on a large scale.
<p>
I'm sure there are also some CPAN modules that do this kind of thing, but I was in the mood for experimentation and it only took a few minutes to write. (And it worked right the first time, always a nice feeling.)
<p>
<readmore>
<code>
package Alex::Log;
use strict;
use warnings;
use lib '/usr/local/alex/lib';
use Carp qw(croak);
use Alex::DBI;
sub new {
my $class = shift;
my %args = @_;
croak "No program name given to constructor.
( program => 'foo' required )"
unless exists $args{program};
my $pname = $args{program};
my $dbh = Alex::DBI->new;
my ( $pid ) = $dbh->selectrow_array( "SELECT id FROM Log_Programs
WHERE name = '$pname'" );
croak "Program $pname not in database" unless $pid;
my $levels = $dbh->selectall_arrayref( "SELECT id, name
FROM Log_Levels" );
foreach my $lev( @$levels ) {
# install dynamic method
my $lid = $lev->[0];
my $name = $lev->[1];
no strict 'refs';
*{ "Alex::Log::$name" } = sub {
my $self = shift;
my $msg = shift;
# truncate msg if needed.
if ( length( $msg ) > 2048 ) {
$msg = substr $msg, 0, 2048;
}
$msg = "[PID:$$] " . $msg;
my $sth = $dbh->prepare( "INSERT INTO Logs
( log_level_id,
log_program_id,
message )
VALUES ( ?, ?, ? )" );
$sth->execute( $lid, $pid, $msg );
};
}
return bless { }, $class;
}
1;
</code>
</readmore>
<p>
Thanks for looking.