Config::Manager::Report - Error Reporting and Logging Module

Config-Manager documentation Contained in the Config-Manager distribution.

Index

Code Index:

NAME

Top

Config::Manager::Report - Error Reporting and Logging Module

SYNOPSIS

Top

  use Config::Manager::Report qw(:all);

  $logobject = Config::Manager::Report->new([TOOL[,PATH[,FILE]]]);
  $newlogobject = $logobject->new([TOOL[,PATH[,FILE]]]);

  $default_logobject = Config::Manager::Report->singleton();

  $logobject->report($CMD,$LEVEL,@text);
  Config::Manager::Report->report($CMD,$LEVEL,@text);

    Fuer ($CMD,$LEVEL) sollte stets eine der folgenden
    (oeffentlichen) Konstanten verwendet werden:

        @TRACE
        @INFO
        @WARN
        @ERROR
        @FATAL

    Beispiel:
        Config::Manager::Report->report(@ERROR,@text);

  $logobject->trace();
  Config::Manager::Report->trace();

  $logfile = $logobject->logfile();
  $logfile = Config::Manager::Report->logfile();

  [ $oldlevel = ] $logobject->level([NEWLEVEL]);
  [ $oldlevel = ] Config::Manager::Report->level([NEWLEVEL]);

  [ $oldflag = ] $logobject->notify([NEWFLAG]);
  [ $oldflag = ] Config::Manager::Report->notify([NEWFLAG]);

  $lines = $logobject->ret_hold();
  @text  = $logobject->ret_hold();
  $lines = Config::Manager::Report->ret_hold();
  @text  = Config::Manager::Report->ret_hold();

  $logobject->clr_hold();
  Config::Manager::Report->clr_hold();

DESCRIPTION

Top

Das Logging ist so realisiert, dass die Ausgabe der Meldungen auf den verschiedenen Ausgabekanaelen einzeln (unabhaengig voneinander) gesteuert werden kann. Es gibt die Ausgabekanaele STDOUT, STDERR, Logdatei und Halde.

STDOUT und STDERR sind die ueblichen Standard-Ausgabekanaele. Auf Wunsch koennen Meldungen aber auch in das Logfile geschrieben werden. Auf der Halde koennen Meldungen gekellert werden. Die Meldungen werden dann erst auf Anforderung auf dem Bildschirm ausgegeben.

Bei Verwendung der Funktion "ReportErrorAndExit()" aus dem Modul "Config::Manager::Base.pm" wird vor Beendigung des Programms die Halde auf STDERR ausgegeben, falls sie nicht leer ist.

Bei Verwendung der Standard-Konstanten @TRACE @INFO @WARN @ERROR @FATAL werden alle Meldungen immer auch in die Logdatei geschrieben, damit keine (moeglicherweise wichtige!) Information verlorengehen kann.

Das sollte man auch dann immer tun, wenn man diese Standard-Konstanten nicht verwendet.

SEE ALSO

Top

Config::Manager(3), Config::Manager::Base(3), Config::Manager::Conf(3), Config::Manager::File(3), Config::Manager::PUser(3), Config::Manager::SendMail(3), Config::Manager::User(3).

VERSION

Top

This man page documents "Config::Manager::Report" version 1.7.

AUTHORS

Top

 Steffen Beyer <sb@engelschall.com>
 http://www.engelschall.com/u/sb/download/
 Gerhard Albers

COPYRIGHT

Top

 Copyright (c) 2003 by Steffen Beyer & Gerhard Albers.
 All rights reserved.

LICENSE

Top

This package is free software; you can use, modify and redistribute it under the same terms as Perl itself, i.e., under the terms of the "Artistic License" or the "GNU General Public License".

Please refer to the files "Artistic.txt" and "GNU_GPL.txt" in this distribution, respectively, for more details!

DISCLAIMER

Top

This package is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

See the "GNU General Public License" for more details.

Config-Manager documentation Contained in the Config-Manager distribution. 
###############################################################################
##                                                                           ##
##    Copyright (c) 2003 by Steffen Beyer & Gerhard Albers.                  ##
##    All rights reserved.                                                   ##
##                                                                           ##
##    This package is free software; you can redistribute it                 ##
##    and/or modify it under the same terms as Perl itself.                  ##
##                                                                           ##
###############################################################################

package Config::Manager::Report;

