Initial Commit

database/perl/vendor/lib/Log/Message/Config.pm

@@ -0,0 +1,198 @@
+package Log::Message::Config;
+use if $] > 5.017, 'deprecate';
+use strict;
+
+use Params::Check qw[check];
+use Module::Load;
+use FileHandle;
+use Locale::Maketext::Simple Style => 'gettext';
+
+BEGIN {
+    use vars        qw[$VERSION $AUTOLOAD];
+    $VERSION    =   '0.08';
+}
+
+sub new {
+    my $class = shift;
+    my %hash  = @_;
+
+    ### find out if the user specified a config file to use
+    ### and/or a default configuration object
+    ### and remove them from the argument hash
+    my %special =   map { lc, delete $hash{$_} }
+                    grep /^config|default$/i, keys %hash;
+
+    ### allow provided arguments to override the values from the config ###
+    my $tmpl = {
+        private => { default => undef,  },
+        verbose => { default => 1       },
+        tag     => { default => 'NONE', },
+        level   => { default => 'log',  },
+        remove  => { default => 0       },
+        chrono  => { default => 1       },
+    };
+
+    my %lc_hash = map { lc, $hash{$_} } keys %hash;
+
+    my $file_conf;
+    if( $special{config} ) {
+        $file_conf = _read_config_file( $special{config} )
+                        or ( warn( loc(q[Could not parse config file!]) ), return );
+    }
+
+    my $def_conf = \%{ $special{default} || {} };
+
+    ### make sure to only include keys that are actually defined --
+    ### the checker will assign even 'undef' if you have provided that
+    ### as a value
+    ### priorities goes as follows:
+    ### 1: arguments passed
+    ### 2: any config file passed
+    ### 3: any default config passed
+    my %to_check =  map     { @$_ }
+                    grep    { defined $_->[1] }
+                    map     {   [ $_ =>
+                                    defined $lc_hash{$_}        ? $lc_hash{$_}      :
+                                    defined $file_conf->{$_}    ? $file_conf->{$_}  :
+                                    defined $def_conf->{$_}     ? $def_conf->{$_}   :
+                                    undef
+                                ]
+                            } keys %$tmpl;
+
+    my $rv = check( $tmpl, \%to_check, 1 )
+                or ( warn( loc(q[Could not validate arguments!]) ), return );
+
+    return bless $rv, $class;
+}
+
+sub _read_config_file {
+    my $file = shift or return;
+
+    my $conf = {};
+    my $FH = new FileHandle;
+    $FH->open("$file", 'r') or (
+                        warn(loc(q[Could not open config file '%1': %2],$file,$!)),
+                        return {}
+                    );
+
+    while(<$FH>) {
+        next if     /\s*#/;
+        next unless /\S/;
+
+        chomp; s/^\s*//; s/\s*$//;
+
+        my ($param,$val) = split /\s*=\s*/;
+
+        if( (lc $param) eq 'include' ) {
+            load $val;
+            next;
+        }
+
+        ### add these to the config hash ###
+        $conf->{ lc $param } = $val;
+    }
+    close $FH;
+
+    return $conf;
+}
+
+sub AUTOLOAD {
+    $AUTOLOAD =~ s/.+:://;
+
+    my $self = shift;
+
+    return $self->{ lc $AUTOLOAD } if exists $self->{ lc $AUTOLOAD };
+
+    die loc(q[No such accessor '%1' for class '%2'], $AUTOLOAD, ref $self);
+}
+
+sub DESTROY { 1 }
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Message::Config - Configuration options for Log::Message
+
+=head1 SYNOPSIS
+
+    # This module is implicitly used by Log::Message to create a config
+    # which it uses to log messages.
+    # For the options you can pass, see the C<Log::Message new()> method.
+
+    # Below is a sample of a config file you could use
+
+    # comments are denoted by a single '#'
+    # use a shared stack, or have a private instance?
+    # if none provided, set to '0',
+    private = 1
+
+    # do not be verbose
+    verbose = 0
+
+    # default tag to set on new items
+    # if none provided, set to 'NONE'
+    tag = SOME TAG
+
+    # default level to handle items
+    # if none provided, set to 'log'
+    level = carp
+
+    # extra files to include
+    # if none provided, no files are auto included
+    include = mylib.pl
+    include = ../my/other/lib.pl
+
+    # automatically delete items
+    # when you retrieve them from the stack?
+    # if none provided, set to '0'
+    remove = 1
+
+    # retrieve errors in chronological order, or not?
+    # if none provided, set to '1'
+    chrono = 0
+
+=head1 DESCRIPTION
+
+Log::Message::Config provides a standardized config object for
+Log::Message objects.
+
+It can either read options as perl arguments, or as a config file.
+See the Log::Message manpage for more information about what arguments
+are valid, and see the Synopsis for an example config file you can use
+
+=head1 SEE ALSO
+
+L<Log::Message>, L<Log::Message::Item>, L<Log::Message::Handlers>
+
+=head1 AUTHOR
+
+This module by
+Jos Boumans E<lt>kane@cpan.orgE<gt>.
+
+=head1 Acknowledgements
+
+Thanks to Ann Barcomb for her suggestions.
+
+=head1 COPYRIGHT
+
+This module is
+copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.
+All rights reserved.
+
+This library is free software;
+you may redistribute and/or modify it under the same
+terms as Perl itself.
+
+=cut
+
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4:

