How can I enable a debugging mode via a command-line switch for my Perl program?

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

I think you are facing two issues here. First, to handle more complex command-line parsing, use the core Getopt::Std or Getopt::Long modules instead of the -s command line switch.

The second issue (I think) is that you are trying to have some magic way to skip your debug statements when debug mode is enabled. I'm not aware of any standard module that does that, but it is possible with constructs of the variety:

eval {  ...code block... } if($debug);

This does not mean it is necessarily a good idea to alter your program's logic depending on whether debug mode is enabled. You should aim to limit "debug mode" to alter the output of your program rather than the logic, or you will spend many hours wondering why it works in debug mode and not in 'production mode'.

Answer 2

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.

Answer 3

Based on your response to Tore, I hacked up this sample.

#!/usr/bin/perl 

use strict;
use warnings;

use Getopt::Long;

my $count_letters;
my $eat_beans;
my $count_beans;
my $data_file;

GetOptions (
    'count-letters' => \$count_letters,
    'count-beans'   => \$count_beans,
    'eat-beans'     => \$eat_beans,
    'data-file=s'   => \$data_file,
    'help'          => \&usage,
) or usage();

# Build code ref arrays.

my @validate_file =
  ( $count_beans   ? \&count_beans   : () ),
  ( $count_letters ? \&count_letters : () ),
  ;

my @validate_line = 
  ( $eat_beans     ? \&eat_beans     : () ),
  ;


process_file( $data_file, \@validate_line, \@validate_file );


sub process_file {
    my $file           = shift;
    my $validate_lines = shift;
    my $validate_file  = shift;

    open my $fh, '<', $file or die "$file : $!";

    my @data;
    while( my $line = $fh->readline ) {

        # Validate each line with each line validator

        $_->($line) or die 'Invalid line' 
            for @$validate_lines;

        push @data, $line;
    }

    # Validate the whole file with the each file validator.
    $_->(\@data) or die 'Invalid file' 
        for @$validate_file;
}

# Put real subs here:

sub eat_beans     { 1 }

sub count_beans   { 1 }
sub count_letters { 1 }

As for testing, you probably want to put all your validation subs into a module and use normal perl testing tools (see Test::Simple and Test::More to get started).

I like to structure my apps by having a thin CLI parser that configures the underlying data set that is used by the main app logic which lives in a module.

This makes it very easy to write unit tests to verify that the code is good.

Answer 4

To answer this:

I don't understand why the above lines of code "magically works".

The reason is that you're checking for the values of the debug switch with a regular expression, as in:

if(defined($debug_mode) && !($debug_mode =~ DEBUG_SUPPRESS_ERROR_MSGS))

So if you have:

$debug_mode = "sv"

and as a reminder:

use constant DEBUG_VERBOSE             => "v";
use constant DEBUG_SUPPRESS_ERROR_MSGS   => "s";

Then both of these will evaluate true:

$debug_mode =~ DEBUG_SUPPRESS_ERROR_MSGS;
$debug_mode =~ DEBUG_VERBOSE;

If you want to check for exactly one value you can try:

if ($debug_mode eq DEBUG_SUPPRESS_ERROR_MSGS) {...}
if ($debug_mode eq DEBUG_VERBOSE) {...}

or else

if ($debug_mode =~ /\bDEBUG_SUPPRESS_ERROR_MSGS\b/) {...}
if ($debug_mode =~ /\bDEBUG_VERBOSE/b\) {...}

where the \b tells the regex to match a word boundary. Of course, that if you have $debug_mode ="s v" then the regex will evaluate true as well.