use strict;
use vars qw( @ISA @EXPORT @ALL @AUX @EXPORT_OK %EXPORT_TAGS $VERSION %SIG
             $SHOW_ALL $USE_LEADIN $STACKTRACE
             $LEVEL_TRACE $LEVEL_INFO $LEVEL_WARN $LEVEL_ERROR $LEVEL_FATAL
             $FROM_HOLD $TO_HLD $TO_OUT $TO_ERR $TO_LOG
             @TRACE @INFO @WARN @ERROR @FATAL );

require Exporter;

@ISA = qw(Exporter);

@EXPORT = qw();

@ALL = qw( $SHOW_ALL $USE_LEADIN $STACKTRACE
           $LEVEL_TRACE $LEVEL_INFO $LEVEL_WARN $LEVEL_ERROR $LEVEL_FATAL
           $FROM_HOLD $TO_HLD $TO_OUT $TO_ERR $TO_LOG
           @TRACE @INFO @WARN @ERROR @FATAL
           end abort );

@AUX = qw( Normalize MakeDir );

@EXPORT_OK = (@ALL,@AUX);

%EXPORT_TAGS =
(
    all => [@ALL],
    aux => [@AUX],
    ALL => [@EXPORT_OK]
);

$VERSION = '1.7';

use Config::Manager::Conf qw( whoami );
use Symbol;

#######################
## Public constants: ##
#######################

$TO_HLD      = 0x01;
$TO_OUT      = 0x02;
$TO_ERR      = 0x04;
$TO_LOG      = 0x08;
$FROM_HOLD   = 0x10;

$USE_LEADIN  = 0x01;
$STACKTRACE  = 0x02;

$LEVEL_TRACE = 0x00;
$LEVEL_INFO  = 0x04;
$LEVEL_WARN  = 0x08;
$LEVEL_ERROR = 0x0C;
$LEVEL_FATAL = 0x10;

$SHOW_ALL    = 0x00;

@TRACE = ( $TO_LOG          , $LEVEL_TRACE + $USE_LEADIN );
@INFO  = ( $TO_LOG + $TO_OUT, $LEVEL_INFO  + $USE_LEADIN );
@WARN  = ( $TO_LOG + $TO_ERR, $LEVEL_WARN  + $USE_LEADIN );
@ERROR = ( $TO_LOG + $TO_HLD, $LEVEL_ERROR + $USE_LEADIN );
@FATAL = ( $TO_LOG + $TO_HLD, $LEVEL_FATAL + $USE_LEADIN );

#######################################
## Internal configuration constants: ##
#######################################

my $LOGSUFFIX = 'log';

my @LOGFILEPATH  = ('DEFAULT', 'LOGFILEPATH');
my @FULLNAME     = ('Person',  'Name');

my $RULER   = '_' x 78 . "\n";
my $HEADER  = 'STARTED';
my $CMDLINE = 'COMMAND';
my $LOGFILE = 'LOGFILE';
my $FOOTER  = 'ENDED';

my @LEADIN =
(
    [ 'TRACE',  'HINT',  'WARNING',  'ERROR',  'EXCEPTION'  ], # Singular
    [ 'TRACES', 'HINTS', 'WARNINGS', 'ERRORS', 'EXCEPTIONS' ]  # Plural
);

my $LINE0 = 'line on hold';
my $LINE1 = 'lines on hold';

my $STAT_MIN = 1;
my $STAT_MAX = 4;

my $STARTDEPTH = 0;
my $MAXEVALLEN = 0; # 0 = no limit

#######################
## Global variables: ##
#######################

my $Singleton = 0;

my @Inventory = ();

my $User = (&whoami())[0] || '';

my $Count = 0;

########################
## Private functions: ##
########################

sub _warn_
{
    my($text) = @_;
    $text =~ s!\s+$!!;
    Config::Manager::Report->report
    (
        $TO_LOG+$TO_ERR, $LEVEL_WARN+$USE_LEADIN, $text
    )
}

sub _die_
{
    my($text) = @_;
    $text =~ s!\s+$!!;
    Config::Manager::Report->report
    (
        $TO_LOG+$TO_ERR, $LEVEL_FATAL+$USE_LEADIN, $text
    )
    if (defined $^S); # no logging during startup
}