database/perl/vendor/lib/Log/Message/Handlers.pm

@@ -0,0 +1,195 @@
+package Log::Message::Handlers;
+use if $] > 5.017, 'deprecate';
+use strict;
+use vars qw[$VERSION];
+
+$VERSION = '0.08';
+
+=pod
+
+=head1 NAME
+
+Log::Message::Handlers - Message handlers for Log::Message
+
+=head1 SYNOPSIS
+
+    # Implicitly used by Log::Message to serve as handlers for
+    # Log::Message::Item objects
+
+    # Create your own file with a package called
+    # Log::Message::Handlers to add to the existing ones, or to even
+    # overwrite them
+
+    $item->carp;
+
+    $item->trace;
+
+
+=head1 DESCRIPTION
+
+Log::Message::Handlers provides handlers for Log::Message::Item objects.
+The handler corresponding to the level (see Log::Message::Item manpage
+for an explanation about levels) will be called automatically upon
+storing the error.
+
+Handlers may also explicitly be called on an Log::Message::Item object
+if one so desires (see the Log::Message manpage on how to retrieve the
+Item objects).
+
+=head1 Default Handlers
+
+=head2 log
+
+Will simply log the error on the stack, and do nothing special
+
+=cut
+
+sub log { 1 }
+
+=head2 carp
+
+Will carp (see the Carp manpage) with the error, and add the timestamp
+of when it occurred.
+
+=cut
+
+sub carp {
+    my $self = shift;
+    warn join " ", $self->message, $self->shortmess, 'at', $self->when, "\n";
+}
+
+=head2 croak
+
+Will croak (see the Carp manpage) with the error, and add the
+timestamp of when it occurred.
+
+=cut
+
+sub croak {
+    my $self = shift;
+    die join " ", $self->message, $self->shortmess, 'at', $self->when, "\n";
+}
+
+=head2 cluck
+
+Will cluck (see the Carp manpage) with the error, and add the
+timestamp of when it occurred.
+
+=cut
+
+sub cluck {
+    my $self = shift;
+    warn join " ", $self->message, $self->longmess, 'at', $self->when, "\n";
+}
+
+=head2 confess
+
+Will confess (see the Carp manpage) with the error, and add the
+timestamp of when it occurred
+
+=cut
+
+sub confess {
+    my $self = shift;
+    die join " ", $self->message, $self->longmess, 'at', $self->when, "\n";
+}
+
+=head2 die
+
+Will simply die with the error message of the item
+
+=cut
+
+sub die  { die  shift->message; }
+
+
+=head2 warn
+
+Will simply warn with the error message of the item
+
+=cut
+
+sub warn { warn shift->message; }
+
+
+=head2 trace
+
+Will provide a traceback of this error item back to the first one that
+occurred, clucking with every item as it comes across it.
+
+=cut
+
+sub trace {
+    my $self = shift;
+
+    for my $item( $self->parent->retrieve( chrono => 0 ) ) {
+        $item->cluck;
+    }
+}
+
+=head1 Custom Handlers
+
+If you wish to provide your own handlers, you can simply do the
+following:
+
+=over 4
+
+=item *
+
+Create a file that holds a package by the name of
+C<Log::Message::Handlers>
+
+=item *
+
+Create subroutines with the same name as the levels you wish to
+handle in the Log::Message module (see the Log::Message manpage for
+explanation on levels)
+
+=item *
+
+Require that file in your program, or add it in your configuration
+(see the Log::Message::Config manpage for explanation on how to use a
+config file)
+
+=back
+
+And that is it, the handler will now be available to handle messages
+for you.
+
+The arguments a handler may receive are those specified by the
+C<extra> key, when storing the message.
+See the Log::Message manpage for details on the arguments.
+
+=head1 SEE ALSO
+
+L<Log::Message>, L<Log::Message::Item>, L<Log::Message::Config>
+
+=head1 AUTHOR
+
+This module by
+Jos Boumans E<lt>kane@cpan.orgE<gt>.
+
+=head1 Acknowledgements
+
+Thanks to Ann Barcomb for her suggestions.
+
+=head1 COPYRIGHT
+
+This module is
+copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.
+All rights reserved.
+
+This library is free software;
+you may redistribute and/or modify it under the same
+terms as Perl itself.
+
+=cut
+
+1;
+
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4:

