MMAgic.pl

Go to the documentation of this file.

#!/usr/bin/perl
#
=head1 NAME

MMAgic.pl - Demonstrate use of various MMAgic packages.

=head1 SYNOPSIS

    usage: MMAgic.pl <flag>* <file>
    <flag>
        --curse         # cause endless recursion in process() function
        --show          # show object parsed from input file before conversion
        --trace=<tag>   # trace processing for SUBS and/or DETAIL
                        #   (can be used multiple times)

=head1 DESCRIPTION

Simple program to convert a configuration file in Perl data structure code
into WDDX (XML data exchange format) format.

The real purpose of this script is to demonstrate the use of selected
<tt>MMAgic</tt> libraries from my personal toolkit.

=over

=item MMAgic::Data

Loads data from a file that written in Perl data structure syntax.
This is done by simply evaluating the contents of the file using the Perl interpreter.
The <tt>Safe</tt> module is used to lock down the kinds of operations that the
interpreter will parse, in an attempt to make this mechanism safe.

=item MMAgic::Log

Tagged log statements in a consistent format.
Uses indentable output stream to show stack depth context of log statements.
Provides data dump formats and subroutine information as required.

=item MMAgic::Output

Indentable output stream used by Log.pm.
Also used to generate nicely formatted WDDX output in this example.

=item MMAgic::Trace

Filter-based trace mechanism.
When disabled, trace statements are merely comments,
so there is no run-time penalty.

=back

=head1 EXAMPLES

    MMAgic.pl                                        # usage message
    MMAgic.pl demo/book.data                         # working example
    MMAgic.pl demo/time.data                         # bad data file error
    MMAgic.pl demo/oops.data                         # non-existent data file
    MMAgic.pl demo/book.data --trace=SUBS            # see trace statements
    MMAgic.pl demo/book.data --trace=SUBS --trace=DETAIL
    MMAgic.pl demo/book.data --trace=SUBS --curse    # endless recursion

=head1 METHODS

=over

=cut

use     strict;
use     warnings;
use     UNIVERSAL   qw(isa);

use     FindBin;
use     File::Basename;
use     Getopt::Long;
use     Pod::Usage;

use lib $FindBin::Bin;

use     MMAgic::Data;
use     MMAgic::Log;
use     MMAgic::Trace;

our %option;

###########################################################################

=item   C<process($data, $stream)>

Recursively process the data object to generate WDDX output.

=cut

#=| \param  $data   Data structure from which to generate WDDX output.
#=| \param  $stream MMAgic::Output stream on which to generate WDDX output

sub process
    {
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # MMAgic Demo:
    #   The Log->method() mechanism looks up the stack for the function name.
    #   The block() call returns an indentation object that causes
    #   automagic indentation of output log and pops indent when
    #   the indentation object is destroyed at the end of the function.
    #   Can't do that in Java!!!
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#!# my  $auto   = Log->method(@_)->block;                       #[SUBS]
    my  $data   = shift;
    my  $stream = shift;

    if (isa($data, 'HASH'))
        {
#!#     Log->trace('Found HASH object');                        #[DETAIL]
        $stream->print("<struct>\n")->pushIndent;
        
        map {
            $stream->print("<var name='$_'>\n")->pushIndent;
                process($data->{$_}, $stream);
            $stream->popIndent->print("</var>\n");
            } keys %$data;

        $stream->popIndent->print("</struct>\n");
        }

    elsif (isa($data, 'ARRAY'))
        {
#!#     Log->trace('Found ARRAY object');                       #[DETAIL]
        $stream->print("<array length='", scalar(@$data), "'>\n")->pushIndent;
        
        map {
            process($_, $stream);
            } @$data;

        $stream->popIndent->print("</array>\n");
        }
    
    elsif (ref($data))
        {
        # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        # MMAgic Demo:
        #   Not interpolating the object allows the Log mechanism
        #   to handle various aberrant cases, such as undef:
        # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        Log->warning('Unknown data object:  ', $data);
        $stream->print("<string>Error converting:  $data</string>\n");
        }

    elsif (! defined($data))
        {
#!#     Log->trace('Found undefined object');                   #[DETAIL]
        $stream->print("<null/>\n");
        }
    
    elsif ($data =~ /[-+]?\d+(?:\.\d+)?/)
        {
#!#     Log->trace('Found numeric object');                     #[DETAIL]
        $stream->print('<number>', $data, "</number>\n");
        }
    
    else
        {
        # By default it must be a string (or printable as such):
#!#     Log->trace('Found string object');                      #[DETAIL]
        $stream->print('<string>', $data, "</string>\n");
        
        if ($option{curse})
            {
            # Simulate an infinite recursion error:
            process($data, $stream);
            }
        }
    }

###########################################################################
###########################################################################
#
# Main program.
#

# Parameter parsing using standard Perl packages:

pod2usage(2)
    unless GetOptions(\%option, qw(curse! show trace=s help));

pod2usage(1)
    if $option{help};

pod2usage('No files specified for conversion')
    unless @ARGV;

$option{file} = shift @ARGV;

Log->crash('Non-existent file ', $option{file})
    unless -f $option{file};

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# MMAgic Demo:
#   Setup error logging...
#   MMAgic::Output provides an indentable output stream.
#   MMAgic::Log adds useful logging functions and a class-level interface.
#   It also places a timestamp and a log type on each line:
#
#       2002/05/13 19:06:30 [E] error message
#       2002/05/13 19:06:30 [W] warning message
#       2002/05/13 19:06:30 [T] trace statement
#       2002/05/13 19:06:30 [I] informational message
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Log->handle;    # Initiate __WARN__ and __DIE__ handlers
                #   which redirect to current Log.

###########################################################################

Log->info('Starting ', $0);

my  $data;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# MMAgic Demo:
#   Open input file as a MMAgic::Data object.
#   MMAgic::Data actually evaluates the file contents which are
#   in Perl data structure syntax within a Safe context to
#   prevent execution of unauthorized code.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

tie $data, 'MMAgic::Data', $option{file};

Log->trace('Actual object:')->display($data)
    if $option{show};

my ($name, $path, $suff) = fileparse($option{file}, '\.[^\.]*');

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# MMAgic Demo:
#   Open output file as MMAgic::Output stream which supports indentation.
#   Indentation supports makes it easier to generate readable WDDX output.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

my  $wddx = new MMAgic::Output(pathname => "$path$name.wddx");

# Generate the WDDX output:

$wddx->print(<<WDDX_HDR);
<?xml version='1.0'?>
<!DOCTYPE wddxPacket SYSTEM 'wddx_0100.dtd'>

<wddxPacket version='1.0'>
  <header/>

  <data>
WDDX_HDR

$wddx->pushIndent(4);
    process($data, $wddx);
$wddx->popIndent;

$wddx->print(<<WDDX_FTR);
  </data>
</wddxPacket>
WDDX_FTR

Log->info('Finished ', $0);

__END__

=back

=head1 AUTHOR

Marc M. Adkins, L<mailto:Perl@Doorways.org>

=head1 COPYRIGHT AND LICENSE

Copyright 2004-2008 by Marc M. Adkins

=cut