in reply to Re: RFC: Alex::Log
in thread RFC: Alex::Log
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:
you've just reduced the scope of the dangerous behaviour to just the one line that we want to use it.my $sub = sub { ... }; no strict 'refs'; *{"Alex::Log::$name"} = $sub;
And then your dynamic code would be more like: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 ); }
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; );
And then _doLog would become:foreach my $lev( @$levels ) { no strict 'refs'; *{'Alex::Log::' . $lev->[1]} = sub { _doLog(@$lev, @_); }; }
And then we can import everything. Here's a tricky thing. Maybe this would do:sub _doLog { my ($lid, $pid, $msg) = @_; #... my $sth = _init()->{dbh}->prepare("INSERT INTO Logs ( log_level_id, log_program_id, message ) VALUES ( ?, ?, ? )" ); #... }
And then, in the _init function, we change:our @EXPORT_OK; use base 'Exporter'; sub import { _init(); goto \&Exporter::import; }
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);foreach my $lev( @$levels ) { push @EXPORT_OK, $lev->[1]; # set up the allowable exports no strict 'refs'; *{'Alex::Log::' . $lev->[1]} = sub { _doLog(@$lev, @_); }; }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^3: RFC: Alex::Log
by friedo (Prior) on Jul 24, 2005 at 21:48 UTC |