database/perl/vendor/lib/Log/Message/Item.pm

@@ -0,0 +1,194 @@
+package Log::Message::Item;
+use if $] > 5.017, 'deprecate';
+
+use strict;
+use vars qw[$VERSION];
+use Params::Check qw[check];
+use Log::Message::Handlers;
+
+### for the messages to store ###
+use Carp ();
+
+BEGIN {
+    use vars qw[$AUTOLOAD $VERSION];
+
+    $VERSION    =   '0.08';
+}
+
+### create a new item.
+### note that only an id (position on the stack), message and a reference
+### to its parent are required. all the other things it can fill in itself
+sub new {
+    my $class   = shift;
+    my %hash    = @_;
+
+    my $tmpl = {
+        when        => { no_override    => 1,   default    => scalar localtime },
+        id          => { required       => 1    },
+        message     => { required       => 1    },
+        parent      => { required        => 1    },
+        level       => { default        => ''   },      # default may be conf dependant
+        tag         => { default        => ''   },      # default may be conf dependant
+        longmess    => { default        => _clean(Carp::longmess()) },
+        shortmess   => { default        => _clean(Carp::shortmess())},
+    };
+
+    my $args = check($tmpl, \%hash) or return undef;
+
+    return bless $args, $class;
+}
+
+sub _clean { map { s/\s*//; chomp; $_ } shift; }
+
+sub remove {
+    my $item = shift;
+    my $self = $item->parent;
+
+    return splice( @{$self->{STACK}}, $item->id, 1, undef );
+}
+
+sub AUTOLOAD {
+    my $self = $_[0];
+
+    $AUTOLOAD =~ s/.+:://;
+
+    return $self->{$AUTOLOAD} if exists $self->{$AUTOLOAD};
+
+    local $Carp::CarpLevel = $Carp::CarpLevel + 3;
+
+    {   no strict 'refs';
+        return *{"Log::Message::Handlers::${AUTOLOAD}"}->(@_);
+    }
+}
+
+sub DESTROY { 1 }
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Message::Item  - Message objects for Log::Message
+
+=head1 SYNOPSIS
+
+    # Implicitly used by Log::Message to create Log::Message::Item objects
+
+    print "this is the message's id: ",     $item->id;
+
+    print "this is the message stored: ",   $item->message;
+
+    print "this is when it happened: ",     $item->when;
+
+    print "the message was tagged: ",       $item->tag;
+
+    print "this was the severity level: ",  $item->level;
+
+    $item->remove;  # delete the item from the stack it was on
+
+    # Besides these methods, you can also call the handlers on
+    # the object specifically.
+    # See the Log::Message::Handlers manpage for documentation on what
+    # handlers are available by default and how to add your own
+
+
+=head1 DESCRIPTION
+
+Log::Message::Item is a class that generates generic Log items.
+These items are stored on a Log::Message stack, so see the Log::Message
+manpage about details how to retrieve them.
+
+You should probably not create new items by yourself, but use the
+storing mechanism provided by Log::Message.
+
+However, the accessors and handlers are of interest if you want to do
+fine tuning of how your messages are handled.
+
+The accessors and methods are described below, the handlers are
+documented in the Log::Message::Handlers manpage.
+
+=head1 Methods and Accessors
+
+=head2 remove
+
+Calling remove will remove the object from the stack it was on, so it
+will not show up any more in subsequent fetches of messages.
+
+You can still call accessors and handlers on it however, to handle it
+as you will.
+
+=head2 id
+
+Returns the internal ID of the item. This may be useful for comparing
+since the ID is incremented each time a new item is created.
+Therefore, an item with ID 4 must have been logged before an item with
+ID 9.
+
+=head2 when
+
+Returns the timestamp of when the message was logged
+
+=head2 message
+
+The actual message that was stored
+
+=head2 level
+
+The severity type of this message, as well as the name of the handler
+that was called upon storing it.
+
+=head2 tag
+
+Returns the identification tag that was put on the message.
+
+=head2 shortmess
+
+Returns the equivalent of a C<Carp::shortmess> for this item.
+See the C<Carp> manpage for details.
+
+=head2 longmess
+
+Returns the equivalent of a C<Carp::longmess> for this item, which
+is essentially a stack trace.
+See the C<Carp> manpage for details.
+
+=head2 parent
+
+Returns a reference to the Log::Message object that stored this item.
+This is useful if you want to have access to the full stack in a
+handler.
+
+=head1 SEE ALSO
+
+L<Log::Message>, L<Log::Message::Handlers>, L<Log::Message::Config>
+
+=head1 AUTHOR
+
+This module by
+Jos Boumans E<lt>kane@cpan.orgE<gt>.
+
+=head1 Acknowledgements
+
+Thanks to Ann Barcomb for her suggestions.
+
+=head1 COPYRIGHT
+
+This module is
+copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.
+All rights reserved.
+
+This library is free software;
+you may redistribute and/or modify it under the same
+terms as Perl itself.
+
+=cut
+
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4:

database/perl/vendor/lib/Log/Message/Simple.pm

@@ -0,0 +1,296 @@
+package Log::Message::Simple;
+use if $] > 5.017, 'deprecate';
+
+use strict;
+use Log::Message private => 0;;
+
+BEGIN {
+    use vars qw[$VERSION];
+    $VERSION = '0.10';
+}
+
+
+=pod
+
+=head1 NAME
+
+Log::Message::Simple - Simplified interface to Log::Message
+
+=head1 SYNOPSIS
+
+    use Log::Message::Simple qw[msg error debug
+                                carp croak cluck confess];
+
+    use Log::Message::Simple qw[:STD :CARP];
+
+    ### standard reporting functionality
+    msg(    "Connecting to database",           $verbose );
+    error(  "Database connection failed: $@",   $verbose );
+    debug(  "Connection arguments were: $args", $debug );
+
+    ### standard carp functionality
+    carp(   "Wrong arguments passed: @_" );
+    croak(  "Fatal: wrong arguments passed: @_" );
+    cluck(  "Wrong arguments passed -- including stacktrace: @_" );
+    confess("Fatal: wrong arguments passed -- including stacktrace: @_" );
+
+    ### retrieve individual message
+    my @stack = Log::Message::Simple->stack;
+    my @stack = Log::Message::Simple->flush;
+
+    ### retrieve the entire stack in printable form
+    my $msgs  = Log::Message::Simple->stack_as_string;
+    my $trace = Log::Message::Simple->stack_as_string(1);
+
+    ### redirect output
+    local $Log::Message::Simple::MSG_FH     = \*STDERR;
+    local $Log::Message::Simple::ERROR_FH   = \*STDERR;
+    local $Log::Message::Simple::DEBUG_FH   = \*STDERR;
+
+    ### force a stacktrace on error
+    local $Log::Message::Simple::STACKTRACE_ON_ERROR = 1
+
+=head1 DESCRIPTION
+
+This module provides standardized logging facilities using the
+C<Log::Message> module.
+
+=head1 FUNCTIONS
+
+=head2 msg("message string" [,VERBOSE])
+
+Records a message on the stack, and prints it to C<STDOUT> (or actually
+C<$MSG_FH>, see the C<GLOBAL VARIABLES> section below), if the
+C<VERBOSE> option is true.
+The C<VERBOSE> option defaults to false.
+
+Exported by default, or using the C<:STD> tag.
+
+=head2 debug("message string" [,VERBOSE])
+
+Records a debug message on the stack, and prints it to C<STDOUT> (or
+actually C<$DEBUG_FH>, see the C<GLOBAL VARIABLES> section below),
+if the C<VERBOSE> option is true.
+The C<VERBOSE> option defaults to false.
+
+Exported by default, or using the C<:STD> tag.
+
+=head2 error("error string" [,VERBOSE])
+
+Records an error on the stack, and prints it to C<STDERR> (or actually
+C<$ERROR_FH>, see the C<GLOBAL VARIABLES> sections below), if the
+C<VERBOSE> option is true.
+The C<VERBOSE> options defaults to true.
+
+Exported by default, or using the C<:STD> tag.
+
+=cut
+
+{   package Log::Message::Handlers;
+
+    sub msg {
+        my $self    = shift;
+        my $verbose = shift || 0;
+
+        ### so you don't want us to print the msg? ###
+        return if defined $verbose && $verbose == 0;
+
+        my $old_fh = select $Log::Message::Simple::MSG_FH;
+        print '['. $self->tag (). '] ' . $self->message . "\n";
+        select $old_fh;
+
+        return;
+    }
+
+    sub debug {
+        my $self    = shift;
+        my $verbose = shift || 0;
+
+        ### so you don't want us to print the msg? ###
+        return if defined $verbose && $verbose == 0;
+
+        my $old_fh = select $Log::Message::Simple::DEBUG_FH;
+        print '['. $self->tag (). '] ' . $self->message . "\n";
+        select $old_fh;
+
+        return;
+    }
+
+    sub error {
+        my $self    = shift;
+        my $verbose = shift;
+           $verbose = 1 unless defined $verbose;    # default to true
+
+        ### so you don't want us to print the error? ###
+        return if defined $verbose && $verbose == 0;
+
+        my $old_fh = select $Log::Message::Simple::ERROR_FH;
+
+        my $msg     = '['. $self->tag . '] ' . $self->message;
+
+        print $Log::Message::Simple::STACKTRACE_ON_ERROR
+                    ? Carp::shortmess($msg)
+                    : $msg . "\n";
+
+        select $old_fh;
+
+        return;
+    }
+}
+
+=head2 carp();
+
+Provides functionality equal to C<Carp::carp()> while still logging
+to the stack.
+
+Exported by using the C<:CARP> tag.
+
+=head2 croak();
+
+Provides functionality equal to C<Carp::croak()> while still logging
+to the stack.
+
+Exported by using the C<:CARP> tag.
+
+=head2 confess();
+
+Provides functionality equal to C<Carp::confess()> while still logging
+to the stack.
+
+Exported by using the C<:CARP> tag.
+
+=head2 cluck();
+
+Provides functionality equal to C<Carp::cluck()> while still logging
+to the stack.
+
+Exported by using the C<:CARP> tag.
+
+=head1 CLASS METHODS
+
+=head2 Log::Message::Simple->stack()
+
+Retrieves all the items on the stack. Since C<Log::Message::Simple> is
+implemented using C<Log::Message>, consult its manpage for the
+function C<retrieve> to see what is returned and how to use the items.
+
+=head2 Log::Message::Simple->stack_as_string([TRACE])
+
+Returns the whole stack as a printable string. If the C<TRACE> option is
+true all items are returned with C<Carp::longmess> output, rather than
+just the message.
+C<TRACE> defaults to false.
+
+=head2 Log::Message::Simple->flush()
+
+Removes all the items from the stack and returns them. Since
+C<Log::Message::Simple> is  implemented using C<Log::Message>, consult its
+manpage for the function C<retrieve> to see what is returned and how
+to use the items.
+
+=cut
+
+BEGIN {
+    use Exporter;
+    use Params::Check   qw[ check ];
+    use vars            qw[ @EXPORT @EXPORT_OK %EXPORT_TAGS @ISA ];;
+
+    @ISA            = 'Exporter';
+    @EXPORT         = qw[error msg debug];
+    @EXPORT_OK      = qw[carp cluck croak confess];
+
+    %EXPORT_TAGS    = (
+        STD     => \@EXPORT,
+        CARP    => \@EXPORT_OK,
+        ALL     => [ @EXPORT, @EXPORT_OK ],
+    );
+
+    my $log         = new Log::Message;
+
+    for my $func ( @EXPORT, @EXPORT_OK ) {
+        no strict 'refs';
+
+                        ### up the carplevel for the carp emulation
+                        ### functions
+        *$func = sub {  local $Carp::CarpLevel += 2
+                            if grep { $_ eq $func } @EXPORT_OK;
+
+                        my $msg     = shift;
+                        $log->store(
+                                message => $msg,
+                                tag     => uc $func,
+                                level   => $func,
+                                extra   => [@_]
+                        );
+                };
+    }
+
+    sub flush {
+        return reverse $log->flush;
+    }
+
+    sub stack {
+        return $log->retrieve( chrono => 1 );
+    }
+
+    sub stack_as_string {
+        my $class = shift;
+        my $trace = shift() ? 1 : 0;
+
+        return join $/, map {
+                        '[' . $_->tag . '] [' . $_->when . '] ' .
+                        ($trace ? $_->message . ' ' . $_->longmess
+                                : $_->message);
+                    } __PACKAGE__->stack;
+    }
+}
+
+=head1 GLOBAL VARIABLES
+
+=over 4
+
+=item $ERROR_FH
+
+This is the filehandle all the messages sent to C<error()> are being
+printed. This defaults to C<*STDERR>.
+
+=item $MSG_FH
+
+This is the filehandle all the messages sent to C<msg()> are being
+printed. This default to C<*STDOUT>.
+
+=item $DEBUG_FH
+
+This is the filehandle all the messages sent to C<debug()> are being
+printed. This default to C<*STDOUT>.
+
+=item $STACKTRACE_ON_ERROR
+
+If this option is set to C<true>, every call to C<error()> will
+generate a stacktrace using C<Carp::shortmess()>.
+Defaults to C<false>
+
+=back
+
+=cut
+
+BEGIN {
+    use vars qw[ $ERROR_FH $MSG_FH $DEBUG_FH $STACKTRACE_ON_ERROR ];
+
+    local $| = 1;
+    $ERROR_FH               = \*STDERR;
+    $MSG_FH                 = \*STDOUT;
+    $DEBUG_FH               = \*STDOUT;
+
+    $STACKTRACE_ON_ERROR    = 0;
+}
+
+
+1;
+
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4: