Importing conditionally compiled functions from a Perl module
I have a set of logging and debugging functionality that I want to use for multiple modules / objects. I would like them to be turned on / off globally using a command line switch.
In the following code, however, I would like to omit the package name and keep everything in one file.
Specifically, I would like to import the log function names into each module so that they can be called without qualifying the package name (similar to the C ++ directive use namespace;
), and I want to be able to enable / disable them globally from within a script that uses them, as in See my example code below.
This is related to the two previous questions I asked here and here .
One more thing - I don't think I fully understand why below code works.
#! /usr/bin/perl -w
use strict;
use Getopt::Long;
{
package LogFuncs;
use threads;
use Time::HiRes qw( gettimeofday );
# provide tcpdump style time stamp
sub _gf_time {
my ( $seconds, $microseconds ) = gettimeofday();
my @time = localtime($seconds);
return sprintf( "%02d:%02d:%02d.%06ld",
$time[2], $time[1], $time[0], $microseconds );
}
sub logerr;
sub compile {
my %params = @_;
*logerr = $params{do_logging}
? sub {
my $msg = shift;
warn _gf_time() . " Thread " . threads->tid() . ": $msg\n";
}
: sub { };
}
}
{
package FooObj;
sub new {
my $class = shift;
bless {}, $class;
};
sub foo_work {
my $self = shift;
# do some foo work
LogFuncs::logerr($self);
}
}
{
package BarObj;
sub new {
my $class = shift;
my $data = { fooObj => FooObj->new() };
bless $data, $class;
}
sub bar_work {
my $self = shift;
$self->{fooObj}->foo_work();
LogFuncs::logerr($self);
}
}
my $do_logging = 0;
GetOptions(
"do_logging" => \$do_logging,
);
LogFuncs::compile(do_logging => $do_logging);
my $bar = BarObj->new();
LogFuncs::logerr("Created $bar");
$bar->bar_work();
a source to share
If you want to keep everything in one file, why not put a logger at the top of the lexical file with files.
GetOptions( do_logging => \$do_logging );
my $logerr = $do_logging ? sub {logging_code_here()} : sub {};
$logerr
is now available in any package defined after this point in the same file.
However, it is generally faster to structure your log calls like this:
my $logerr = sub { logging_code_here() };
$logerr->("some string $some_var") if $do_logging;
this way you avoid calling the subroutine, and the string argument in $ logerr does not need to be evaluated if logging is disabled.
You can also customize the logging levels:
$logerr->("starting loop") if $do_logging;
for (@big_array) {
$logerr->("processing $_") if $do_logging > 1;
...
}
EDIT: While I don't think the best practice is based on your comments, here is what you are probably looking for (pragma):
use 5.010;
use warnings;
use strict;
BEGIN { # compile time
$INC{'log.pm'}++; # block 'require log;'
package log;
sub is_active {(caller 1)[10]{log}} # test the hints hash
sub import {
$^H{log} = 1; # set the hints hash for 'log'
my $logmsg = (caller).'::logmsg'; # name of caller sub
no strict 'refs';
*$logmsg = sub {print "logging: @_\n" if is_active} # install sub
unless *{$logmsg}{CODE}; # unless we did already
}
sub unimport {
$^H{log} = 0; # unset the hints hash
}
}
package MyPkg;
use log;
logmsg 'hello, world!';
{
no log;
logmsg 'nope, not here';
}
logmsg 'back again';
a source to share
If you need to fix some of the logging methods (or do something else conditionally in a dev environment versus production), you can put the code in a import()
package method and use an inline argument to use
turn it on / off:
# this is in MyLogger.pm:
package MyLogger;
use strict; use warnings;
use Exporter;
our @EXPORT_OK = qw(logerr);
sub import
{
my ($class, $debug) = @_;
if ($debug)
{
# do whatever you need here - patch methods, turn up the log level to "everything", etc
# imports logerr method
MyLogger->export_to_level(1, 'logger');
}
}
sub logerr
{
# your patched method here..
}
1;
# (now in your application code...)
use MyLogger "debug"; # enables debugging mode
# or:
use MyLogger MyConfig::DEBUG; # uses a debugging constant that you defined elsewhere
a source to share
Below you will get your code without an explicit package for the logging functions. I renamed LogFuncs :: compile to logerr: setup to be more explicit and not pollute the main namespace. Everything in perl has a package, it's just main by default. I think that the code you had before, with the package for registration functions, was actually cleaner and it is easily broken down into a separate module so it can be reused.
As far as I don’t understand how the code works, I’m not sure how to solve this, but only because you didn’t define any specifics of what you didn’t understand. I assume you meant packages. Perl packages can be thought of as namespaces or classes. In the case of the LogFuncs package, you use it as a namespace, and the subpackages created in it are available as static class methods (to use some of the conventions of other traditional OO languages that might shine on this). The FooObj package and BarObj are traditionally used as objects by providing a new () constructorand expecting the subsets within them to be called using object notation (-> sub), automatically passing the object itself as the first parameter to the sub / method. The only thing that defines sub as a static class method or an object method is whether it expects to receive an object as the first parameter. Thus, a little prudent and careful programming can create subsets that work for both, by correctly determining what the first parameter is passed and acting accordingly.
#! /usr/bin/perl -w
use strict;
use Getopt::Long;
use threads;
use Time::HiRes qw( gettimeofday );
# provide tcpdump style time stamp
sub _gf_time {
my ( $seconds, $microseconds ) = gettimeofday();
my @time = localtime($seconds);
return sprintf( "%02d:%02d:%02d.%06ld",
$time[2], $time[1], $time[0], $microseconds );
}
sub logerr;
sub logerr_setup {
my %params = @_;
*logerr = $params{do_logging}
? sub {
my $msg = shift;
warn _gf_time() . " Thread " . threads->tid() . ": $msg\n";
}
: sub { };
}
{
package FooObj;
sub new {
my $class = shift;
bless {}, $class;
};
sub foo_work {
my $self = shift;
# do some foo work
main::logerr($self);
}
}
{
package BarObj;
sub new {
my $class = shift;
my $data = { fooObj => FooObj->new() };
bless $data, $class;
}
sub bar_work {
my $self = shift;
$self->{fooObj}->foo_work();
main::logerr($self);
}
}
my $do_logging = 0;
GetOptions(
"do_logging" => \$do_logging,
);
logerr_setup(do_logging => $do_logging);
my $bar = BarObj->new();
logerr("Created $bar");
$bar->bar_work();
a source to share