sub _adjust # code "stolen" from Carp.pm:
{
    my($pack,$file,$line,$sub,$hargs,$warray,$eval,$require) = @_;

    if (defined $eval)
    {
        if ($require)
        {
            $sub = "require $eval";
        }
        else
        {
            if ($MAXEVALLEN && length($eval) > $MAXEVALLEN)
            {
                substr($eval,$MAXEVALLEN) = '...';
            }
            $eval =~ s!([\\\'])!\\$1!g;
            $sub = "eval '$eval'";
        }
    }
    elsif ($sub eq '(eval)')
    {
        $sub = 'eval {...}';
    }
    return $sub;
}

sub _ShortTime
{
    my($s,$m,$h,$dd,$mm,$yy) = localtime(time);
    $yy %= 100;
    $mm++;
    return sprintf("%02d%02d%02d-%02d%02d%02d", $yy,$mm,$dd,$h,$m,$s);
}

sub _LongTime
{
    my($s,$m,$h,$dd,$mm,$yy) = localtime(time);
    $yy += 1900;
    $mm = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$mm];
    return sprintf("%02d-%s-%d %02d:%02d:%02d", $dd,$mm,$yy,$h,$m,$s);
}

sub _which
{
    my($self) = shift;

    if (ref $self) { return $self; }
    else
    {
        unless (ref $Singleton)
        {
            if (ref ($Singleton = Config::Manager::Report->new(@_)))
            {
                ${$Singleton}{'singleton'} = 1;
                $SIG{'__WARN__'} = \&_warn_;
                $SIG{'__DIE__'}  = \&_die_;
            }
        }
        return $Singleton;
    }
}

sub DESTROY
{
    my($self,$close) = @_;
    my($text,$item,$count,$file,$handle);

    return unless (ref $self and keys %{$self});
    $text = "\n" . $RULER . "\n $FOOTER: " . _LongTime();
    for ( $item = $STAT_MIN; $item <= $STAT_MAX; $item++ )
    {
        if ((defined ($count = ${${$self}{'stat'}}[$item])) && ($count > 0))
        {
            $text .= " - $count ";
            if ($count == 1) { $text .= ucfirst(lc($LEADIN[0][$item])); }
            else             { $text .= ucfirst(lc($LEADIN[1][$item])); }
        }
    }
    if (($count = scalar(@{${$self}{'hold'}})) > 0)
    {
        $text .= " - $count ";
        if ($count == 1) { $text .= $LINE0; }
        else             { $text .= $LINE1; }
    }
    $text .= "\n" . $RULER;
    $file   = ${$self}{'file'};
    $handle = ${$self}{'hand'};
    ${$self}{'level'} = $SHOW_ALL;
    if (${$self}{'flag'})
    {
        $self->report($TO_LOG+$TO_OUT,$LEVEL_INFO,"$LOGFILE = '$file'");
    }
    $self->report($TO_LOG,$LEVEL_INFO,$text);
    # Enable creation of new singleton object if necessary:
    $Singleton = 0 if (${$self}{'singleton'});
    # Prevent closing it again at global destruction time:
    %{$self} = ();
    $text = '';
    unless (close($handle))
    {
        if ($close)
        {
            $text = __PACKAGE__ . "::close(): Can't close logfile '$file': $!";
        }
        else
        {
            $text = __PACKAGE__ . "::DESTROY(): Can't close logfile '$file': $!";
            print STDERR "$text\n";
        }
    }
    return $text;
}

END { &end(); }

#######################
## Public functions: ##
#######################

sub end
{
    $SIG{'__WARN__'} = 'DEFAULT';
    $SIG{'__DIE__'}  = 'DEFAULT';
    while (@Inventory)
    {
        pop(@Inventory)->DESTROY();
    }
}

sub abort
{
    &end();
    print STDERR @_ if @_;
    print STDERR "<Program aborted>\n";
    exit 1;
}

sub Normalize
{
    my $dir = defined $_[0] ? $_[0] : '';
    my $drv = '';

    if    ($dir =~ s!^([a-zA-Z]:)!!) { $drv = $1;  }
    elsif ($dir !~ m!^[/\\]!)        { $drv = '.'; }
    $dir = "/$dir/";
    $dir =~ s!\\!/!g;
    $dir =~ s!//+!/!g;
    while ($dir =~ s!/(?:\./)+!/!g) {};
    while ($dir =~ s,/(?!\.\./)[^/]+/\.\./,/,g) {};
    $dir =~ s!^/(?:\.\./)+!/!g;
    $dir =~ s!^/!!;
    $dir =~ s!/$!!;

    return wantarray ? ($drv,$dir) : "$drv/$dir";
}

sub MakeDir
{
    my($drv,$dir) = Normalize($_[0]);
    my(@dir);
    local($!);

    return '' if (-d "$drv/$dir");
    @dir = split(/\//, $dir);
    $dir = $drv;
    while (@dir)
    {
        $dir .= '/' . shift(@dir);
        unless (-d $dir)
        {
            unless (mkdir($dir,0777))
            {
                return "Can't mkdir '$dir': $!";
            }
        }
    }
    return '';
}

#####################
## Public methods: ##
#####################

sub singleton
{
    shift;                        # discard class name
    return _which($Singleton,@_); # trigger creation if necessary
}

sub new
{
    my($class) = shift || __PACKAGE__;
    my($tool)  = shift || '';
    my($path)  = shift || '';
    my($file)  = shift || '';
    my($err,$name,$user,$handle,$self,$time,$text);
    local($_); # because of map()

    $class = ref($class) || $class;
    $name = Config::Manager::Conf->get(@FULLNAME) || '';
    if ($tool =~ /^\s*$/)
    {
        $tool = $0;
        $tool =~ s!^.*[/\\]!!;
        $tool =~ s!\.+[^\.]*$!!;
    }
    if ($path =~ /^\s*$/)
    {
        unless (defined ($path = Config::Manager::Conf->get(@LOGFILEPATH)))
        {
            $err = Config::Manager::Conf->error();
            $err =~ s!\s+$!!;
            return(__PACKAGE__ .
                "::new(): Can't find log directory in configuration data: $err");
        }
    }
    $file =~ s!^.*[/\\]!!;
    if ($file =~ /^\s*$/)
    {
        $user = $User || $name || 'unknown';
        $user =~ s!\s+!!g;
        $path .= "/$tool/$user";
        $file = join('-', $tool, $user, _ShortTime(), $$, ++$Count) . '.' . $LOGSUFFIX;
    }
    if ($err = MakeDir($path))
    {
        return(__PACKAGE__ .
            "::new(): Can't create log directory '$path': $err");
    }
    $file = Normalize("$path/$file");
    $handle = gensym();
    unless (open($handle, ">$file"))
    {
        return(__PACKAGE__ .
            "::new(): Can't open logfile '$file': $!");
    }
    select( ( select($handle), $| = 1 )[0] );
    $self = { };
    bless($self, $class);
#   ${$self}{'user'} = $User;
#   ${$self}{'name'} = $name;
#   ${$self}{'tool'} = $tool;
#   ${$self}{'path'} = $path;
    ${$self}{'file'} = $file;   # logfile name
    ${$self}{'hand'} = $handle; # logfile handle
    ${$self}{'hold'} = [ ];     # for putting lines on hold
    ${$self}{'stat'} = [ ];     # for statistics
    ${$self}{'flag'} = 0;       # for automatic dump of logfile name
    ${$self}{'level'} = $SHOW_ALL;
    # (for suppressing messages below the indicated level)
    $user = $User;
    if (($user !~ /^\s*$/) && ($name !~ /^\s*$/))
    {
        $user = "$name ($user)";
    }
    else
    {
        if ($user =~ /^\s*$/)
        {
            if ($name =~ /^\s*$/) { $user = "<Unknown User>"; }
            else                  { $user = $name; }
        }
    }
    $time = _LongTime();
    $text =
        $RULER .
        "\n $HEADER: $tool - $time - $user\n" .
        $RULER .
        "\n $CMDLINE: " .
        join(' ', map("'$_'", $^X, $0, @ARGV)) .
        "\n";
    $self->report($TO_LOG,$LEVEL_INFO,$text); # increments stat counters
    ${$self}{'stat'} = [ ];                   # reset stat counters to zero
    push( @Inventory, $self );
    return $self;
}

sub close
{
    my($self) = _which(shift);

    return __PACKAGE__ . "::close(): invalid logfile object!"
        unless (ref $self and keys %{$self});
    return $self->DESTROY(1);
}

sub report
{
    my($self)    = _which(shift);
    my($command) = shift || 0;
    my($level)   = shift || 0;
    my($text,$leadin,$indent,$item,$depth,$sub,$file,$handle);
    my(@stack,@trace);

    return unless (ref $self and keys %{$self});
    if ($command & $FROM_HOLD)
    {
        return if ($command == $FROM_HOLD + $TO_HLD);
        return unless (@{${$self}{'hold'}} > 0);
        $text = ${$self}{'hold'};
    }
    else
    {
        return if ($level < ${$self}{'level'});
        $leadin = '';
        $indent = '';
        if ($level & $USE_LEADIN)
        {
            $leadin = $LEADIN[0][$level >> 2] . ': ';
            $indent = ' ' x length($leadin);
        }
        $text = [ ];
        foreach $item (@_)
        {
            push( @{$text}, split(/\n/, $item, -1) );
        }
        foreach $item (@{$text})
        {
            $item = $leadin . $item;
            $item =~ s!\s+$!!;
            $item .= "\n";
            $leadin = $indent;
        }
        @trace = ();
        if ($level & $STACKTRACE)
        {
            $depth = $STARTDEPTH;
            while (@stack = caller($depth++))
            {
                $sub = _adjust(@stack);
                push
                (
                    @trace,
                    $indent . "in $sub\n",
                    $indent . "called at $stack[1] line $stack[2]\n"
                );
            }
            # Comment out next line if stack traces in logfile ONLY:
####        push( @{$text}, @trace );
        }
    }
    if ($command & $TO_LOG)
    {
        $file   = ${$self}{'file'};
        $handle = ${$self}{'hand'};
####    unless (print $handle join('', @{$text}))         # use this if push above is enabled
        unless (print $handle join('', @{$text}, @trace)) # use this if push above is disabled
        {
            unshift( @{$text}, __PACKAGE__ . "::report(): Can't print logfile '$file': $!\n" );
            $command |= $TO_HLD;
            $command |= $TO_ERR;
        }
    }
    if ($command & $TO_ERR)
    {
        unless (print STDERR join('', @{$text}))
        {
            $command |= $TO_OUT;
        }
    }
    if ($command & $TO_OUT)
    {
        unless (print STDOUT join('', @{$text}))
        {
            $command |= $TO_HLD;
        }
    }
    if ($command & $TO_HLD)
    {
        unless ($command & $FROM_HOLD)
        {
####        push( @{${$self}{'hold'}}, @{$text} );         # use this if push above is enabled
            push( @{${$self}{'hold'}}, @{$text}, @trace ); # use this if push above is disabled
        }
    }
    if ($command & $FROM_HOLD)
    {
        ${$self}{'hold'} = [ ] unless ($command & $TO_HLD);
    }
    else
    {
        ${${$self}{'stat'}}[$level >> 2]++;
    }
}

sub trace
{
    my($self) = _which(shift);
    my($first,$depth,$sub,$item);
    my(@stack,@trace,@args);

    return unless (ref $self and keys %{$self});
    # Do nothing if trace unwanted:
    return if ($LEVEL_TRACE < ${$self}{'level'});
    $first = 1;
    $depth = 1;
    @trace = (); # code "borrowed" from Carp.pm:
    while ( do {{ package DB; @stack = caller($depth++) }} )
    {
        $sub = _adjust(@stack);
        if ($first)
        {
            if ($stack[4]) # $hargs
            {
                @args = @DB::args;
                foreach $item (@args)
                {
                    if (defined $item)
                    {
                        $item = "$item";
                        $item =~ s!([\\\'])!\\$1!g;
                        $item = "'$item'"
                            unless ($item =~ /^-?(?:[1-9]\d*|0)(?:\.\d+)?$/);
#                       $item =~ s!([\x80-\xFF])!'M-'.chr(ord($1)&0x7F)!eg;
                        $item =~ s!([\x00-\x1F\x7F])!'^'.chr(ord($1)^0x40)!eg;
                    }
                    else { $item = "undef"; }
                }
                $sub .= '(' . join(',', @args) . ')';
            }
            else { $sub .= '()'; }
        }
        else { $sub = "in $sub"; }
        push
        (
            @trace,
            $sub,
            "called at $stack[1] line $stack[2]"
        );
        $first = 0;
    }
    $self->report(@TRACE,@trace);
}

sub level
{
    my($self) = _which(shift);
    my($level);

    return undef unless (ref $self and keys %{$self});
    $level = ${$self}{'level'};
    if (@_ > 0)
    {
        ${$self}{'level'} = $_[0] + 0;
    }
    return $level;
}

sub logfile
{
    my($self) = _which(shift);

    return undef unless (ref $self and keys %{$self});
    return ${$self}{'file'};
}

sub notify # set flag for notifying user at exit about where logfile lies
{
    my($self) = _which(shift);
    my($flag);

    return undef unless (ref $self and keys %{$self});
    $flag = ${$self}{'flag'};
    if (@_ > 0)
    {
        ${$self}{'flag'} = ($_[0] ? 1 : 0);
    }
    return $flag;
}

sub ret_hold
{
    my($self) = _which(shift);

    if (defined wantarray && wantarray)
    {
        return () unless (ref $self and keys %{$self});
        return (@{${$self}{'hold'}});
    }
    else
    {
        return undef unless (ref $self and keys %{$self});
        return scalar(@{${$self}{'hold'}});
    }
}

sub clr_hold
{
    my($self) = _which(shift);

    return unless (ref $self and keys %{$self});
    ${$self}{'hold'} = [ ];
}

1;

__END__