Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery

RFC: Alex::Log

by friedo (Prior)
on Jul 24, 2005 at 05:38 UTC ( #477547=perlmeditation: print w/replies, xml ) Need Help??

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.

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.)

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;

Thanks for looking.

Replies are listed 'Best First'.
Re: RFC: Alex::Log
by polettix (Vicar) on Jul 24, 2005 at 14:50 UTC
    Maybe I'm missing something, but I'd use the import package function instead of new, given the fact that you're using a functional approach for the logging functions. I'd also change the truncation:
    substr($msg, 2045) = '...' if length( $msg ) > 2048;
    to signal the fact that the log line has been truncated. But this post is definitely something for me to put in the bag for the future, thanks :)

    perl -ple'$_=reverse' <<<ti.xittelop@oivalf

    Don't fool yourself.

      Ah, but friedo isn't importing, either. He's creating an object, a very expensive create, and returning that. This way, require still works as well.

      Actually, given the way this works, I would be tempted to suggest the following changes:

      • Cache the object. The second time Alex::Log->new is called, return the same object. This kills inheritance, mind you, so as long as you don't derive new packages off this one, it will at least allow the second and further instantiations to not query the database.
      • The no strict 'refs' line has a significant scope. By saying
        my $sub = sub { ... }; no strict 'refs'; *{"Alex::Log::$name"} = $sub;
        you've just reduced the scope of the dangerous behaviour to just the one line that we want to use it.
      • I think your truncation is a bit off - you then add a bunch of stuff to the front after truncation. I think you probably want to add the stuff prior to truncation.
      • Heck, I'd just take that subroutine out altogether and have everything passed in:
        sub _doLog { my ($self, $lid, $pid, $msg) = @_; $msg = '[PID:$$] ' . $msg; substr($msg, 2045) = '...' if length($msg) > 2048; my $sth = $self->{dbh}->prepare("INSERT INTO Logs ( log_level_id, log_program_id, message ) VALUES ( ?, ?, ? )" ); $sth->execute( $lid, $pid, $msg ); }
        And then your dynamic code would be more like:
        my $singleton; sub new { return $singleton if $singleton; # bypass setup if already done 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; $singleton = bless( { dbh => $dbh }, $class ); my $levels = $dbh->selectall_arrayref( "SELECT id, name FROM Log_Levels" foreach my $lev( @$levels ) { no strict 'refs'; *{'Alex::Log::' . $lev->[1]} = sub { shift->_doLog(@$lev, @_); }; } $singleton; );
      • At this point, we can almost get rid of the object. Rather than using "new", we call it "_initialise". Otherwise, it can work pretty much the way it is. And then the dynamic setup would become:
        foreach my $lev( @$levels ) { no strict 'refs'; *{'Alex::Log::' . $lev->[1]} = sub { _doLog(@$lev, @_); }; }
        And then _doLog would become:
        sub _doLog { my ($lid, $pid, $msg) = @_; #... my $sth = _init()->{dbh}->prepare("INSERT INTO Logs ( log_level_id, log_program_id, message ) VALUES ( ?, ?, ? )" ); #... }
        And then we can import everything. Here's a tricky thing. Maybe this would do:
        our @EXPORT_OK; use base 'Exporter'; sub import { _init(); goto \&Exporter::import; }
        And then, in the _init function, we change:
        foreach my $lev( @$levels ) { push @EXPORT_OK, $lev->[1]; # set up the allowable exports no strict 'refs'; *{'Alex::Log::' . $lev->[1]} = sub { _doLog(@$lev, @_); }; }
        And now you can just call the functions from your code directly, without the object. Change @EXPORT_OK to @EXPORT if you really want to import 'em all, otherwise call as use Alex::Log qw(level1 level2 level4);
      Just a few possible suggestions - take whatever suits your needs. :-)

        Thanks for the suggestions, Tanktalus! I really don't want to go the Exporter route with this since I already have a significant amount of namespace invasion going on in other places. But I think caching the object is definitely a good idea, as is reducing the scope of the no strict.
Re: RFC: Alex::Log
by saintmike (Vicar) on Jul 25, 2005 at 03:06 UTC
    Sounds like a perfect opportunity to use Log::Log4perl. This way, you're getting both levels and categories, as orthogonal ways of controlling the amount and source of logged messages.

    It has (among many others) a Log::Log4perl::Appender::DBI appender which forwards messages to a database via DBI.

    Or, write your own appender.

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://477547]
Approved by kvale
Front-paged by planetscape
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (2)
As of 2022-08-15 07:23 GMT
Find Nodes?
    Voting Booth?

    No recent polls found