Question

I am learning Perl in a “head-first” manner. I am absolutely a newbie in this language:

I am trying to have a debug_mode switch from CLI which can be used to control how my script works, by switching certain subroutines “on and off”.

And below is what I’ve got so far:

#!/usr/bin/perl -s -w

# purpose : make subroutine execution optional,
# which is depending on a CLI switch flag

use strict;
use warnings;

use constant DEBUG_VERBOSE             => "v";
use constant DEBUG_SUPPRESS_ERROR_MSGS   => "s";
use constant DEBUG_IGNORE_VALIDATION     => "i";
use constant DEBUG_SETPPING_COMPUTATION  => "c";

our ($debug_mode);

mainMethod();

sub mainMethod # ()
{
    if(!$debug_mode)
    {
        print "debug_mode is OFF\n";
    }
    elsif($debug_mode)
    {
        print "debug_mode is ON\n";
    }
    else
    {
        print "OMG!\n";
        exit -1;
    }

    checkArgv();
    printErrorMsg("Error_Code_123", "Parsing Error at...");
    verbose();
}

sub checkArgv #()
{
    print ("Number of ARGV : ".(1 + $#ARGV)."\n");
}

sub printErrorMsg # ($error_code, $error_msg, ..)
{
    if(defined($debug_mode) && !($debug_mode =~ DEBUG_SUPPRESS_ERROR_MSGS))
    {
        print "You can only see me if -debug_mode is NOT set".
          " to DEBUG_SUPPRESS_ERROR_MSGS\n";
        die("terminated prematurely...\n") and exit -1;
    }
}

sub verbose # ()
{
    if(defined($debug_mode) && ($debug_mode =~ DEBUG_VERBOSE))
    {
        print "Blah blah blah...\n";
    }
}

So far as I can tell, at least it works…:

1. the -debug_mode switch doesn’t interfere with normal ARGV
2. the following commandlines work:
   • ./optional.pl
   • ./optional.pl -debug_mode
   • ./optional.pl -debug_mode=v
   • ./optional.pl -debug_mode=s

However, I am puzzled when multiple debug_modes are “mixed”, such as:

1. ./optional.pl -debug_mode=sv
2. ./optional.pl -debug_mode=vs

I don’t understand why the above lines of code “magically works”.

I see both of the “DEBUG_VERBOS” and “DEBUG_SUPPRESS_ERROR_MSGS” apply to the script, which is fine in this case.

However, if there are some “conflicting” debug modes, I am not sure how to set the “precedence of debug_modes”?

Also, I am not certain if my approach is good enough to Perlists and I hope I am getting my feet in the right direction.

One biggest problem is that I now put if statements inside
most of my subroutines for controlling their behavior under different modes. Is this okay?
Is there a more elegant way?

I know there must be a debug module from CPAN or elsewhere, but I want a real minimal solution that doesn’t depend on any other module than the “default”.

And I cannot have any control on the environment where this script will be executed…

Answer 1

For handling command line options, take a look at Getopt::Long. You get all kinds of slick argument parsing options.

There are many, many modules that handle logging. Log4Perl is a very popular logging module.

If you really, really want to limit yourself by avoiding CPAN (which is a bad idea) you can pretty easily hack together a logging module.

Here’s a small one I hacked up for you. It needs tests and real docs and so forth. I also used some advanced techniques, like a custom import() method. There are also some gotchas surrounding my use of a single variable to store the DEBUG settings for the whole app. But it works. I used a similar module on a project and was pretty happy with it.

package QLOG;

use strict;
use warnings;
use Carp qw(croak);

our %DEBUG_OPTIONS;
our %VALID_DEBUG_OPTIONS;
our %DEBUG_CONFLICTS;

sub import {

    my $pkg = shift;
    my $target = caller();

    my %opts = @_;


    # Configure options

    croak "Must supply an array ref of valid modes"
       unless exists $opts{options};

    @VALID_DEBUG_OPTIONS{ @{$opts{options}} } = ();

    # Configure conflicts

    if( exists $opts{conflicts} ) {
        @DEBUG_CONFLICTS{ keys %{$opts{conflicts}} } 
            = values %{$opts{conflicts}}
    }

    # Export DEBUG method

    {   no strict 'refs';
        *{$target.'::DEBUG'} = \&DEBUG;
    }

    return;
}

sub DEBUG {
    my $mode = shift;

    croak "DEBUG mode undefined"
        unless defined $mode;

    return unless
        ( $mode eq 'ANY' and %DEBUG_OPTIONS )
        or exists $DEBUG_OPTIONS{$mode};

    warn "$_\n" for @_;

    return 1;
}


sub set_options {

    for my $opt ( @_ ) {
        die "Illegal option '$opt'"
           unless exists $VALID_DEBUG_OPTIONS{$opt};

        $DEBUG_OPTIONS{$opt}++;
    }

    return;
}

sub check_option_conflicts {

    for my $opt ( keys %DEBUG_OPTIONS ) {

        if (exists $DEBUG_CONFLICTS{$opt}) {

            for ( @{$DEBUG_CONFLICTS{$opt}} ) {

                die "Debug option $opt conflicts with $_" 
                    if exists $DEBUG_OPTIONS{$_} 
            }
        }
    }

    return;
}


1;

And then use it like this:

#!/usr/bin/perl 

use strict;
use warnings;


use Getopt::Long;

use QLOG
    options => [qw(
        VERBOSE
        SUPPRESS_ERROR_MSGS
        IGNORE_VALIDATION
        SETPPING_COMPUTATION
    )], 
    conflicts => {
        VERBOSE => [qw(
            SUPPRESS_ERROR_MSGS
            SETPPING_COMPUTATION
        )],
    };




process_args();

DEBUG VERBOSE => 'Command line data parsed.';

main();

### ---------------

sub main {

    DEBUG VERBOSE => 'BEGIN main()';

    if( DEBUG 'ANY' ) {
        print "debug_mode is ON\n";
    }
    else {
        print "debug_mode is OFF\n";
    }

    warn "Error which could be surpressed\n"
        unless DEBUG 'SUPPRESS_ERROR_MSGS';
}


# Get arguments and process flags like 'v' and 'sc' into strings specified
# in QLOG configuration above.
# This processing makes the nice DEBUG VERBOSE => 'blah'; syntax work.
sub process_args {

    # Use Getopt::Long to parse @ARGV

    my @debug_options;
    GetOptions (
        'debug-options=s@' => \@debug_options,
        'help'             => \&usage,
    ) or usage();

    # Convert option flags to strings.
    my %option_lut = qw(
        v  VERBOSE  
        s  SUPPRESS_ERROR_MSGS
        i  IGNORE_VALIDATION 
        c  SETPPING_COMPUTATION 
    );

    my @options = map {          # This chained map 
        exists $option_lut{$_}   #    looks in the lut for a flag
        ? $option_lut{$_}        #       translates it if found
        : $_                     #       or passes on the original if not.
    } 
    map {                        # Here we split 'cv' into ('c','v')
       split //
    } @debug_options;

    # Really should use Try::Tiny here.
    eval {    
        # Send a list of strings to QLOG
        # QLOG will make sure they are allowed.
        QLOG::set_options( @options );

        QLOG::check_option_conflicts(); 

        1;          # Ensure true value returned if no exception occurs.
    } or usage($@);

    return;
}

sub usage {

    my $message = shift || '';
    $message = '' if $message eq 'help';

    print <<"END";
$message

Use this proggy right.

END

    exit;
}

You might want to add a method to make your debug messages suppressable.

Something like:

sub SUPPRESSED_BY {
     my $mode = shift;

     return if exists $DEBUG_OPTIONS{$mode);

     return @_; 
}

Export the symbol and then use it like:

DEBUG VERBOSE => SUPPRESSED_BY SUPPRESS_ERRORS => 'My message here';

The ease with which a logging module can be thrown together has lead to there being a large number of such modules available. There are so many ways to accomplish this task and different variations on the requirements when instrumenting code that there are even more. I’ve even written a few logging modules to meet various needs.

Anyhow, this should give you a serious dunk in the water as you dive head-first into Perl.

Feel free to ask me ‘what the heck?’ type questions. I realize I’m throwing a lot at you.