Importing Conditionally Compiled Functions From a Perl Module

Question

I have a set of logging and debugging functions which I want to use across multiple modules / objects. I'd like to be able to turn them on / off globally using a command line switch.

The following code does this, however, I would like to be able to omit the package name and keep everything in a single file.

More specifically, I would like to import the logging functions names into each module so that they can be called without any package name qualification ( similar to a C++ use namespace; directive ) and I want to be able to enable / disable them globally from the script which uses them as in my example code below.

This is related to two previous questions I asked, here and here.

One other thing - I don't think I completely understand why the 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();

Answer 1

If you want to keep everything in the same file, why not put the logger at the top in a file scoped lexical.

GetOptions( do_logging => \$do_logging );

my $logerr = $do_logging ? sub {logging_code_here()} : sub {};

$logerr is now available in any package defined after that point in the same file.

However, it is generally faster to structure your logging calls as follows:

my $logerr = sub { logging_code_here() };

$logerr->("some string $some_var") if $do_logging;

that way you avoid a subroutine call and the string argument to $logerr does not need to be calculated if logging is off.

You can also setup logging levels:

$logerr->("starting loop")     if $do_logging;

for (@big_array) {
    $logerr->("processing $_") if $do_logging > 1;
    ...
}

EDIT: While I don't think its the best practice, based on your comments, here is what you are probably looking for (a 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's 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';

Answer 2

If you need to patch some logging methods (or do something else conditionally in a developer environment vs. production), you can put the code into the import() method of a package and use an argument in the use line to enable/disable it:

# 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

Answer 3

Below you will your code without an explicit package for the logging functions. I've renamed LogFuncs::compile to logerr:setup to be a bit more explicit and not pollute the main namespace. Everything in perl has a package, it's just main by default. I think the code you have before, with a package for the logging functions was actually cleaner, and lends itself to being split into a separate module easily, so it can be reused easier.

As for not understanding how the code works, I'm not sure how to address that, but only because you didn't identify any specifics of what you didn't understand. I'll assume you meant the packages. Perl packages can be viewed as namespaces, or classes. In the case of the LogFuncs package, you are using it as a namespace, and subs created in it are accessed as static class methods (to use some notation from other more traditional OO languages that may shine light on this). Package FooObj and BarObj are used more traditionally as objects by providing a constructor new(), and expecting subs 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 defining a sub as a static class method or a object method is whether it expects to receive the object as the first parameter. As such, a little forethought and careful programming can produce subs that work for both, by correctly determining what the first passed parameter is 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();