Log-Report-1.40/0000755000175000001440000000000015000465237014150 5ustar00markovusers00000000000000Log-Report-1.40/lib/0000755000175000001440000000000015000465237014716 5ustar00markovusers00000000000000Log-Report-1.40/lib/Log/0000755000175000001440000000000015000465237015437 5ustar00markovusers00000000000000Log-Report-1.40/lib/Log/Report/0000755000175000001440000000000015000465237016712 5ustar00markovusers00000000000000Log-Report-1.40/lib/Log/Report/Die.pm0000644000175000001440000000747215000465232017756 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Die;{ our $VERSION = '1.40'; } use base 'Exporter'; use warnings; use strict; our @EXPORT = qw/die_decode exception_decode/; use POSIX qw/locale_h/; sub die_decode($%) { my ($text, %args) = @_; my @text = split /\n/, $text; @text or return (); chomp $text[-1]; # Try to catch the error directly, to remove it from the error text my %opt = (errno => $! + 0); my $err = "$!"; if($text[0] =~ s/ at (.+) line (\d+)\.?$// ) { $opt{location} = [undef, $1, $2, undef]; } elsif(@text > 1 && $text[1] =~ m/^\s*at (.+) line (\d+)\.?$/ ) { # sometimes people carp/confess with \n, folding the line $opt{location} = [undef, $1, $2, undef]; splice @text, 1, 1; } $text[0] =~ s/\s*[.:;]?\s*$err\s*$// # the $err is translation sensitive or delete $opt{errno}; my @msg = shift @text; length $msg[0] or $msg[0] = 'stopped'; my @stack; foreach (@text) { if(m/^\s*(.*?)\s+called at (.*?) line (\d+)\s*$/) { push @stack, [ $1, $2, $3 ] } else { push @msg, $_ } } $opt{stack} = \@stack; $opt{classes} = [ 'perl', (@stack ? 'confess' : 'die') ]; my $reason = $opt{errno} ? 'FAULT' : @stack ? 'PANIC' : $args{on_die} || 'ERROR'; (\%opt, $reason, join("\n", @msg)); } sub _exception_dbix($$) { my ($exception, $args) = @_; my $on_die = delete $args->{on_die}; my %opts = %$args; my @lines = split /\n/, "$exception"; # accessor missing to get msg my $first = shift @lines; my ($sub, $message, $fn, $linenr) = $first =~ m/^ (?: ([\w:]+?) \(\)\: [ ] | \{UNKNOWN\}\: [ ] )? (.*?) \s+ at [ ] (.+) [ ] line [ ] ([0-9]+)\.? $/x; my $pkg = defined $sub && $sub =~ s/^([\w:]+)\:\:// ? $1 : $0; $opts{location} ||= [ $pkg, $fn, $linenr, $sub ]; my @stack; foreach (@lines) { my ($func, $fn, $linenr) = /^\s+(.*?)\(\)\s+called at (.*?) line ([0-9]+)$/ or next; push @stack, [ $func, $fn, $linenr ]; } $opts{stack} ||= \@stack if @stack; my $reason = $opts{errno} ? 'FAULT' : @stack ? 'PANIC' : $on_die || 'ERROR'; (\%opts, $reason, $message); } my %_libxml_errno2reason = (1 => 'WARNING', 2 => 'MISTAKE', 3 => 'ERROR'); sub _exception_libxml($$) { my ($exc, $args) = @_; my $on_die = delete $args->{on_die}; my %opts = %$args; $opts{errno} ||= $exc->code + 13000; $opts{location} ||= [ 'libxml', $exc->file, $exc->line, $exc->domain ]; my $msg = $exc->message . $exc->context . "\n" . (' ' x $exc->column) . '^' . ' (' . $exc->domain . ' error ' . $exc->code . ')'; my $reason = $_libxml_errno2reason{$exc->level} || 'PANIC'; (\%opts, $reason, $msg); } sub exception_decode($%) { my ($exception, %args) = @_; my $errno = $! + 0; return _exception_dbix($exception, \%args) if $exception->isa('DBIx::Class::Exception'); return _exception_libxml($exception, \%args) if $exception->isa('XML::LibXML::Error'); # Unsupported exception system, sane guesses my %opt = ( classes => [ 'unknown exception', 'die', ref $exception ] , errno => $errno ); my $reason = $errno ? 'FAULT' : ($args{on_die} || 'ERROR'); # hopefully stringification is overloaded (\%opt, $reason, "$exception"); } "to die or not to die, that's the question"; Log-Report-1.40/lib/Log/Report/Dispatcher/0000755000175000001440000000000015000465237021000 5ustar00markovusers00000000000000Log-Report-1.40/lib/Log/Report/Dispatcher/LogDispatch.pod0000644000175000001440000001346115000465233023706 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::LogDispatch - send messages to Log::Dispatch back-end =head1 INHERITANCE Log::Report::Dispatcher::LogDispatch is a Log::Report::Dispatcher =head1 SYNOPSIS use Log::Dispatch::File; dispatcher Log::Dispatch::File => 'logger', accept => 'NOTICE-' , filename => 'logfile', to_level => [ 'ALERT-' => 'err' ]; # disable default dispatcher dispatcher close => 'logger'; =head1 DESCRIPTION This dispatchers produces output to and C back-end. (which will NOT be automatically installed for you). The REASON for a message often uses names which are quite similar to the log-levels used by Log::Dispatch. However: they have a different approach. The REASON of Log::Report limits the responsibility of the programmer to indicate the cause of the message: whether it was able to handle a certain situation. The Log::Dispatch levels are there for the user's of the program. However: the programmer does not known anything about the application (in the general case). This is cause of much of the trickery in Perl programs. The default translation table is list below. You can change the mapping using L. See example in SYNOPSIS. Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Log::Report::Dispatcher::LogDispatch-EB($type, $name, %options) The Log::Dispatch infrastructure has quite a large number of output TYPEs, each extending the Log::Dispatch::Output base-class. You do not create these objects yourself: Log::Report is doing it for you. The Log::Dispatch back-ends are very careful with validating their parameters, so you will need to restrict the options to what is supported for the specific back-end. See their respective manual-pages. The errors produced by the back-ends quite horrible and untranslated, sorry. -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode callbacks [] charset Log::Report::Dispatcher format_reason Log::Report::Dispatcher 'LOWERCASE' locale Log::Report::Dispatcher max_level undef min_level debug mode Log::Report::Dispatcher 'NORMAL' to_level [] =over 2 =item accept => REASONS =item callbacks => CODE|ARRAY-of-CODE See Log::Dispatch::Output. =item charset => CHARSET =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item locale => LOCALE =item max_level => LEVEL Like C. =item min_level => LEVEL Restrict the messages which are passed through based on the LEVEL, so after the reason got translated into a Log::Dispatch compatible LEVEL. The default will use Log::Report restrictions only. =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item to_level => ARRAY-of-PAIRS See L. =back =back =head2 Accessors Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">. =over 4 =item $obj-EB() Returns the Log::Dispatch::Output object which is used for logging. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$reason] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Logging Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">. =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher::LogDispatch-EB(@CODE) Inherited, see L =item $obj-EB() =item Log::Report::Dispatcher::LogDispatch-EB() Inherited, see L =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher::LogDispatch-EB( [$maxdepth] ) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message, $domain) Inherited, see L =item $obj-EB($reason) Returns a level which is understood by Log::Dispatch, based on a translation table. This can be changed with L. =item $obj-EB() Inherited, see L =item $obj-EB(%options) =item Log::Report::Dispatcher::LogDispatch-EB(%options) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message) Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report/Dispatcher/Callback.pod0000644000175000001440000001135615000465233023202 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Callback - call a code-ref for each log-line =head1 INHERITANCE Log::Report::Dispatcher::Callback is a Log::Report::Dispatcher =head1 SYNOPSIS sub cb($$$) { my ($disp, $options, $reason, $message) = @_; ... } dispatcher Log::Report::Dispatcher::Callback => 'cb' , callback => \&cb; dispatcher CALLBACK => 'cb' # same , callback => \&cb; =head1 DESCRIPTION This basic file logger accepts a callback, which is called for each message which is to be logged. When you need complex things, you may best make your own extension to L, but for simple things this will do. Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. B<. Example> sub send_mail($$$) { my ($disp, $options, $reason, $message) = @_; my $msg = Mail::Send->new(Subject => $reason , To => 'admin@localhost'); my $fh = $msg->open('sendmail'); print $fh $disp->translate($reason, $message); close $fh; } dispatcher CALLBACK => 'mail', callback => \&send_mail; =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Log::Report::Dispatcher::Callback-EB($type, $name, %options) -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode callback charset Log::Report::Dispatcher format_reason Log::Report::Dispatcher 'LOWERCASE' locale Log::Report::Dispatcher mode Log::Report::Dispatcher 'NORMAL' =over 2 =item accept => REASONS =item callback => CODE Your C is called with five parameters: this dispatcher object, the options, a reason and a message. The C are the first parameter of L (read over there). The C is a capitized string like C. Then, the C (is a L). Finally the text-domain of the message. =item charset => CHARSET =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item locale => LOCALE =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =back =back =head2 Accessors Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">. =over 4 =item $obj-EB() Returns the code reference which will handle each logged message. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$reason] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Logging Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">. =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher::Callback-EB(@CODE) Inherited, see L =item $obj-EB() =item Log::Report::Dispatcher::Callback-EB() Inherited, see L =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher::Callback-EB( [$maxdepth] ) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message, $domain) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB(%options) =item Log::Report::Dispatcher::Callback-EB(%options) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message) Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report/Dispatcher/Syslog.pod0000644000175000001440000001543515000465233022770 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Syslog - send messages to syslog =head1 INHERITANCE Log::Report::Dispatcher::Syslog is a Log::Report::Dispatcher =head1 SYNOPSIS # add syslog dispatcher dispatcher SYSLOG => 'syslog', accept => 'NOTICE-' , format_reason => 'IGNORE' , to_prio => [ 'ALERT-' => 'err' ]; # disable default dispatcher, when daemon dispatcher close => 'default'; =head1 DESCRIPTION This dispatchers produces output to syslog, based on the Sys::Syslog module (which will NOT be automatically installed for you, because some systems have a problem with this dependency). The REASON for a message often uses names which are quite similar to the log-levels used by syslog. However: they have a different purpose. The REASON is used by the programmer to indicate the cause of the message: whether it was able to handle a certain situation. The syslog levels are there for the user's of the program (with syslog usually the system administrators). It is not unusual to see a "normal" error or mistake as a very serious situation in a production environment. So, you may wish to translate any message above reason MISTAKE into a LOG_CRIT. The default translation table is list below. You can change the mapping using L. See example in SYNOPSIS. TRACE => LOG_DEBUG ERROR => LOG_ERR ASSERT => LOG_DEBUG FAULT => LOG_ERR INFO => LOG_INFO ALERT => LOG_ALERT NOTICE => LOG_NOTICE FAILURE => LOG_EMERG WARNING => LOG_WARNING PANIC => LOG_CRIT MISTAKE => LOG_WARNING Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Log::Report::Dispatcher::Syslog-EB($type, $name, %options) With syslog, people tend not to include the REASON of the message in the logs, because that is already used to determine the destination of the message. -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode charset 'utf8' facility 'user' flags 'pid,nowait' format format_reason Log::Report::Dispatcher 'IGNORE' identity include_domain locale Log::Report::Dispatcher logsocket undef mode Log::Report::Dispatcher 'NORMAL' to_prio [] =over 2 =item accept => REASONS =item charset => CHARSET Translate the text-strings into the specified charset, otherwise the sysadmin may get unreadable text. =item facility => STRING The possible values for this depend (a little) on the system. POSIX only defines C, and C up to C. =item flags => STRING Any combination of flags as defined by Sys::Syslog, for instance C, C, and C. =item format => CODE [1.10] With a CODE reference you get your hands on the text before it gets sent to syslog. The three parameters are: the (translated) text, the related text domain object, and the message object. You may want to use context information from the latter. [1.19] After the three positional parameters, there may be a list of pairs (named parameters) with additional info. This may contain a C with an ARRAY of information produced by caller() about the origin of the exception. =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item identity => STRING =item include_domain => BOOLEAN [1.00] Include the text-domain of the message in each logged message. =item locale => LOCALE =item logsocket => 'unix'|'inet'|'stream'|HASH If specified, the log socket type will be initialized to this before C is called. If not specified, the system default is used. =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item to_prio => ARRAY-of-PAIRS See L. =back =back =head2 Accessors Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">. =over 4 =item $obj-EB( [CODE] ) Returns the CODE ref which formats the syslog line. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$reason] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Logging Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">. =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher::Syslog-EB(@CODE) Inherited, see L =item $obj-EB() =item Log::Report::Dispatcher::Syslog-EB() Inherited, see L =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher::Syslog-EB( [$maxdepth] ) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message, $domain) Inherited, see L =item $obj-EB($reason) Returns a level which is understood by syslog(3), based on a translation table. This can be changed with L. =item $obj-EB() Inherited, see L =item $obj-EB(%options) =item Log::Report::Dispatcher::Syslog-EB(%options) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message) Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report/Dispatcher/Log4perl.pm0000644000175000001440000000530215000465232023021 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Dispatcher::Log4perl;{ our $VERSION = '1.40'; } use base 'Log::Report::Dispatcher'; use warnings; use strict; use Log::Report 'log-report'; use Log::Report::Util qw/@reasons expand_reasons/; use Log::Log4perl qw/:levels/; my %default_reasonToLevel = ( TRACE => $DEBUG , ASSERT => $DEBUG , INFO => $INFO , NOTICE => $INFO , WARNING => $WARN , MISTAKE => $WARN , ERROR => $ERROR , FAULT => $ERROR , ALERT => $FATAL , FAILURE => $FATAL , PANIC => $FATAL ); @reasons==keys %default_reasonToLevel or panic __"Not all reasons have a default translation"; # Do not show these as source of the error: one or more caller frames up Log::Log4perl->wrapper_register($_) for qw/ Log::Report Log::Report::Dispatcher Log::Report::Dispatcher::Try /; sub init($) { my ($self, $args) = @_; $args->{accept} ||= 'ALL'; $self->SUPER::init($args); my $name = $self->name; $self->{LRDL_levels} = { %default_reasonToLevel }; if(my $to_level = delete $args->{to_level}) { my @to = @$to_level; while(@to) { my ($reasons, $level) = splice @to, 0, 2; my @reasons = expand_reasons $reasons; $level =~ m/^[0-5]$/ or error __x"Log4perl level '{level}' must be in 0-5", level => $level; $self->{LRDL_levels}{$_} = $level for @reasons; } } if(my $config = delete $args->{config}) { Log::Log4perl->init($config) or return; } $self; } #sub close() #{ my $self = shift; # $self->SUPER::close or return; # $self; #} sub logger(;$) { my ($self, $domain) = @_; defined $domain or return Log::Log4perl->get_logger($self->name); # get_logger() creates a logger if that does not exist. But we # want to route it to default $Log::Log4perl::LOGGERS_BY_NAME->{$domain} ||= Log::Log4perl->get_logger($self->name); } sub log($$$$) { my ($self, $opts, $reason, $msg, $domain) = @_; my $text = $self->translate($opts, $reason, $msg) or return; my $level = $self->reasonToLevel($reason); local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 3; $text =~ s/\s+$//s; # log4perl adds own \n $self->logger($domain)->log($level, $text); $self; } sub reasonToLevel($) { $_[0]->{LRDL_levels}{$_[1]} } 1; Log-Report-1.40/lib/Log/Report/Dispatcher/Syslog.pm0000644000175000001440000000642015000465232022613 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Dispatcher::Syslog;{ our $VERSION = '1.40'; } use base 'Log::Report::Dispatcher'; use warnings; use strict; use Log::Report 'log-report'; use Sys::Syslog qw/:standard :extended :macros/; use Log::Report::Util qw/@reasons expand_reasons/; use Encode qw/encode/; use File::Basename qw/basename/; my %default_reasonToPrio = ( TRACE => LOG_DEBUG , ASSERT => LOG_DEBUG , INFO => LOG_INFO , NOTICE => LOG_NOTICE , WARNING => LOG_WARNING , MISTAKE => LOG_WARNING , ERROR => LOG_ERR , FAULT => LOG_ERR , ALERT => LOG_ALERT , FAILURE => LOG_EMERG , PANIC => LOG_CRIT ); @reasons==keys %default_reasonToPrio or panic __"not all reasons have a default translation"; my $active; sub init($) { my ($self, $args) = @_; $args->{format_reason} ||= 'IGNORE'; $self->SUPER::init($args); error __x"max one active syslog dispatcher, attempt for {new} have {old}" , new => $self->name, old => $active if $active; $active = $self->name; setlogsock(delete $args->{logsocket}) if $args->{logsocket}; my $ident = delete $args->{identity} || basename $0; my $flags = delete $args->{flags} || 'pid,nowait'; my $fac = delete $args->{facility} || 'user'; openlog $ident, $flags, $fac; # doesn't produce error. $self->{LRDS_incl_dom} = delete $args->{include_domain}; $self->{LRDS_charset} = delete $args->{charset} || "utf-8"; $self->{LRDS_format} = $args->{format} || sub {$_[0]}; $self->{prio} = +{ %default_reasonToPrio }; if(my $to_prio = delete $args->{to_prio}) { my @to = @$to_prio; while(@to) { my ($reasons, $level) = splice @to, 0, 2; my @reasons = expand_reasons $reasons; my $prio = Sys::Syslog::xlate($level); error __x"syslog level '{level}' not understood", level => $level if $prio eq -1; $self->{prio}{$_} = $prio for @reasons; } } $self; } sub close() { my $self = shift; undef $active; closelog; $self->SUPER::close; } #-------------- sub format(;$) { my $self = shift; @_ ? $self->{LRDS_format} = shift : $self->{LRDS_format}; } #-------------- sub log($$$$$) { my ($self, $opts, $reason, $msg, $domain) = @_; my $text = $self->translate($opts, $reason, $msg) or return; my $format = $self->format; # handle each line in message separately $text =~ s/\s+$//s; my @text = split /\n/, $format->($text, $domain, $msg, %$opts); my $prio = $self->reasonToPrio($reason); my $charset = $self->{LRDS_charset}; if($self->{LRDS_incl_dom} && $domain) { $domain =~ s/\%//g; # security syslog $prio, "$domain %s", encode($charset, shift @text); } syslog $prio, "%s", encode($charset, $_) for @text; } sub reasonToPrio($) { $_[0]->{prio}{$_[1]} } 1; Log-Report-1.40/lib/Log/Report/Dispatcher/File.pm0000644000175000001440000001035315000465232022212 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Dispatcher::File;{ our $VERSION = '1.40'; } use base 'Log::Report::Dispatcher'; use warnings; use strict; use Log::Report 'log-report'; use IO::File (); use POSIX qw/strftime/; use Encode qw/find_encoding/; use Fcntl qw/:flock/; sub init($) { my ($self, $args) = @_; if(!$args->{charset}) { my $lc = $ENV{LC_CTYPE} || $ENV{LC_ALL} || $ENV{LANG} || ''; my $cs = $lc =~ m/\.([\w-]+)/ ? $1 : ''; $args->{charset} = length $cs && find_encoding $cs ? $cs : undef; } $self->SUPER::init($args); my $name = $self->name; $self->{to} = $args->{to} or error __x"dispatcher {name} needs parameter 'to'", name => $name; $self->{replace} = $args->{replace} || 0; my $format = $args->{format} || sub { '['.localtime()."] $_[0]" }; $self->{LRDF_format} = ref $format eq 'CODE' ? $format : $format eq 'LONG' ? sub { my $msg = shift; my $domain = shift || '-'; my $stamp = strftime "%Y-%m-%dT%H:%M:%S", gmtime; "[$stamp $$] $domain $msg" } : error __x"unknown format parameter `{what}'" , what => ref $format || $format; $self; } sub close() { my $self = shift; $self->SUPER::close or return; my $to = $self->{to}; my @close = ref $to eq 'CODE' ? values %{$self->{LRDF_out}} : $self->{LRDF_filename} ? $self->{LRDF_output} : (); $_ && $_->close for @close; $self; } #----------- sub filename() {shift->{LRDF_filename}} sub format() {shift->{LRDF_format}} sub output($) { # fast simple case return $_[0]->{LRDF_output} if $_[0]->{LRDF_output}; my ($self, $msg) = @_; my $name = $self->name; my $to = $self->{to}; if(!ref $to) { # constant file name $self->{LRDF_filename} = $to; my $binmode = $self->{replace} ? '>' : '>>'; my $f = $self->{LRDF_output} = IO::File->new($to, $binmode); unless($f) { # avoid logging error to myself (issue #4) my $msg = __x"cannot write log into {file} with mode '{binmode}'" , binmode => $binmode, file => $to; if(my @disp = grep $_->name ne $name, Log::Report::dispatcher('list')) { $msg->to($disp[0]->name); error $msg; } else { die $msg; } } $f->autoflush; return $self->{LRDF_output} = $f; } if(ref $to eq 'CODE') { # variable filename my $fn = $self->{LRDF_filename} = $to->($self, $msg); return $self->{LRDF_output} = $self->{LRDF_out}{$fn}; } # probably file-handle $self->{LRDF_output} = $to; } #----------- sub rotate($) { my ($self, $old) = @_; my $to = $self->{to}; my $logs = ref $to eq 'CODE' ? $self->{LRDF_out} : +{ $self->{to} => $self->{LRDF_output} }; while(my ($log, $fh) = each %$logs) { !ref $log or error __x"cannot rotate log file which was opened as file-handle"; my $oldfn = ref $old eq 'CODE' ? $old->($log) : $old; trace "rotating $log to $oldfn"; rename $log, $oldfn or fault __x"unable to rotate logfile {fn} to {oldfn}" , fn => $log, oldfn => $oldfn; $fh->close; # close after move not possible on Windows? my $f = $self->{LRDF_output} = $logs->{$log} = IO::File->new($log, '>>') or fault __x"cannot write log into {file}", file => $log; $f->autoflush; } $self; } #----------- sub log($$$$) { my ($self, $opts, $reason, $msg, $domain) = @_; my $trans = $self->translate($opts, $reason, $msg); my $text = $self->format->($trans, $domain, $msg, %$opts); my $out = $self->output($msg); flock $out, LOCK_EX; $out->print($text); flock $out, LOCK_UN; } 1; Log-Report-1.40/lib/Log/Report/Dispatcher/File.pod0000644000175000001440000001631715000465233022367 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::File - send messages to a file or file-handle =head1 INHERITANCE Log::Report::Dispatcher::File is a Log::Report::Dispatcher =head1 SYNOPSIS dispatcher Log::Report::Dispatcher::File => 'stderr' , to => \*STDERR, accept => 'NOTICE-'; # close a dispatcher dispatcher close => 'stderr'; # let dispatcher open and close the file dispatcher FILE => 'mylog', to => '/var/log/mylog' , charset => 'utf-8'; ... dispatcher close => 'mylog'; # will close file # open yourself, then also close yourself open OUT, ">:encoding('iso-8859-1')", '/var/log/mylog' or fault "..."; dispatcher FILE => 'mylog', to => \*OUT; ... dispatcher close => 'mylog'; close OUT; # dispatch into a scalar my $output = ''; open $outfile, '>', \$output; dispatcher FILE => 'into-scalar', to => \$outfile; ... dispatcher close => 'into-scalar'; print $output; =head1 DESCRIPTION This basic file logger accepts an file-handle or filename as destination. [1.00] writing to the file protected by a lock, so multiple processes can write to the same file. Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">. =over 4 =item $obj-EB() Only when initiated with a FILENAME, the file will be closed. In any other case, nothing will be done. =item Log::Report::Dispatcher::File-EB($type, $name, %options) -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode charset Log::Report::Dispatcher LOCALE format format_reason Log::Report::Dispatcher 'LOWERCASE' locale Log::Report::Dispatcher mode Log::Report::Dispatcher 'NORMAL' replace false to =over 2 =item accept => REASONS =item charset => CHARSET =item format => CODE|'LONG' [1.00] process each printed line. By default, this adds a timestamp, but you may want to add hostname, process number, or more. format => sub { '['.localtime().'] '.$_[0] } format => sub { shift } # no timestamp format => 'LONG' The first parameter to format is the string to print; it is already translated and trailed by a newline. The second parameter is the text-domain (if known). [1.10] As third parameter, you get the $msg raw object as well (maybe you want to use the message context?) [1.19] After the three positional parameters, there may be a list of pairs providing additional facts about the exception. It may contain C information. The "LONG" format is equivalent to: my $t = strftime "%FT%T", gmtime; "[$t $$] $_[1] $_[0]" Use of context: format => sub { my ($msgstr, $domain, $msg, %more) = @_; my $host = $msg->context->{host}; "$host $msgstr"; } =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item locale => LOCALE =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item replace => BOOLEAN Only used in combination with a FILENAME: throw away the old file if it exists. Probably you wish to append to existing information. Use the LOCALE setting by default, which is LC_CTYPE or LC_ALL or LANG (in that order). If these contain a character-set which Perl understands, then that is used, otherwise silently ignored. =item to => FILENAME|FILEHANDLE|OBJECT|CODE You can either specify a FILENAME, which is opened in append mode with autoflush on. Or pass any kind of FILE-HANDLE or some OBJECT which implements a C method. You probably want to have autoflush enabled on your FILE-HANDLES. When cleaning-up the dispatcher, the file will only be closed in case of a FILENAME. [1.10] When you pass a CODE, then for each log message the function is called with two arguments: this dispatcher object and the message object. In some way (maybe via the message context) you have to determine the log filename. This means that probably many log-files are open at the same time. # configuration time dispatcher FILE => 'logfile', to => sub { my ($disp, $msg) = @_; $msg->context->{logfile} }; # whenever you want to change the logfile textdomain->updateContext(logfile => '/var/log/app'); (textdomain 'mydomain')->setContext(logfile => '/var/log/app'); # or error __x"help", _context => {logfile => '/dev/tty'}; error __x"help", _context => "logfile=/dev/tty"; =back =back =head2 Accessors Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">. =over 4 =item $obj-EB() Returns the name of the opened file, or C in case this dispatcher was started from a file-handle or file-object. =item $obj-EB() =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$reason] ) Inherited, see L =item $obj-EB($msg) Returns the file-handle to write the log lines to. [1.10] This may depend on the $msg (especially message context) =item $obj-EB() Inherited, see L =back =head2 File maintenance =over 4 =item $obj-EB($filename|CODE) [1.00] Move the current file to $filename, and start a new file. =back =head2 Logging Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">. =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher::File-EB(@CODE) Inherited, see L =item $obj-EB() =item Log::Report::Dispatcher::File-EB() Inherited, see L =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher::File-EB( [$maxdepth] ) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message, $domain) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB(%options) =item Log::Report::Dispatcher::File-EB(%options) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message) Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report/Dispatcher/Callback.pm0000644000175000001440000000160215000465232023024 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Dispatcher::Callback;{ our $VERSION = '1.40'; } use base 'Log::Report::Dispatcher'; use warnings; use strict; use Log::Report 'log-report'; sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $self->{callback} = $args->{callback} or error __x"dispatcher {name} needs a 'callback'", name => $self->name; $self; } sub callback() {shift->{callback}} sub log($$$$) { my $self = shift; $self->{callback}->($self, @_); } 1; Log-Report-1.40/lib/Log/Report/Dispatcher/LogDispatch.pm0000644000175000001440000000416715000465232023542 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Dispatcher::LogDispatch;{ our $VERSION = '1.40'; } use base 'Log::Report::Dispatcher'; use warnings; use strict; use Log::Report 'log-report', syntax => 'SHORT'; use Log::Report::Util qw/@reasons expand_reasons/; use Log::Dispatch 2.00; my %default_reasonToLevel = ( TRACE => 'debug' , ASSERT => 'debug' , INFO => 'info' , NOTICE => 'notice' , WARNING => 'warning' , MISTAKE => 'warning' , ERROR => 'error' , FAULT => 'error' , ALERT => 'alert' , FAILURE => 'emergency' , PANIC => 'critical' ); @reasons != keys %default_reasonToLevel and panic __"Not all reasons have a default translation"; sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $args->{name} = $self->name; $args->{min_level} ||= 'debug'; $self->{level} = { %default_reasonToLevel }; if(my $to_level = delete $args->{to_level}) { my @to = @$to_level; while(@to) { my ($reasons, $level) = splice @to, 0, 2; my @reasons = expand_reasons $reasons; Log::Dispatch->level_is_valid($level) or error __x"Log::Dispatch level '{level}' not understood" , level => $level; $self->{level}{$_} = $level for @reasons; } } $self->{backend} = $self->type->new(%$args); $self; } sub close() { my $self = shift; $self->SUPER::close or return; delete $self->{backend}; $self; } sub backend() {shift->{backend}} sub log($$$$$) { my $self = shift; my $text = $self->translate(@_) or return; my $level = $self->reasonToLevel($_[1]); $self->backend->log(level => $level, message => $text); $self; } sub reasonToLevel($) { $_[0]->{level}{$_[1]} } 1; Log-Report-1.40/lib/Log/Report/Dispatcher/Perl.pod0000644000175000001440000000271215000465233022404 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Perl - send messages to die and warn =head1 INHERITANCE Log::Report::Dispatcher::Perl is a Log::Report::Dispatcher =head1 SYNOPSIS dispatcher Log::Report::Dispatcher::Perl => 'default' , accept => 'NOTICE-'; # close the default dispatcher dispatcher close => 'default'; =head1 DESCRIPTION Ventilate the problem reports via the standard Perl error mechanisms: C, C, and C. There can be only one such dispatcher (per thread), because once C is called, we are not able to return. Therefore, this dispatcher will always be called last. In the early releases of Log::Report, it tried to simulate the behavior of warn and die using STDERR and exit; however: that is not possible. Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report/Dispatcher/Try.pm0000644000175000001440000000545215000465232022115 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Dispatcher::Try;{ our $VERSION = '1.40'; } use base 'Log::Report::Dispatcher'; use warnings; use strict; use Log::Report 'log-report', syntax => 'SHORT'; use Log::Report::Exception (); use Log::Report::Util qw/%reason_code expand_reasons/; use List::Util qw/first/; use overload bool => 'failed' , '""' => 'showStatus' , fallback => 1; #----------------- sub init($) { my ($self, $args) = @_; defined $self->SUPER::init($args) or return; $self->{exceptions} = delete $args->{exceptions} || []; $self->{died} = delete $args->{died}; $self->hide($args->{hide} // 'NONE'); $self->{on_die} = $args->{on_die} // 'ERROR'; $self; } #----------------- sub died(;$) { my $self = shift; @_ ? ($self->{died} = shift) : $self->{died}; } sub exceptions() { @{shift->{exceptions}} } sub hides($) { $_[0]->{LRDT_hides}{$_[1]} } sub hide(@) { my $self = shift; my @reasons = expand_reasons(@_ > 1 ? \@_ : shift); $self->{LRDT_hides} = +{ map +($_ => 1), @reasons }; } sub die2reason() { shift->{on_die} } #----------------- sub log($$$$) { my ($self, $opts, $reason, $message, $domain) = @_; unless($opts->{stack}) { my $mode = $self->mode; $opts->{stack} = $self->collectStack if $reason eq 'PANIC' || ($mode==2 && $reason_code{$reason} >= $reason_code{ALERT}) || ($mode==3 && $reason_code{$reason} >= $reason_code{ERROR}); } $opts->{location} ||= ''; my $e = Log::Report::Exception->new ( reason => $reason , report_opts => $opts , message => $message ); push @{$self->{exceptions}}, $e; $self; } sub reportFatal(@) { $_->throw(@_) for shift->wasFatal } sub reportAll(@) { $_->throw(@_) for shift->exceptions } #----------------- sub failed() { defined shift->{died} } sub success() { ! defined shift->{died} } sub wasFatal(@) { my ($self, %args) = @_; defined $self->{died} or return (); my $ex = first { $_->isFatal } @{$self->{exceptions}} or return (); # There can only be one fatal exception. Is it in the class? (!$args{class} || $ex->inClass($args{class})) ? $ex : (); } sub showStatus() { my $self = shift; my $fatal = $self->wasFatal or return ''; __x"try-block stopped with {reason}: {text}" , reason => $fatal->reason , text => $self->died; } 1; Log-Report-1.40/lib/Log/Report/Dispatcher/Perl.pm0000644000175000001440000000140415000465232022232 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Dispatcher::Perl;{ our $VERSION = '1.40'; } use base 'Log::Report::Dispatcher'; use warnings; use strict; use Log::Report 'log-report'; use IO::File; my $singleton = 0; # can be only one (per thread) sub log($$$$) { my ($self, $opts, $reason, $message, $domain) = @_; print STDERR $self->translate($opts, $reason, $message); } 1; Log-Report-1.40/lib/Log/Report/Dispatcher/Try.pod0000644000175000001440000002344715000465233022270 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Try - capture all reports as exceptions =head1 INHERITANCE Log::Report::Dispatcher::Try is a Log::Report::Dispatcher =head1 SYNOPSIS try { ... }; # mind the ';' !! if($@) { # signals something went wrong if(try {...}) { # block ended normally my $x = try { read_temperature() }; my @x = try { read_lines_from_file() }; try { ... } # no comma!! mode => 'DEBUG', accept => 'ERROR-'; try sub { ... }, # with comma mode => 'DEBUG', accept => 'ALL'; try \&myhandler, accept => 'ERROR-'; try { ... } hide => 'TRACE'; print ref $@; # Log::Report::Dispatcher::Try $@->reportFatal; # re-dispatch result of try block $@->reportAll; # ... also warnings etc if($@) {...} # if errors if($@->failed) { # same # } if($@->success) { # no errors # } try { # something causes an error report, which is caught failure 'no network'; }; $@->reportFatal(to => 'syslog'); # overrule destination print $@->exceptions; # no re-cast, just print =head1 DESCRIPTION The B works like Perl's build-in C, but implements real exception handling which Perl core lacks. The L function creates this C<::Try> dispatcher object with name 'try'. After the C is over, you can find the object in C<$@>. The C<$@> as C<::Try> object behaves exactly as the C<$@> produced by C, but has many added features. The C function catches fatal errors happening inside the BLOCK (CODE reference which is just following the function name) into the C<::Try> object C<$@>. The errors are not automatically progressed to active dispatchers. However, non-fatal exceptions (like info or notice) are also collected (unless not accepted, see L, but also immediately passed to the active dispatchers (unless the reason is hidden, see L) After the C has run, you can introspect the collected exceptions. Typically, you use L to get the exception which terminated the run of the BLOCK. Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Log::Report::Dispatcher::Try-EB($type, $name, %options) -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode charset Log::Report::Dispatcher died undef exceptions [] format_reason Log::Report::Dispatcher 'LOWERCASE' hide 'NONE' locale Log::Report::Dispatcher mode Log::Report::Dispatcher 'NORMAL' on_die 'ERROR' =over 2 =item accept => REASONS =item charset => CHARSET =item died => STRING The exit string or object ($@) of the eval'ed block, in its unprocessed state. =item exceptions => ARRAY ARRAY of L objects. =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item hide => REASONS|ARRAY|'ALL'|'NONE' [1.09] see L =item locale => LOCALE =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item on_die => 'ERROR'|'PANIC' When code which runs in this block exits with a die(), it will get translated into a L using L. How serious are we about these errors? =back =back =head2 Accessors Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">. =over 4 =item $obj-EB() Returns the value of L. =item $obj-EB( [STRING] ) The exit string or object ($@) of the eval'ed block, in its unprocessed state. They will always return true when they where deadly, and it always stringifies into something useful. =item $obj-EB() Returns all collected C. The last of them may be a fatal one. The other are non-fatal. =item $obj-EB(@reasons) [1.09] By default, the try will only catch messages which stop the execution of the block (errors etc, internally a 'die'). Other messages are passed to the parent dispatchers. This option gives the opportunity to stop, for instance, trace messages. Those messages are still collected inside the try object (unless excluded by L), so may get passed-on later via L if you like. Be warned: Using this method will reset the whole 'hide' configuration: it's a I not an I. example: change the setting of the running block my $parent_try = dispatcher 'active-try'; $parent_try->hide('ALL'); =item $obj-EB($reason) Check whether the try stops message which were produced for C<$reason>. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$reason] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Logging Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">. =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher::Try-EB(@CODE) Inherited, see L =item $obj-EB() =item Log::Report::Dispatcher::Try-EB() Inherited, see L =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher::Try-EB( [$maxdepth] ) Inherited, see L =item $obj-EB($opts, $reason, $message) Other dispatchers translate the message here, and make it leave the program. However, messages in a "try" block are only captured in an intermediate layer: they may never be presented to an end-users. And for sure, we do not know the language yet. The $message is either a STRING or a L. =item $obj-EB(%options) Re-cast the messages in all collect exceptions into the defined dispatchers, which were disabled during the try block. The %options will end-up as HASH of %options to L; see L which does the job. =item $obj-EB() Re-cast only the fatal message to the defined dispatchers. If the block was left without problems, then nothing will be done. The %options will end-up as HASH of %options to L; see L which does the job. =item $obj-EB() Inherited, see L =item $obj-EB(%options) =item Log::Report::Dispatcher::Try-EB(%options) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message) Inherited, see L =back =head2 Status =over 4 =item $obj-EB() Returns true if the block was left with an fatal message. =item $obj-EB() If this object is kept in C<$@>, and someone uses this as string, we want to show the fatal error message. The message is not very informative for the good cause: we do not want people to simply print the C<$@>, but wish for a re-cast of the message using L or L. =item $obj-EB() Returns true if the block exited normally. =item $obj-EB(%options) Returns the L which caused the "try" block to die, otherwise an empty LIST (undef). -Option--Default class undef =over 2 =item class => CLASS|REGEX Only return the exception if it was fatal, and in the same time in the specified CLASS (as string) or matches the REGEX. See L =back =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 OVERLOADING =over 4 =item overload: B Returns true if the previous try block did produce a terminal error. This "try" object is assigned to C<$@>, and the usual perl syntax is C. =item overload: B When C<$@> is used the traditional way, it is checked to have a string content. In this case, stringify into the fatal error or nothing. =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report/Dispatcher/Log4perl.pod0000644000175000001440000001570015000465233023173 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Log4perl - send messages to Log::Log4perl back-end =head1 INHERITANCE Log::Report::Dispatcher::Log4perl is a Log::Report::Dispatcher =head1 SYNOPSIS # start using log4perl via a config file # The name of the dispatcher is the name of the default category. dispatcher LOG4PERL => 'logger' , accept => 'NOTICE-' , config => "$ENV{HOME}/.log.conf"; # disable default dispatcher dispatcher close => 'logger'; # configuration inline, not in file: adapted from the Log4perl manpage my $name = 'logger'; my $outfile = '/tmp/a.log'; my $config = <<__CONFIG; log4perl.category.$name = INFO, Logfile log4perl.logger.Logfile = Log::Log4perl::Appender::File log4perl.logger.Logfile.filename = $outfn log4perl.logger.Logfile.layout = Log::Log4perl::Layout::PatternLayout log4perl.logger.Logfile.layout.ConversionPattern = %d %F{1} %L> %m __CONFIG dispatcher LOG4PERL => $name, config => \$config; =head1 DESCRIPTION This dispatchers produces output tot syslog, based on the C module (which will not be automatically installed for you). Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. =head2 Reasons <--> Levels The REASONs for a message in L are names quite similar to the log levels used by Log::Log4perl. The default mapping is list below. You can change the mapping using L. TRACE => $DEBUG ERROR => $ERROR ASSERT => $DEBUG FAULT => $ERROR INFO => $INFO ALERT => $FATAL NOTICE => $INFO FAILURE => $FATAL WARNING => $WARN PANIC => $FATAL MISTAKE => $WARN =head2 Categories C uses text-domains for translation tables. These are also used as categories for the Log4perl infrastructure. So, typically every module start with: use Log::Report 'my-text-domain', %more_options; Now, if there is a logger inside the log4perl configuration which is named 'my-text-domain', that will be used. Otherwise, the name of the dispatcher is used to select the logger. =head3 Limitiations The global C<$caller_depth> concept of Log::Log4perl is broken. That variable is used to find the filename and line number of the logged messages. But these messages may have been caught, rerouted, eval'ed, and otherwise followed a unpredictable multi-leveled path before it reached the Log::Log4perl dispatcher. This means that layout patterns C<%F> and C<%L> are not useful in the generic case, maybe in your specific case. =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Log::Report::Dispatcher::Log4perl-EB($type, $name, %options) The Log::Log4perl infrastructure has all settings in a configuration file. In that file, you should find a category with the $name. -Option --Defined in --Default accept Log::Report::Dispatcher 'ALL' charset Log::Report::Dispatcher config format_reason Log::Report::Dispatcher 'LOWERCASE' locale Log::Report::Dispatcher mode Log::Report::Dispatcher 'NORMAL' to_level [] =over 2 =item accept => REASONS =item charset => CHARSET =item config => FILENAME|SCALAR When a SCALAR reference is passed in, that must refer to a string which contains the configuration text. Otherwise, specify an existing FILENAME. By default, it is expected that Log::Log4perl has been initialized externally. That module uses global variables to communicate, which should be present before any logging is attempted. =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item locale => LOCALE =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item to_level => ARRAY-of-PAIRS See L. =back =back =head2 Accessors Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB( [$domain] ) Returns the Log::Log4perl::Logger object which is used for logging. When there is no specific logger for this $domain (logger with the exact name of the $domain) the default logger is being used, with the name of this dispatcher. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$reason] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Logging Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">. =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher::Log4perl-EB(@CODE) Inherited, see L =item $obj-EB() =item Log::Report::Dispatcher::Log4perl-EB() Inherited, see L =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher::Log4perl-EB( [$maxdepth] ) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message, $domain) Inherited, see L =item $obj-EB($reason) Returns a level which is understood by Log::Dispatch, based on a translation table. This can be changed with L. example: use Log::Log4perl qw/:levels/; # by default, ALERTs are output as $FATAL dispatcher Log::Log4perl => 'logger' , to_level => [ ALERT => $ERROR, ] , ...; =item $obj-EB() Inherited, see L =item $obj-EB(%options) =item Log::Report::Dispatcher::Log4perl-EB(%options) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message) Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report/messages/0000755000175000001440000000000015000465237020521 5ustar00markovusers00000000000000Log-Report-1.40/lib/Log/Report/messages/log-report.utf-8.po0000644000175000001440000001147215000464120024110 0ustar00markovusers00000000000000#. Header generated with Log::Report::Lexicon::POT 0.0 msgid "" msgstr "" "Project-Id-Version: log-report 0.01\n" "Report-Msgid-Bugs-To:\n" "POT-Creation-Date: 2007-05-14 17:14+0200\n" "PO-Revision-Date: 2025-04-14 17:56+0200\n" "Last-Translator:\n" "Language-Team:\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=utf-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n!=1);\n" #: lib/Log/Report/Dispatcher/Log4perl.pm:145 #, fuzzy msgid "Log4perl level '{level}' must be in 0-5" msgstr "" #: lib/Log/Report/Dispatcher/LogDispatch.pm:109 #, fuzzy msgid "Log::Dispatch level '{level}' not understood" msgid_plural "level" msgstr[0] "" msgstr[1] "" #: lib/Log/Report/Domain.pm:180 #, fuzzy msgid "Missing key '{key}' in format '{format}', file {use}" msgstr "" #: lib/Log/Report/Dispatcher/Log4perl.pm:31 #: lib/Log/Report/Dispatcher/LogDispatch.pm:31 #, fuzzy msgid "Not all reasons have a default translation" msgstr "" #: lib/Log/Report/Dispatcher.pm:159 #, fuzzy msgid "Perl does not support charset {cs}" msgstr "" #: lib/Log/Report.pm:280 #, fuzzy msgid "a message object is reported with more parameters" msgstr "" #: lib/Log/Report/Dispatcher.pm:322 lib/Log/Report/Dispatcher.pm:332 #, fuzzy msgid "at {filename} line {line}" msgstr "" #: lib/Log/Report/Domain.pm:251 #, fuzzy msgid "cannot open JSON file for context at {fn}" msgstr "" #: lib/Log/Report/Dispatcher/File.pm:260 #, fuzzy msgid "cannot rotate log file which was opened as file-handle" msgstr "" #: lib/Log/Report/Dispatcher/File.pm:272 #, fuzzy msgid "cannot write log into {file}" msgstr "" #: lib/Log/Report/Dispatcher/File.pm:218 #, fuzzy msgid "cannot write log into {file} with mode '{binmode}'" msgstr "" #: lib/Log/Report/Dispatcher/Callback.pm:66 #, fuzzy msgid "dispatcher {name} needs a 'callback'" msgstr "" #: lib/Log/Report/Dispatcher/File.pm:145 #, fuzzy msgid "dispatcher {name} needs parameter 'to'" msgstr "" #: lib/Log/Report.pm:732 #, fuzzy msgid "even length parameter list for __x at {where}" msgstr "" #: lib/Log/Report/Dispatcher.pm:153 #, fuzzy msgid "illegal format_reason '{format}' for dispatcher" msgstr "" #: lib/Log/Report/Dispatcher/Syslog.pm:135 #, fuzzy msgid "max one active syslog dispatcher, attempt for {new} have {old}" msgstr "" #: lib/Log/Report.pm:1017 #, fuzzy msgid "message_class {class} does not extend {base}" msgstr "" #: lib/Log/Report.pm:1032 #, fuzzy msgid "no domain for configuration options in {fn} line {line}" msgstr "" #: lib/Log/Report/Dispatcher/Syslog.pm:34 #, fuzzy msgid "not all reasons have a default translation" msgstr "" #: lib/Log/Report.pm:569 #, fuzzy msgid "odd length parameter list for try(): forgot the terminating ';'?" msgstr "" #: lib/Log/Report.pm:272 #, fuzzy msgid "odd length parameter list with '{msg}'" msgstr "" #: lib/Log/Report.pm:286 #, fuzzy msgid "odd length parameter list with object '{msg}'" msgstr "" #: lib/Log/Report.pm:483 #, fuzzy msgid "only one dispatcher name accepted in SCALAR context" msgstr "" #: lib/Log/Report/Dispatcher.pm:218 #, fuzzy msgid "switching to run mode {mode} for {pkg}, accept {accept}" msgstr "" #: lib/Log/Report.pm:1010 #, fuzzy msgid "syntax flag must be either SHORT or REPORT, not `{flag}' in {fn} line {line}" msgstr "" #: lib/Log/Report/Dispatcher/Syslog.pm:160 #, fuzzy msgid "syslog level '{level}' not understood" msgstr "" #: lib/Log/Report.pm:1042 #, fuzzy msgid "textdomain `{domain}' for translator not defined" msgstr "" #: lib/Log/Report.pm:457 #, fuzzy msgid "the 'filter' sub-command needs a CODE reference" msgstr "" #: lib/Log/Report.pm:442 #, fuzzy msgid "the 'list' sub-command doesn't expect additional parameters" msgstr "" #: lib/Log/Report.pm:450 #, fuzzy msgid "the 'needs' sub-command parameter '{reason}' is not a reason" msgstr "" #: lib/Log/Report/Domain.pm:162 #, fuzzy msgid "the native_language '{locale}' is not a valid locale" msgstr "" #: lib/Log/Report.pm:241 #, fuzzy msgid "token '{token}' not recognized as reason" msgstr "" #: lib/Log/Report.pm:1051 #, fuzzy msgid "translator must be a {pkg} object for {domain}" msgstr "" #: lib/Log/Report/Dispatcher/Try.pm:284 #, fuzzy msgid "try-block stopped with {reason}: {text}" msgstr "" #: lib/Log/Report/Dispatcher/File.pm:267 #, fuzzy msgid "unable to rotate logfile {fn} to {oldfn}" msgstr "" #: lib/Log/Report/Dispatcher/File.pm:157 #, fuzzy msgid "unknown format parameter `{what}'" msgstr "" #: lib/Log/Report/Domain.pm:257 #, fuzzy msgid "unsupported context file type for {fn}" msgstr "" #: lib/Log/Report/Domain.pm:201 #, fuzzy msgid "you need to configure context_rules before setContext" msgstr "" #: lib/Log/Report/Dispatcher.pm:307 #, fuzzy msgid "{message}; {error}" msgstr "" #: lib/Log/Report/Dispatcher.pm:306 #, fuzzy msgid "{reason}: {message}" msgstr "" #: lib/Log/Report/Dispatcher.pm:305 #, fuzzy msgid "{reason}: {message}; {error}" msgstr "" Log-Report-1.40/lib/Log/Report/messages/log-report/0000755000175000001440000000000015000465237022613 5ustar00markovusers00000000000000Log-Report-1.40/lib/Log/Report/messages/log-report/nl_NL.po0000644000175000001440000001403015000464120024141 0ustar00markovusers00000000000000#. Header generated with Log::Report::Lexicon::POT 0.0 msgid "" msgstr "" "Project-Id-Version: log-report 0.01\n" "Report-Msgid-Bugs-To:\n" "POT-Creation-Date: 2007-05-14 17:14+0200\n" "PO-Revision-Date: 2025-04-14 17:56+0200\n" "Last-Translator: Mark Overmeer \n" "Language-Team:\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=utf-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n!=1);\n" #~ msgid "ALERT" #~ msgstr "ALARM" #~ msgid "ASSERT" #~ msgstr "CONDITIE" #~ msgid "ERROR" #~ msgstr "ERROR" #~ msgid "FAILURE" #~ msgstr "STORING" #~ msgid "FAULT" #~ msgstr "PROBLEEM" #~ msgid "INFO" #~ msgstr "INFO" #: lib/Log/Report/Dispatcher/Log4perl.pm:145 #, fuzzy msgid "Log4perl level '{level}' must be in 0-5" msgstr "Log4perl level '{level}' is getal van 0 tot 5" #: lib/Log/Report/Dispatcher/LogDispatch.pm:109 msgid "Log::Dispatch level '{level}' not understood" msgstr "Log::Dispatch level '{level}' niet herkend" #~ msgid "MISTAKE" #~ msgstr "FOUT" #: lib/Log/Report/Domain.pm:180 #, fuzzy msgid "Missing key '{key}' in format '{format}', file {use}" msgstr "" #~ msgid "NOTICE" #~ msgstr "OPGELET" #: lib/Log/Report/Dispatcher/Log4perl.pm:31 #: lib/Log/Report/Dispatcher/LogDispatch.pm:31 msgid "Not all reasons have a default translation" msgstr "Niet alle redenen hebben een default vertaling" #~ msgid "PANIC" #~ msgstr "PANIEK" #: lib/Log/Report/Dispatcher.pm:159 msgid "Perl does not support charset {cs}" msgstr "Perl heeft geen support voor tekenset {cs}" #~ msgid "TRACE" #~ msgstr "TRACE" #~ msgid "WARNING" #~ msgstr "WAARSCHUWING" #: lib/Log/Report.pm:280 msgid "a message object is reported with more parameters" msgstr "een message object vergezeld van meer parameters" #: lib/Log/Report/Dispatcher.pm:322 lib/Log/Report/Dispatcher.pm:332 msgid "at {filename} line {line}" msgstr "in {filename} regel {line}" #: lib/Log/Report/Domain.pm:251 #, fuzzy msgid "cannot open JSON file for context at {fn}" msgstr "" #: lib/Log/Report/Dispatcher/File.pm:260 #, fuzzy msgid "cannot rotate log file which was opened as file-handle" msgstr "" #: lib/Log/Report/Dispatcher/File.pm:272 #, fuzzy msgid "cannot write log into {file}" msgstr "" #: lib/Log/Report/Dispatcher/File.pm:218 #, fuzzy msgid "cannot write log into {file} with mode '{binmode}'" msgstr "kan log niet naar bestand {file} schrijven in {binmode}" #: lib/Log/Report/Dispatcher/Callback.pm:66 msgid "dispatcher {name} needs a 'callback'" msgstr "dispatcher {name} verlangt een 'callback'" #: lib/Log/Report/Dispatcher/File.pm:145 msgid "dispatcher {name} needs parameter 'to'" msgstr "dispatcher {name} verlangt argument 'to'" #: lib/Log/Report.pm:732 msgid "even length parameter list for __x at {where}" msgstr "een even-lengte lijst van parameters bij __x bij {where}" #: lib/Log/Report/Dispatcher.pm:153 msgid "illegal format_reason '{format}' for dispatcher" msgstr "onbekende format_reason '{format}' voor dispatcher" #: lib/Log/Report/Dispatcher/Syslog.pm:135 #, fuzzy msgid "max one active syslog dispatcher, attempt for {new} have {old}" msgstr "" #: lib/Log/Report.pm:1017 #, fuzzy msgid "message_class {class} does not extend {base}" msgstr "" #: lib/Log/Report.pm:1032 #, fuzzy msgid "no domain for configuration options in {fn} line {line}" msgstr "" #: lib/Log/Report/Dispatcher/Syslog.pm:34 #, fuzzy msgid "not all reasons have a default translation" msgstr "" #: lib/Log/Report.pm:569 msgid "odd length parameter list for try(): forgot the terminating ';'?" msgstr "oneven lengte van parameterlijst voor try(): afsluitende ';' vergeten?" #: lib/Log/Report.pm:272 msgid "odd length parameter list with '{msg}'" msgstr "parameter-lijst van oneven lengte bij '{msg}'" #: lib/Log/Report.pm:286 #, fuzzy msgid "odd length parameter list with object '{msg}'" msgstr "" #: lib/Log/Report.pm:483 msgid "only one dispatcher name accepted in SCALAR context" msgstr "dispatcher gebruik in SCALAR context accepteert slechts één naam" #: lib/Log/Report/Dispatcher.pm:218 #, fuzzy msgid "switching to run mode {mode} for {pkg}, accept {accept}" msgstr "" #: lib/Log/Report.pm:1010 #, fuzzy msgid "syntax flag must be either SHORT or REPORT, not `{flag}' in {fn} line {line}" msgstr "" #: lib/Log/Report/Dispatcher/Syslog.pm:160 msgid "syslog level '{level}' not understood" msgstr "syslog level '{level}' niet herkend" #: lib/Log/Report.pm:1042 #, fuzzy msgid "textdomain `{domain}' for translator not defined" msgstr "" #: lib/Log/Report.pm:457 msgid "the 'filter' sub-command needs a CODE reference" msgstr "het 'filter' sub-commando verwacht een CODE referentie" #: lib/Log/Report.pm:442 msgid "the 'list' sub-command doesn't expect additional parameters" msgstr "het 'list' sub-commando verwacht geen aanvullende argumenten" #: lib/Log/Report.pm:450 msgid "the 'needs' sub-command parameter '{reason}' is not a reason" msgstr "het 'needs' sub-commando argument '{reason}' is geen reden" #: lib/Log/Report/Domain.pm:162 #, fuzzy msgid "the native_language '{locale}' is not a valid locale" msgstr "" #: lib/Log/Report.pm:241 msgid "token '{token}' not recognized as reason" msgstr "token '{token}' niet herkend als reden" #: lib/Log/Report.pm:1051 #, fuzzy msgid "translator must be a {pkg} object for {domain}" msgstr "" #: lib/Log/Report/Dispatcher/Try.pm:284 msgid "try-block stopped with {reason}: {text}" msgstr "try-blok gestopt met {reason}: {text}" #: lib/Log/Report/Dispatcher/File.pm:267 #, fuzzy msgid "unable to rotate logfile {fn} to {oldfn}" msgstr "" #: lib/Log/Report/Dispatcher/File.pm:157 #, fuzzy msgid "unknown format parameter `{what}'" msgstr "" #: lib/Log/Report/Domain.pm:257 #, fuzzy msgid "unsupported context file type for {fn}" msgstr "" #: lib/Log/Report/Domain.pm:201 #, fuzzy msgid "you need to configure context_rules before setContext" msgstr "" #: lib/Log/Report/Dispatcher.pm:307 msgid "{message}; {error}" msgstr "{message}; {error}" #: lib/Log/Report/Dispatcher.pm:306 msgid "{reason}: {message}" msgstr "{reason}: {message}" #: lib/Log/Report/Dispatcher.pm:305 msgid "{reason}: {message}; {error}" msgstr "{reason}: {message}; {error}" Log-Report-1.40/lib/Log/Report/messages/first-domain.utf-8.po0000644000175000001440000000315214637476635024443 0ustar00markovusers00000000000000#. Header generated with Log::Report::Lexicon::POT 0.0 msgid "" msgstr "" "Project-Id-Version: first-domain 0.01\n" "Report-Msgid-Bugs-To:\n" "POT-Creation-Date: 2012-08-30 21:00+0200\n" "PO-Revision-Date: 2012-08-30 21:00+0200\n" "Last-Translator:\n" "Language-Team:\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=utf-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n!=1);\n" #: t/40ppi.t:54 #, fuzzy msgid "a1" msgstr "" #: t/40ppi.t:55 #, fuzzy msgid "a2" msgstr "" #: t/40ppi.t:56 #, fuzzy msgid "a3a" msgstr "" #: t/40ppi.t:57 #, fuzzy msgid "a4" msgstr "" #: t/40ppi.t:62 #, fuzzy msgid "b2" msgstr "" #: t/40ppi.t:63 #, fuzzy msgid "b3a" msgstr "" #: t/40ppi.t:64 #, fuzzy msgid "b4" msgstr "" #: t/40ppi.t:65 #, fuzzy msgid "b5a" msgstr "" #: t/40ppi.t:66 #, fuzzy msgid "b6a" msgstr "" #: t/40ppi.t:67 #, fuzzy msgid "b7a" msgstr "" #: t/40ppi.t:68 #, fuzzy msgid "b8a" msgstr "" #: t/40ppi.t:69 #, fuzzy msgid "b9a" msgstr "" #: t/40ppi.t:71 #, fuzzy msgid "c1" msgid_plural "c2" msgstr[0] "" msgstr[1] "" #: t/40ppi.t:72 #, fuzzy msgid "c3" msgid_plural "c4" msgstr[0] "" msgstr[1] "" #: t/40ppi.t:73 #, fuzzy msgid "c5" msgid_plural "c6" msgstr[0] "" msgstr[1] "" #: t/40ppi.t:74 #, fuzzy msgid "c7" msgid_plural "c8" msgstr[0] "" msgstr[1] "" #: t/40ppi.t:76 #, fuzzy msgid "d1" msgstr "" #: t/40ppi.t:78 #, fuzzy msgid "d2" msgstr "" #: t/40ppi.t:78 #, fuzzy msgid "d3" msgstr "" #: t/40ppi.t:79 #, fuzzy msgid "d4" msgstr "" #: t/40ppi.t:79 #, fuzzy msgid "d5" msgstr "" #: t/40ppi.t:79 #, fuzzy msgid "d6" msgstr "" #: t/40ppi.t:79 #, fuzzy msgid "d7" msgstr "" Log-Report-1.40/lib/Log/Report/Message.pod0000644000175000001440000004200715000465233021001 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Message - a piece of text to be translated =head1 INHERITANCE Log::Report::Message is extended by Dancer2::Plugin::LogReport::Message =head1 SYNOPSIS # Objects created by Log::Report's __ functions # Full feature description in the DETAILS section # no interpolation __"Hello, World"; # with interpolation __x"age {years}", years => 12; # interpolation for one or many my $nr_files = @files; __nx"one file", "{_count} files", $nr_files; __nx"one file", "{_count} files", \@files; # interpolation of arrays __x"price-list: {prices%.2f}", prices => \@prices, _join => ', '; # white-spacing on msgid preserved print __"\tCongratulations,\n"; print "\t", __("Congratulations,"), "\n"; # same =head1 DESCRIPTION Any use of a translation function exported by L, like C<__()> (the function is named underscore-underscore) or C<__x()> (underscore-underscore-x) will result in this object. It will capture some environmental information, and delay the translation until it is needed. Creating an object first and translating it later, is slower than translating it immediately. However, on the location where the message is produced, we do not yet know in what language to translate it to: that depends on the front-end, the log dispatcher. =head1 METHODS =head2 Constructors =over 4 =item $obj-EB(%options, $variables) Returns a new object which copies info from original, and updates it with the specified %options and $variables. The advantage is that the cached translations are shared between the objects. example: use of clone() my $s = __x "found {nr} files", nr => 5; my $t = $s->clone(nr => 3); my $t = $s->(nr => 3); # equivalent print $s; # found 5 files print $t; # found 3 files =item Log::Report::Message-EB($domain, $msgid, $params) See L on the details how to integrate Log::Report translations with Template::Toolkit (version 1 and 2) =item Log::Report::Message-EB(%options) B, but use L and friends. The %options is a mixed list of object initiation parameters (all with a leading underscore) and variables to be filled in into the translated C<_msgid> string. -Option --Default _append undef _category undef _class [] _classes [] _context undef _count undef _domain _expand false _join $" $LIST_SEPARATOR _lang _msgctxt undef _msgid undef _plural undef _prepend undef _to =over 2 =item _append => STRING|MESSAGE Text as STRING or MESSAGE object to be displayed after the display of this message. =item _category => INTEGER The category when the real gettext library is used, for instance LC_MESSAGES. =item _class => STRING|ARRAY When messages are used for exception based programming, you add C<_class> parameters to the argument list. Later, with for instance L, you can check the category of the message. One message can be part of multiple classes. The STRING is used as comma- and/or blank separated list of class tokens (barewords), the ARRAY lists all tokens separately. See L. =item _classes => STRING|ARRAY Alternative for C<_class>, which cannot be used at the same time. =item _context => WORDS|ARRAY [1.00] Set keywords which can be used to select alternatives between translations. Read the DETAILS section in L =item _count => INTEGER|ARRAY|HASH When defined, the C<_plural> need to be defined as well. When an ARRAY is provided, the length of the ARRAY is taken. When a HASH is given, the number of keys in the HASH is used. =item _domain => STRING The text-domain (translation table) to which this C<_msgid> belongs. With this parameter, your can "borrow" translations from other textdomains. Be very careful with this (although there are good use-cases) The xgettext msgid extractor may add the used msgid to this namespace as well. To avoid that, add a harmless '+': print __x(+"errors", _domain => 'global'); The extractor will not take the msgid when it is an expression. The '+' has no effect on the string at runtime. =item _expand => BOOLEAN Indicates whether variables are to be filled-in. =item _join => STRING Which STRING to be used then an ARRAY is being filled-in. =item _lang => ISO [1.00] Override language setting from locale, for instance because that is not configured correctly (yet). This does not extend to prepended or appended translated message object. =item _msgctxt => STRING [1.22] Message context in the translation file, the traditional use. Cannot be combined with C<_context> on the same msgids. =item _msgid => MSGID The message label, which refers to some translation information. Usually a string which is close the English version of the message. This will also be used if there is no translation possible/known. Leading white-space C<\s> will be added to C<_prepend>. Trailing white-space will be added before C<_append>. =item _plural => MSGID Can be used together with C<_count>. This plural form of the C<_msgid> text is used to simplify the work of translators, and as fallback when no translation is possible: therefore, this can best resemble an English message. White-space at the beginning and end of the string are stripped off. The white-space provided by the C<_msgid> will be used. =item _prepend => STRING|MESSAGE Text as STRING or MESSAGE object to be displayed before the display of this message. =item _to => NAME Specify the NAME of a dispatcher as destination explicitly. Short for C<< report {to => NAME}, ... >> See L =back =back =head2 Accessors =over 4 =item $obj-EB() Returns the string or L object which is appended after this one. Usually C. =item $obj-EB() Returns the LIST of classes which are defined for this message; message group indicators, as often found in exception-based programming. =item $obj-EB() Returns an HASH if there is a context defined for this message. =item $obj-EB() Returns the count, which is used to select the translation alternatives. =item $obj-EB() Returns the domain of the first translatable string in the structure. =item $obj-EB( [$errno] ) [1.38] Returns the value of the C<_errno> key, to indicate the error number (to be returned from your script). Usually, this method will return undef. For FAILURE, FAULT, and ALERT, the errno is by default taken from C<$!> and C<$?>. =item $obj-EB() The message context for the translation table lookup. =item $obj-EB() Returns the msgid which will later be translated. =item $obj-EB() Returns the string which is prepended to this one. Usually C. =item $obj-EB( [$name] ) Returns the $name of a dispatcher if explicitly specified with the '_to' key. Can also be used to set it. Usually, this will return undef, because usually all dispatchers get all messages. =item $obj-EB($parameter) Lookup the named $parameter for the message. All pre-defined names have their own method which should be used with preference. example: When the message was produced with my @files = qw/one two three/; my $msg = __xn "found one file: {file}" , "found {nrfiles} files: {files}" , scalar @files , file => $files[0] , files => \@files , nrfiles => @files+0 # or scalar(@files) , _class => 'IO, files' , _join => ', '; then the values can be takes from the produced message as my $files = $msg->valueOf('files'); # returns ARRAY reference print @$files; # 3 my $count = $msg->count; # 3 my @class = $msg->classes; # 'IO', 'files' if($msg->inClass('files')) # true Simplified, the above example can also be written as: local $" = ', '; my $msg = __xn "found one file: {files}" , "found {_count} files: {files}" , @files # has scalar context , files => \@files , _class => 'IO, files'; =back =head2 Processing =over 4 =item $obj-EB( STRING|$object, [$prepend] ) This method implements the overloading of concatenation, which is needed to delay translations even longer. When $prepend is true, the STRING or $object (other C) needs to prepended, otherwise it is appended. example: of concatenation print __"Hello" . ' ' . __"World!"; print __("Hello")->concat(' ')->concat(__"World!")->concat("\n"); =item $obj-EB($class|Regexp) Returns true if the message is in the specified $class (string) or matches the Regexp. The trueth value is the (first matching) class. =item $obj-EB( [$locale] ) [1.11] Translate the message, and then entity encode HTML volatile characters. [1.20] When used in combination with a templating system, you may want to use C< 'HTML'>> in L. example: print $msg->toHTML('NL'); =item $obj-EB( [$locale] ) Translate a message. If not specified, the default locale is used. =item $obj-EB() Return the concatenation of the prepend, msgid, and append strings. Variable expansions within the msgid is not performed. =back =head1 DETAILS =head2 OPTIONS and VARIABLES The L functions which define translation request can all have OPTIONS. Some can have VARIABLES to be interpolated in the string as well. To distinguish between the OPTIONS and VARIABLES (both a list of key-value pairs), the keys of the OPTIONS start with an underscore C<_>. As result of this, please avoid the use of keys which start with an underscore in variable names. On the other hand, you are allowed to interpolate OPTION values in your strings. =head3 Interpolating With the C<__x()> or C<__nx()>, interpolation will take place on the translated MSGID string. The translation can contain the VARIABLE and OPTION names between curly brackets. Text between curly brackets which is not a known parameter will be left untouched. fault __x"cannot open open {filename}", filename => $fn; print __xn"directory {dir} contains one file" ,"directory {dir} contains {nr_files} files" , scalar(@files) # (1) (2) , nr_files => scalar @files # (3) , dir => $dir; (1) this required third parameter is used to switch between the different plural forms. English has only two forms, but some languages have many more. (2) the "scalar" keyword is not needed, because the third parameter is in SCALAR context. You may also pass C< \@files > there, because ARRAYs will be converted into their length. A HASH will be converted into the number of keys in the HASH. (3) the C keyword is required here, because it is LIST context: otherwise all filenames will be filled-in as parameters to C<__xn()>. See below for the available C<_count> valure, to see how the C parameter can disappear. =head3 Interpolation of VARIABLES C uses L to interpolate values in(translated) messages. This is a very powerful syntax, and you should certainly read that manual-page. Here, we only described additional features, specific to the usage of C in C objects. There is no way of checking beforehand whether you have provided all required values, to be interpolated in the translated string. For interpolating, the following rules apply: =over 4 =item * Simple scalar values are interpolated "as is" =item * References to SCALARs will collect the value on the moment that the output is made. The C object which is created with the C<__xn> can be seen as a closure. The translation can be reused. See example below. =item * Code references can be used to create the data "under fly". The C object which is being handled is passed as only argument. This is a hash in which all OPTIONS and VARIABLES can be found. =item * When the value is an ARRAY, all members will be interpolated with C<$"> between the elements. Alternatively (maybe nicer), you can pass an interpolation parameter via the C<_join> OPTION. =back local $" = ', '; error __x"matching files: {files}", files => \@files; error __x"matching files: {files}", files => \@files, _join => ', '; =head3 Interpolation of OPTIONS You are permitted the interpolate OPTION values in your string. This may simplify your coding. The useful names are: =over 4 =item _msgid The MSGID as provided with L and L =item _plural, _count The PLURAL MSGIDs, respectively the COUNT as used with L and L =item _textdomain The label of the textdomain in which the translation takes place. =item _class or _classes Are to be used to group reports, and can be queried with L, L, or L. =back B<. Example: using the _count> With Locale::TextDomain, you have to do use Locale::TextDomain; print __nx ( "One file has been deleted.\n" , "{num} files have been deleted.\n" , $num_files , num => $num_files ); With C, you can do use Log::Report; print __nx ( "One file has been deleted.\n" , "{_count} files have been deleted.\n" , $num_files ); Of course, you need to be aware that the name used to reference the counter is fixed to C<_count>. The first example works as well, but is more verbose. =head3 Handling white-spaces In above examples, the msgid and plural form have a trailing new-line. In general, it is much easier to write print __x"Hello, World!\n"; than print __x("Hello, World!") . "\n"; For the translation tables, however, that trailing new-line is "over information"; it is an layout issue, not a translation issue. Therefore, the first form will automatically be translated into the second. All leading and trailing white-space (blanks, new-lines, tabs, ...) are removed from the msgid before the look-up, and then added to the translated string. Leading and trailing white-space on the plural form will also be removed. However, after translation the spacing of the msgid will be used. =head3 Avoiding repetative translations This way of translating is somewhat expensive, because an object to handle the C<__x()> is created each time. for my $i (1..100_000) { print __x "Hello World {i}\n", i => $i; } The suggestion that Locale::TextDomain makes to improve performance, is to get the translation outside the loop, which only works without interpolation: use Locale::TextDomain; my $i = 42; my $s = __x("Hello World {i}\n", i => $i); foreach $i (1..100_000) { print $s; } Oops, not what you mean because the first value of C<$i> is captured in the initial message object. With Log::Report, you can do it (except when you use contexts) use Log::Report; my $i; my $s = __x("Hello World {i}\n", i => \$i); foreach $i (1..100_000) { print $s; } Mind you not to write: C in above case!!!! You can also write an incomplete translation: use Log::Report; my $s = __x "Hello World {i}\n"; foreach my $i (1..100_000) { print $s->(i => $i); } In either case, the translation will be looked-up only once. =head1 OVERLOADING =over 4 =item overload: B When the object is used to call as $function, a new object is created with the data from the original one but updated with the new parameters. Implemented in C. =item overload: B An (accidental) use of concatenation (a dot where a comma should be used) would immediately stringify the object. This is avoided by overloading that operation. =item overload: B When the object is used in string context, it will get translated. Implemented as L. =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report/DBIC/0000755000175000001440000000000015000465237017413 5ustar00markovusers00000000000000Log-Report-1.40/lib/Log/Report/DBIC/Profiler.pod0000644000175000001440000000230215000465233021672 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::DBIC::Profiler - query profiler for DBIx::Class =head1 INHERITANCE Log::Report::DBIC::Profiler is a DBIx::Class::Storage::Statistics =head1 SYNOPSIS use Log::Report::DBIC::Profiler; $schema->storage->debugobj(Log::Report::DBIC::Profiler->new); $schema->storage->debug(1); # And maybe (if no exceptions expected from DBIC) $schema->exception_action(sub { panic @_ }); # Log to syslog use Log::Report; dispatcher SYSLOG => 'myapp' , identity => 'myapp' , facility => 'local0' , flags => "pid ndelay nowait" , mode => 'DEBUG'; =head1 DESCRIPTION This profile will log DBIx::Class queries via L to a selected back-end (via a dispatcher, see L) =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report/DBIC/Profiler.pm0000644000175000001440000000162115000465232021526 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::DBIC::Profiler;{ our $VERSION = '1.40'; } use base 'DBIx::Class::Storage::Statistics'; use strict; use warnings; use Log::Report 'log-report', import => 'trace'; use Time::HiRes qw(time); my $start; sub print($) { trace $_[1] } sub query_start(@) { my $self = shift; $self->SUPER::query_start(@_); $start = time; } sub query_end(@) { my $self = shift; $self->SUPER::query_end(@_); trace sprintf "execution took %0.4f seconds elapse", time-$start; } 1; Log-Report-1.40/lib/Log/Report/Dispatcher.pod0000644000175000001440000003207015000465233021502 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher - manage message dispatching, display or logging =head1 INHERITANCE Log::Report::Dispatcher is extended by Log::Report::Dispatcher::Callback Log::Report::Dispatcher::File Log::Report::Dispatcher::Log4perl Log::Report::Dispatcher::LogDispatch Log::Report::Dispatcher::Perl Log::Report::Dispatcher::Syslog Log::Report::Dispatcher::Try =head1 SYNOPSIS use Log::Report; # The following will be created for you automatically dispatcher 'PERL', 'default', accept => 'NOTICE-'; dispatcher close => 'default'; # after deamonize dispatcher 'FILE', 'log' , mode => 'DEBUG', to => '/var/log/mydir/myfile'; # Full package name is used, same as 'FILE' dispatcher Log::Report::Dispatch::File => 'stderr' , to => \*STDERR, accept => 'NOTICE-'; =head1 DESCRIPTION In L, dispatchers are used to handle (exception) messages which are created somewhere else. Those message were produced (thrown) by L and friends. This base-class handles the creation of dispatchers, plus the common filtering rules. See the L section, below. =head1 METHODS =head2 Constructors =over 4 =item $obj-EB() Terminate the dispatcher activities. The dispatcher gets disabled, to avoid the case that it is accidentally used. Returns C (false) if the dispatcher was already closed. =item Log::Report::Dispatcher-EB($type, $name, %options) Create a dispatcher. The $type of back-end to start is required, and listed in the L part of this manual-page. For various external back-ends, special wrappers are created. The $name must be uniquely identifying this dispatcher. When a second dispatcher is created (via L) with the name of an existing dispatcher, the existing one will get replaced. All %options which are not consumed by this base constructor are passed to the wrapped back-end. Some of them will check whether all %options are understood, other ignore unknown %options. -Option --Default accept depend on mode charset format_reason 'LOWERCASE' locale mode 'NORMAL' =over 2 =item accept => REASONS See L for possible values. If the initial mode for this dispatcher does not need verbose or debug information, then those levels will not be accepted. When the mode equals "NORMAL" (the default) then C's default is C. In case of "VERBOSE" it will be C, C results in C, and "DEBUG" in C. =item charset => CHARSET Convert the messages in the specified character-set (codeset). By default, no conversion will take place, because the right choice cannot be determined automatically. =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE How to show the reason text which is printed before the message. When a CODE is specified, it will be called with a translated text and the returned text is used. =item locale => LOCALE Overrules the global setting. Can be overruled by L. =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 Possible values are C (or C<0> or C), which will not show C or debug messages, C (C<1>; shows C not debug), C (C<2>; only ignores C messages), or C (C<3>) which shows everything. See section L. You are advised to use the symbolic mode names when the mode is changed within your program: the numerical values are available for smooth Getopt::Long integration. =back =back =head2 Accessors =over 4 =item $obj-EB() =item $obj-EB() Returns the mode in use for the dispatcher as number. See L and L. =item $obj-EB() Returns the unique name of this dispatcher. =item $obj-EB( [$reason] ) Returns the list with all REASONS which are needed to fulfill this dispatcher's needs. When disabled, the list is empty, but not forgotten. [0.999] when only one $reason is specified, it is returned if in the list. =item $obj-EB() The dispatcher $type, which is usually the same as the class of this object, but not in case of wrappers like for Log::Dispatch. =back =head2 Logging =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher-EB(@CODE) [1.13] Add one or more CODE blocks of caller lines which should not be collected for stack-traces or location display. A CODE gets called with an ARRAY of caller information, and returns true when that line should get skipped. B this logic is applied globally: on all dispatchers. example: By default, all lines in the Log::Report packages are skipped from display, with a simple CODE as this: sub in_lr { $_[0][0] =~ m/^Log\:\:Report(?:\:\:|$)/ } Log::Report::Dispatcher->addSkipStack(\&in_lr); The only parameter to in_lr is the return of caller(). The first element of that ARRAY is the package name of a stack line. =item $obj-EB() =item Log::Report::Dispatcher-EB() Collect the information to be displayed as line where the error occurred. =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher-EB( [$maxdepth] ) Returns an ARRAY of ARRAYs with text, filename, line-number. =item $obj-EB(HASH-$of-%options, $reason, $message, $domain) This method is called by L and should not be called directly. Internally, it will call L, which does most $of the work. =item $obj-EB() [1.13] Returns the number of nestings in the stack which should be skipped to get outside the Log::Report (and related) modules. The end-user does not want to see those internals in stack-traces. =item $obj-EB(%options) =item Log::Report::Dispatcher-EB(%options) -Option --Default abstract 1 call filename linenr max_line undef max_params 8 package params =over 2 =item abstract => INTEGER The higher the abstraction value, the less details are given about the caller. The minimum abstraction is specified, and then increased internally to make the line fit within the C margin. =item call => STRING =item filename => STRING =item linenr => INTEGER =item max_line => INTEGER =item max_params => INTEGER =item package => CLASS =item params => ARRAY =back =item $obj-EB(HASH-$of-%options, $reason, $message) See L, which describes the actions taken by this method. A string is returned, which ends on a new-line, and may be multi-line (in case a stack trace is produced). =back =head1 DETAILS =head2 Available back-ends When a dispatcher is created (via L or L), you must specify the TYPE of the dispatcher. This can either be a class name, which extends a L, or a pre-defined abbreviation of a class name. Implemented are: =over 4 =item L (abbreviation 'PERL') Use Perl's own C, C and C to ventilate reports. This is the default dispatcher. =item L (abbreviation 'FILE') Logs the message into a file, which can either be opened by the class or be opened before the dispatcher is created. =item L (abbreviation 'SYSLOG') Send messages into the system's syslog infrastructure, using Sys::Syslog. =item L (abbreviation 'CALLBACK') Calls any CODE reference on receipt of each selected message, for instance to send important message as email or SMS. =item C All of the Log::Dispatch::Output extensions can be used directly. The L will wrap around that back-end. =item C Use the Log::Log4perl main object to write to dispatchers. This infrastructure uses a configuration file. =item L (abbreviation 'TRY') Used by function L. It collects the exceptions and can produce them on request. =back =head2 Processing the message =head3 Addition information The modules which use C will only specify the base of the message string. The base dispatcher and the back-ends will extend this message with additional information: =over 4 =item . the reason =item . the filename/line-number where the problem appeared =item . the filename/line-number where it problem was reported =item . the error text in C<$!> =item . a stack-trace =item . a trailing new-line =back When the message is a translatable object (L, for instance created with L), then the added components will get translated as well. Otherwise, all will be in English. Exactly what will be added depends on the actual mode of the dispatcher (change it with L, initiate it with L). mode mode mode mode REASON SOURCE TE! NORM VERB ASSE DEBUG trace program ... S assert program ... SL SL info program T.. S S S notice program T.. S S S S mistake user T.. S S S SL warning program T.. S S SL SL error user TE. S S SL SC fault system TE! S S SL SC alert system T.! SL SL SC SC failure system TE! SL SL SC SC panic program .E. SC SC SC SC T - usually translated E - exception (execution interrupted) ! - will include $! text at display L - include filename and linenumber S - show/print when accepted C - stack trace (like Carp::confess()) =head3 Filters With a filter, you can block or modify specific messages before translation. There may be a wish to change the REASON of a report or its content. It is not possible to avoid the exit which is related to the original message, because a module's flow depends on it to happen. When there are filters defined, they will be called in order of definition. For each of the dispatchers which are called for a certain REASON (which C that REASON), it is checked whether its name is listed for the filter (when no names where specified, then the filter is applied to all dispatchers). When selected, the filter's CODE reference is called with four arguments: the dispatcher object (a L), the HASH-of-OPTIONS passed as optional first argument to L, the REASON, and the MESSAGE. Returned is the new REASON and MESSAGE. When the returned REASON is C, then the message will be ignored for that dispatcher. Be warned about processing the MESSAGE: it is a L object which may have a C string and C string or object. When the call to L contained multiple comma-separated components, these will already have been joined together using concatenation (see L. B<. Example: a filter on syslog> dispatcher filter => \&myfilter, 'syslog'; # ignore all translatable and non-translatable messages containing # the word "skip" sub myfilter($$$$) { my ($disp, $opts, $reason, $message) = @_; return () if $message->untranslated =~ m/\bskip\b/; ($reason, $message); } B<. Example: take all mistakes and warnings serious> dispatch filter => \&take_warns_seriously; sub take_warns_seriously($$$$) { my ($disp, $opts, $reason, $message) = @_; $reason eq 'MISTAKE' ? (ERROR => $message) : $reason eq 'WARNING' ? (FAULT => $message) : ($reason => $message); } =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report/Translator.pod0000644000175000001440000000377015000465233021552 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Translator - base implementation for translating messages =head1 INHERITANCE Log::Report::Translator is extended by Log::Report::Translator::Gettext Log::Report::Translator::POT =head1 SYNOPSIS # internal infrastructure my $msg = Log::Report::Message->new(_msgid => "Hello World\n"); print Log::Report::Translator->new(...)->translate($msg); # normal use textdomain 'my-domain' , translator => Log::Report::Translator->new; # default print __"Hello World\n"; =head1 DESCRIPTION A module (or distribution) has a certain way of translating messages, usually C. The translator is based on some C for the message, which can be specified as option per text element, but usually is package scoped. This base class does not translate at all: it will use the MSGID (and MSGID_PLURAL if available). It's a nice fallback if the language packs are not installed. =head1 METHODS =head2 Constructors =over 4 =item Log::Report::Translator-EB(%options) =back =head2 Accessors =head2 Translating =over 4 =item $obj-EB($domain, $locale) Load the translation information in the text $domain for the indicated $locale. Multiple calls to L should not cost significant performance: the data must be cached. =item $obj-EB( $message, [$language, $ctxt] ) Returns the translation of the $message, a C object, based on the current locale. Translators are permitted to peek into the internal HASH of the message object, for performance reasons. =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report/Domain.pod0000644000175000001440000002255015000465233020625 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Domain - administer one text-domain =head1 INHERITANCE Log::Report::Domain is a Log::Report::Minimal::Domain Log::Report::Domain is extended by Log::Report::Template::Textdomain =head1 SYNOPSIS # internal usage use Log::Report::Domain; my $domain = Log::Report::Domain->new(name => $name); # find a ::Domain object use Log::Report 'my-domain'; my $domain = textdomain 'my-domain'; # find domain config my $domain = textdomain; # config of this package # explicit domain configuration package My::Package; use Log::Report 'my-domain'; # set textdomain for package textdomain $name, %configure; # set config, once per program (textdomain $name)->configure(%configure); # same textdomain->configure(%configure); # same if current package in $name # implicit domain configuration package My::Package; use Log::Report 'my-domain', %configure; # external file for configuration (perl or json format) use Log::Report 'my-domain', config => $filename; use Log::Report 'my-domain'; textdomain->configure(config => $filename); =head1 DESCRIPTION L can handle multiple sets of packages at the same time: in the usual case a program consists of more than one software distribution, each containing a number of packages. Each module in an application belongs to one of these sets, by default the domain set 'default'. For C, those packags sets are differentiated via the text-domain value in the C statement: use Log::Report 'my-domain'; There are many things you can configure per (text)domain. This is not only related to translations, but also -for instance- for text formatting configuration. The administration for the configuration is managed in this package. Extends L<"DESCRIPTION" in Log::Report::Minimal::Domain|Log::Report::Minimal::Domain/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Minimal::Domain|Log::Report::Minimal::Domain/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Minimal::Domain|Log::Report::Minimal::Domain/"Constructors">. =over 4 =item Log::Report::Domain-EB(%options) Create a new Domain object. -Option--Defined in --Default name Log::Report::Minimal::Domain =over 2 =item name => STRING =back =back =head2 Attributes Extends L<"Attributes" in Log::Report::Minimal::Domain|Log::Report::Minimal::Domain/"Attributes">. =over 4 =item $obj-EB(%options) The import is automatically called when the package is compiled. For all but one packages in your distribution, it will only contain the name of the DOMAIN. For one package, it will contain configuration information. These %options are used for all packages which use the same DOMAIN. See chapter L below. -Option --Defined in --Default config undef context_rules undef formatter PRINTI native_language 'en_US' translator created internally where Log::Report::Minimal::Domain =over 2 =item config => FILENAME Read the settings from the file. The parameters found in the file are used as default for the parameters above. This parameter is especially useful for the C, which need to be shared between the running application and F. See L =item context_rules => HASH|OBJECT When rules are provided, the translator will use the C fields as provided by PO-files (gettext). This parameter is used to initialize a L helper object. =item formatter => CODE|HASH|'PRINTI' Selects the formatter used for the errors messages. The default is C, which will use L: interpolation with curly braces around the variable names. =item native_language => CODESET This is the language which you have used to write the translatable and the non-translatable messages in. In case no translation is needed, you still wish the system error messages to be in the same language as the report. Of course, each textdomain can define its own. =item translator => L|HASH Set the object which will do the translations for this domain. =item where => ARRAY =back =item $obj-EB() =item $obj-EB() Returns the current default translation context settings as HASH. You should not modify the content of that HASH: change it by called L or L. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() =item $obj-EB($filename) =item Log::Report::Domain-EB($filename) Helper method, which simply parses the content $filename into a HASH to be used as parameters to L. The filename must end on '.pl', to indicate that it uses perl syntax (can be processed with Perl's C command) or end on '.json'. See also chapter L below. Currently, this file can be in Perl native format (when ending on C<.pl>) or JSON (when it ends with C<.json>). Various modules may explain parts of what can be found in these files, for instance L. =item $obj-EB(STRING|HASH|ARRAY|PAIRS) Temporary set the default translation context for messages. This is used when the message is created without a C<_context> parameter. The context can be retrieved with L. Contexts are totally ignored then there are no C. When you do not wish to change settings, you may simply provide a HASH. example: use Log::Report 'my-domain', context_rules => {}; =item $obj-EB() =item $obj-EB(STRING|HASH|ARRAY|PAIRS) [1.10] Make changes and additions to the active context (see L). =back =head2 Action Extends L<"Action" in Log::Report::Minimal::Domain|Log::Report::Minimal::Domain/"Action">. =over 4 =item $obj-EB( $msgid, [$args] ) Inherited, see L =item $obj-EB($message, $language) Translate the $message into the $language. =back =head1 DETAILS =head2 Configuring Configuration of a domain can happen in many ways: either explicitly or implicitly. The explicit form: package My::Package; use Log::Report 'my-domain'; textdomain 'my-domain', %configuration; textdomain->configure(%configuration); textdomain->configure(\%configuration); textdomain->configure(conf => $filename); The implicit form is (no variables possible, only constants!) package My::Package; use Log::Report 'my-domain', %configuration; use Log::Report 'my-domain', conf => '/filename'; You can only configure your domain in one place in your program. The textdomain setup is then used for all packages in the same domain. This also works for L, which is a dressed-down version of L. =head3 configuring your own formatter [0.91] The C is a special constants for L, and will use L function C, with the standard tricks. textdomain 'some-domain' formatter => { class => 'String::Print' # default , method => 'sprinti' # default , %options # constructor options for the class ); When you want your own formatter, or configuration of C, you need to pass a CODE. Be aware that you may loose magic added by L and other layers, like L: textdomain 'some-domain', formatter => \&my_formatter; =head3 configuring global values Say, you log for a (Dancer) webserver, where you wish to include the website name in some of the log lines. For this, (ab)use the translation context: ### first, enable translation contexts use Log::Report 'my-domain', context_rules => { ... }; # or use Log::Report 'my-domain'; textdomain->configure(context_rules => { ... }); # or textdomain 'my-domain', content_rules => { ... }; ### every time you start working for a different virtual host (textdomain 'my-domain')->setContext(host => $host); ### now you can use that in your code package My::Package; use Log::Report 'my-domain'; error __x"in {_context.host} not logged-in {user}", user => $username; =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report/Dispatcher.pm0000644000175000001440000002252115000465232021333 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Dispatcher;{ our $VERSION = '1.40'; } use warnings; use strict; use Log::Report 'log-report'; use Log::Report::Util qw/parse_locale expand_reasons %reason_code escape_chars use_errno/; use POSIX qw/strerror/; use List::Util qw/sum first/; use Encode qw/find_encoding FB_DEFAULT/; use Devel::GlobalDestruction qw/in_global_destruction/; eval { POSIX->import('locale_h') }; if($@) { no strict 'refs'; *setlocale = sub { $_[1] }; *LC_ALL = sub { undef }; } my %modes = (NORMAL => 0, VERBOSE => 1, ASSERT => 2, DEBUG => 3 , 0 => 0, 1 => 1, 2 => 2, 3 => 3); my @default_accept = ('NOTICE-', 'INFO-', 'ASSERT-', 'ALL'); my %always_loc = map +($_ => 1), qw/ASSERT ALERT FAILURE PANIC/; my %predef_dispatchers = map +(uc($_) => __PACKAGE__.'::'.$_) , qw/File Perl Syslog Try Callback Log4perl/; my @skip_stack = sub { $_[0][0] =~ m/^Log\:\:Report(?:\:\:|$)/ }; sub new(@) { my ($class, $type, $name, %args) = @_; # $type is a class name or predefined name. my $backend = $predef_dispatchers{$type} ? $predef_dispatchers{$type} : $type->isa('Log::Dispatch::Output') ? __PACKAGE__.'::LogDispatch' : $type; eval "require $backend"; $@ and alert "cannot use class $backend:\n$@"; (bless {name => $name, type => $type, filters => []}, $backend) ->init(\%args); } my %format_reason = ( LOWERCASE => sub { lc $_[0] } , UPPERCASE => sub { uc $_[0] } , UCFIRST => sub { ucfirst lc $_[0] } , IGNORE => sub { '' } ); my $default_mode = 'NORMAL'; sub init($) { my ($self, $args) = @_; my $mode = $self->_set_mode(delete $args->{mode} || $default_mode); $self->{locale} = delete $args->{locale}; my $accept = delete $args->{accept} || $default_accept[$mode]; $self->{needs} = [ expand_reasons $accept ]; my $f = delete $args->{format_reason} || 'LOWERCASE'; $self->{format_reason} = ref $f eq 'CODE' ? $f : $format_reason{$f} or error __x"illegal format_reason '{format}' for dispatcher", format => $f; my $csenc; if(my $cs = delete $args->{charset}) { my $enc = find_encoding $cs or error __x"Perl does not support charset {cs}", cs => $cs; $csenc = sub { no warnings 'utf8'; $enc->encode($_[0]) }; } $self->{charset_enc} = $csenc || sub { $_[0] }; $self; } sub close() { my $self = shift; $self->{closed}++ and return undef; $self->{disabled}++; $self; } sub DESTROY { in_global_destruction or shift->close } #---------------------------- sub name {shift->{name}} sub type() {shift->{type}} sub mode() {shift->{mode}} #Please use C $MODE;> sub defaultMode($) {$default_mode = $_[1]} # only to be used via Log::Report::dispatcher(mode => ...) # because requires re-investigating collective dispatcher needs sub _set_mode($) { my $self = shift; my $mode = $self->{mode} = $modes{$_[0]}; defined $mode or panic "unknown run mode $_[0]"; $self->{needs} = [ expand_reasons $default_accept[$mode] ]; trace __x"switching to run mode {mode} for {pkg}, accept {accept}" , mode => $mode, pkg => ref $self, accept => $default_accept[$mode] unless $self->isa('Log::Report::Dispatcher::Try'); $mode; } # only to be called from Log::Report::dispatcher()!! # because requires re-investigating needs sub _disabled($) { my $self = shift; @_ ? ($self->{disabled} = shift) : $self->{disabled}; } sub isDisabled() {shift->{disabled}} sub needs(;$) { my $self = shift; return () if $self->{disabled}; my $needs = $self->{needs}; @_ or return @$needs; my $need = shift; first {$need eq $_} @$needs; } #----------- sub log($$$$) { panic "method log() must be extended per back-end"; } sub translate($$$) { my ($self, $opts, $reason, $msg) = @_; my $mode = $self->{mode}; my $code = $reason_code{$reason} or panic "unknown reason '$reason'"; my $show_loc = $always_loc{$reason} || ($mode==2 && $code >= $reason_code{WARNING}) || ($mode==3 && $code >= $reason_code{MISTAKE}); my $show_stack = $reason eq 'PANIC' || ($mode==2 && $code >= $reason_code{ALERT}) || ($mode==3 && $code >= $reason_code{ERROR}); my $locale = defined $msg->msgid ? ($opts->{locale} || $self->{locale}) # translate whole : (textdomain $msg->domain)->nativeLanguage; my $oldloc = setlocale(&LC_ALL) // ""; setlocale(&LC_ALL, $locale) if $locale && $locale ne $oldloc; my $r = $self->{format_reason}->((__$reason)->toString); my $e = use_errno($reason) ? strerror($opts->{errno} || 1) : undef; my $format = $r && $e ? N__"{reason}: {message}; {error}" : $r ? N__"{reason}: {message}" : $e ? N__"{message}; {error}" : undef; my $text = ( defined $format ? __x($format, message => $msg->toString , reason => $r, error => $e) : $msg )->toString; $text =~ s/\n*\z/\n/; if($show_loc) { if(my $loc = $opts->{location} || $self->collectLocation) { my ($pkg, $fn, $line, $sub) = @$loc; # pkg and sub are missing when decoded by ::Die $text .= " " . __x( 'at {filename} line {line}' , filename => $fn, line => $line)->toString . "\n"; } } if($show_stack) { my $stack = $opts->{stack} ||= $self->collectStack; foreach (@$stack) { $text .= $_->[0] . " " . __x( 'at {filename} line {line}' , filename => $_->[1], line => $_->[2] )->toString . "\n"; } } setlocale(&LC_ALL, $oldloc) if $locale && $locale ne $oldloc; $self->{charset_enc}->($text); } sub collectStack($) { my ($thing, $max) = @_; my $nest = $thing->skipStack; # special trick by Perl for Carp::Heavy: adds @DB::args { package DB; # non-blank before package to avoid problem with OODoc my @stack; while(!defined $max || $max--) { my ($pkg, $fn, $linenr, $sub) = caller $nest++; defined $pkg or last; my $line = $thing->stackTraceLine(call => $sub, params => \@DB::args); push @stack, [$line, $fn, $linenr]; } \@stack; } } sub addSkipStack(@) { my $thing = shift; push @skip_stack, @_; $thing; } sub skipStack() { my $thing = shift; my $nest = 1; my $args; do { $args = [caller ++$nest] } while @$args && first {$_->($args)} @skip_stack; # do not count my own stack level in! @$args ? $nest-1 : 1; } sub collectLocation() { [caller shift->skipStack] } sub stackTraceLine(@) { my ($thing, %args) = @_; my $max = $args{max_line} ||= 500; my $abstract = $args{abstract} || 1; my $maxparams = $args{max_params} || 8; my @params = @{$args{params}}; my $call = $args{call}; my $obj = ref $params[0] && $call =~ m/^(.*\:\:)/ && UNIVERSAL::isa($params[0], $1) ? shift @params : undef; my $listtail = ''; if(@params > $maxparams) { $listtail = ', [' . (@params-$maxparams) . ' more]'; $#params = $maxparams -1; } $max -= @params * 2 - length($listtail); # \( ( \,[ ] ){n-1} \) my $calling = $thing->stackTraceCall(\%args, $abstract, $call, $obj); my @out = map $thing->stackTraceParam(\%args, $abstract, $_), @params; my $total = sum map {length $_} $calling, @out; ATTEMPT: while($total <= $max) { $abstract++; last if $abstract > 2; # later more levels foreach my $p (reverse 0..$#out) { my $old = $out[$p]; $out[$p] = $thing->stackTraceParam(\%args, $abstract, $params[$p]); $total -= length($old) - length($out[$p]); last ATTEMPT if $total <= $max; } my $old = $calling; $calling = $thing->stackTraceCall(\%args, $abstract, $call, $obj); $total -= length($old) - length($calling); } $calling .'(' . join(', ',@out) . $listtail . ')'; } # 1: My::Object(0x123141, "my string") # 2: My::Object=HASH(0x1231451) # 3: My::Object("my string") # 4: My::Object() # sub stackTraceCall($$$;$) { my ($thing, $args, $abstract, $call, $obj) = @_; if(defined $obj) # object oriented { my ($pkg, $method) = $call =~ m/^(.*\:\:)(.*)/; return overload::StrVal($obj) . '->' . $call; } else # imperative { return $call; } } sub stackTraceParam($$$) { my ($thing, $args, $abstract, $param) = @_; defined $param or return 'undef'; $param = overload::StrVal($param) if ref $param; return $param # int or float if $param =~ /^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[eE][+-]?\d+)?$/; my $escaped = escape_chars $param; if(length $escaped > 80) { $escaped = substr($escaped, 0, 30) . '...['. (length($escaped) -80) .' chars more]...' . substr($escaped, -30); } qq{"$escaped"}; } #------------ 1; Log-Report-1.40/lib/Log/Report/Translator.pm0000644000175000001440000000162415000465232021377 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Translator;{ our $VERSION = '1.40'; } use warnings; use strict; use Log::Report 'log-report'; sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) } sub init($) { shift } #------------ #------------ # this is called as last resort: if a translator cannot find # any lexicon or has no matching language. sub translate($$$) { my $msg = $_[1]; defined $msg->{_count} && $msg->{_count} != 1 ? $msg->{_plural} : $msg->{_msgid}; } sub load($@) { undef } 1; Log-Report-1.40/lib/Log/Report/Die.pod0000644000175000001440000000514515000465233020120 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Die - compatibility routines with Perl's die/croak/confess =head1 INHERITANCE Log::Report::Die is an Exporter =head1 SYNOPSIS # use internally only =head1 DESCRIPTION This module is used internally, to translate output of 'die' and Carp functions into L objects. Also, it tries to convert other kinds of exception frameworks into our message object. =head1 FUNCTIONS =over 4 =item B(STRING, %options) The STRING is the content of C<$@> after an eval() caught a die(). croak(), or confess(). This routine tries to convert this into parameters for L. This is done in a very smart way, even trying to find the stringifications of C<$!>. Returned are four elements: the error string or object which triggered the death originally (the original $@), and the opts, reason, and plain text message. The opts is a HASH which, amongst other things, may contain a stack trace and location extracted from the death text or object. Translated components will have exception classes C, and C or C. On the moment, the C cannot be distiguished from the C (when used in package main) or C (otherwise). The returned reason depends on whether the translation of the current C<$!> is found in the STRING, and the presence of a stack trace. The following table is used: errstr stack => reason no no ERROR (die) application internal problem yes no FAULT (die) external problem, think open() no yes PANIC (confess) implementation error yes yes ALERT (confess) external problem, caught -Option--Default on_die 'ERROR' =over 2 =item on_die => REASON =back =item B($exception, %options) [1.23] This function attempts to translate object of other exception frameworks into information to create a L. It returns the same list of parameters as L does. Currently supported: =over 4 =item * DBIx::Class::Exception =item * XML::LibXML::Error =back =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report/Exception.pm0000644000175000001440000000445615000465232021212 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Exception;{ our $VERSION = '1.40'; } use warnings; use strict; use Log::Report 'log-report'; use Log::Report::Util qw/is_fatal to_html/; use POSIX qw/locale_h/; use Scalar::Util qw/blessed/; use overload '""' => 'toString' , 'bool' => sub {1} # avoid accidental serialization of message , fallback => 1; sub new($@) { my ($class, %args) = @_; $args{report_opts} ||= {}; bless \%args, $class; } #---------------- sub report_opts() {shift->{report_opts}} sub reason(;$) { my $self = shift; @_ ? $self->{reason} = uc(shift) : $self->{reason}; } sub isFatal() { my $self = shift; my $opts = $self->report_opts; exists $opts->{is_fatal} ? $opts->{is_fatal} : is_fatal $self->{reason}; } sub message(;$) { my $self = shift; @_ or return $self->{message}; my $msg = shift; blessed $msg && $msg->isa('Log::Report::Message') or panic "message() of exception expects Log::Report::Message"; $self->{message} = $msg; } #---------------- sub inClass($) { $_[0]->message->inClass($_[1]) } sub throw(@) { my $self = shift; my $opts = @_ ? { %{$self->{report_opts}}, @_ } : $self->{report_opts}; my $reason; if($reason = delete $opts->{reason}) { $self->{reason} = $reason; $opts->{is_fatal} = is_fatal $reason unless exists $opts->{is_fatal}; } else { $reason = $self->{reason}; } $opts->{stack} ||= Log::Report::Dispatcher->collectStack; report $opts, $reason, $self; } # where the throw is handled is not interesting sub PROPAGATE($$) {shift} sub toString(;$) { my ($self, $locale) = @_; my $msg = $self->message; lc($self->{reason}).': '.(ref $msg ? $msg->toString($locale) : $msg)."\n"; } sub toHTML(;$) { to_html($_[0]->toString($_[1])) } sub print(;$) { my $self = shift; (shift || *STDERR)->print($self->toString); } 1; Log-Report-1.40/lib/Log/Report/Message.pm0000644000175000001440000001154715000465232020637 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Message;{ our $VERSION = '1.40'; } use warnings; use strict; use Log::Report 'log-report'; use POSIX qw/locale_h/; use List::Util qw/first/; use Scalar::Util qw/blessed/; use Log::Report::Util qw/to_html/; # Work-around for missing LC_MESSAGES on old Perls and Windows { no warnings; eval "&LC_MESSAGES"; *LC_MESSAGES = sub(){5} if $@; } use overload '""' => 'toString' , '&{}' => sub { my $obj = shift; sub{$obj->clone(@_)} } , '.' => 'concat' , fallback => 1; sub new($@) { my ($class, %s) = @_; if(ref $s{_count}) { my $c = $s{_count}; $s{_count} = ref $c eq 'ARRAY' ? @$c : keys %$c; } defined $s{_join} or $s{_join} = $"; if($s{_msgid}) { $s{_append} = defined $s{_append} ? $1.$s{_append} : $1 if $s{_msgid} =~ s/(\s+)$//s; $s{_prepend}.= $1 if $s{_msgid} =~ s/^(\s+)//s; } if($s{_plural}) { s/\s+$//, s/^\s+// for $s{_plural}; } bless \%s, $class; } # internal use only: to simplify __*p* functions sub _msgctxt($) {$_[0]->{_msgctxt} = $_[1]; $_[0]} sub clone(@) { my $self = shift; (ref $self)->new(%$self, @_); } sub fromTemplateToolkit($$;@) { my ($class, $domain, $msgid) = splice @_, 0, 3; my $plural = $msgid =~ s/\|(.*)// ? $1 : undef; my $args = @_ && ref $_[-1] eq 'HASH' ? pop : {}; my $count; if(defined $plural) { @_==1 or $msgid .= " (ERROR: missing count for plural)"; $count = shift || 0; $count = @$count if ref $count eq 'ARRAY'; } else { @_==0 or $msgid .= " (ERROR: only named parameters expected)"; } $class->new ( _msgid => $msgid, _plural => $plural, _count => $count , %$args, _expand => 1, _domain => $domain); } #---------------- sub prepend() { $_[0]->{_prepend}} sub msgid() { $_[0]->{_msgid} } sub append() { $_[0]->{_append} } sub domain() { $_[0]->{_domain} } sub count() { $_[0]->{_count} } sub context() { $_[0]->{_context}} sub msgctxt() { $_[0]->{_msgctxt}} sub classes() { my $class = $_[0]->{_class} || $_[0]->{_classes} || []; ref $class ? @$class : split(/[\s,]+/, $class); } sub to(;$) { my $self = shift; @_ ? $self->{_to} = shift : $self->{_to}; } sub errno(;$) { my $self = shift; @_ ? $self->{_errno} = shift : $self->{_errno}; } sub valueOf($) { $_[0]->{$_[1]} } #-------------- sub inClass($) { my @classes = shift->classes; ref $_[0] eq 'Regexp' ? (first { $_ =~ $_[0] } @classes) : (first { $_ eq $_[0] } @classes); } sub toString(;$) { my ($self, $locale) = @_; my $count = $self->{_count} || 0; $locale = $self->{_lang} if $self->{_lang}; my $prepend = $self->{_prepend} // ''; my $append = $self->{_append} // ''; $prepend = $prepend->isa(__PACKAGE__) ? $prepend->toString($locale) : "$prepend" if blessed $prepend; $append = $append->isa(__PACKAGE__) ? $append->toString($locale) : "$append" if blessed $append; $self->{_msgid} # no translation, constant string or return "$prepend$append"; # assumed is that switching locales is expensive my $oldloc = setlocale(LC_MESSAGES); setlocale(LC_MESSAGES, $locale) if defined $locale && (!defined $oldloc || $locale ne $oldloc); # translate the msgid my $domain = $self->{_domain}; $domain = textdomain $domain unless blessed $domain && $domain->isa('Log::Report::Minimal::Domain'); my $format = $domain->translate($self, $locale || $oldloc); defined $format or return (); # fill-in the fields my $text = $self->{_expand} ? $domain->interpolate($format, $self) : "$prepend$format$append"; setlocale(LC_MESSAGES, $oldloc) if defined $oldloc && (!defined $locale || $oldloc ne $locale); $text; } my %tohtml = qw/ > gt < lt " quot & amp /; sub toHTML(;$) { to_html($_[0]->toString($_[1])) } sub untranslated() { my $self = shift; (defined $self->{_prepend} ? $self->{_prepend} : '') . (defined $self->{_msgid} ? $self->{_msgid} : '') . (defined $self->{_append} ? $self->{_append} : ''); } sub concat($;$) { my ($self, $what, $reversed) = @_; if($reversed) { $what .= $self->{_prepend} if defined $self->{_prepend}; return ref($self)->new(%$self, _prepend => $what); } $what = $self->{_append} . $what if defined $self->{_append}; ref($self)->new(%$self, _append => $what); } #---------------- 1; Log-Report-1.40/lib/Log/Report/Domain.pm0000644000175000001440000001041515000465232020453 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Domain;{ our $VERSION = '1.40'; } use base 'Log::Report::Minimal::Domain'; use warnings; use strict; use Log::Report 'log-report'; use Log::Report::Util qw/parse_locale/; use Scalar::Util qw/blessed/; use Log::Report::Translator; sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $self->{LRD_ctxt_def} = {}; $self; } #---------------- sub nativeLanguage() {shift->{LRD_native}} sub translator() {shift->{LRD_transl}} sub contextRules() {shift->{LRD_ctxt_rules}} #---------------- sub configure(%) { my ($self, %args) = @_; if(my $config = delete $args{config}) { my $set = $self->readConfig($config); %args = (%$set, %args); } # 'formatter' is mainly handled by the base-class, but documented here. my $format = $args{formatter} || 'PRINTI'; $args{formatter} = $format = {} if $format eq 'PRINTI'; if(ref $format eq 'HASH') { $format->{missing_key} = sub { $self->_reportMissingKey(@_) }; } $self->SUPER::configure(%args); my $transl = $args{translator} || Log::Report::Translator->new; $transl = Log::Report::Translator->new(%$transl) if ref $transl eq 'HASH'; !blessed $transl || $transl->isa('Log::Report::Translator') or panic "translator must be a Log::Report::Translator object"; $self->{LRD_transl} = $transl; my $native = $self->{LRD_native} = $args{native_language} || 'en_US'; my ($lang) = parse_locale $native; defined $lang or error __x"the native_language '{locale}' is not a valid locale", locale => $native; if(my $cr = $args{context_rules}) { my $tc = 'Log::Report::Translator::Context'; eval "require $tc"; panic $@ if $@; if(blessed $cr) { $cr->isa($tc) or panic "context_rules must be a $tc" } elsif(ref $cr eq 'HASH') { $cr = Log::Report::Translator::Context->new(rules => $cr) } else { panic "context_rules expects object or hash, not {have}", have=>$cr } $self->{LRD_ctxt_rules} = $cr; } $self; } sub _reportMissingKey($$) { my ($self, $sp, $key, $args) = @_; warning __x"Missing key '{key}' in format '{format}', file {use}", key => $key, format => $args->{_format}, use => $args->{_use}; undef; } sub setContext(@) { my $self = shift; my $cr = $self->contextRules # ignore context if no rules given or error __x"you need to configure context_rules before setContext"; $self->{LRD_ctxt_def} = $cr->needDecode(set => @_); } sub updateContext(@) { my $self = shift; my $cr = $self->contextRules # ignore context if no rules given or return; my $rules = $cr->needDecode(update => @_); my $r = $self->{LRD_ctxt_def} ||= {}; @{$r}{keys %$r} = values %$r; $r; } sub defaultContext() { shift->{LRD_ctxt_def} } sub readConfig($) { my ($self, $fn) = @_; my $config; if($fn =~ m/\.pl$/i) { $config = do $fn; } elsif($fn =~ m/\.json$/i) { eval "require JSON"; panic $@ if $@; open my($fh), '<:encoding(utf8)', $fn or fault __x"cannot open JSON file for context at {fn}" , fn => $fn; local $/; $config = JSON->utf8->decode(<$fh>); } else { error __x"unsupported context file type for {fn}", fn => $fn; } $config; } #------------------- sub translate($$) { my ($self, $msg, $lang) = @_; my $tr = $self->translator || $self->configure->translator; my $msgid = $msg->msgid; # fast route when certainly no context is involved return $tr->translate($msg, $lang) || $msgid if index($msgid, '<') == -1; my $msgctxt; if($msgctxt = $msg->msgctxt) { # msgctxt in traditional gettext style } elsif(my $rules = $self->contextRules) { ($msgid, $msgctxt) = $rules->ctxtFor($msg, $lang, $self->defaultContext); } else { 1 while $msgid =~ s/\{([^}]*)\<\w+([^}]*)\}/length "$1$2" ? "{$1$2}" : ''/e; } # This is ugly, horrible and worse... but I do not want to mutulate # the message neither to clone it for performance. We do need to get # rit of {<} local $msg->{_msgid} = $msgid; $tr->translate($msg, $lang, $msgctxt) || $msgid; } 1; __END__ Log-Report-1.40/lib/Log/Report/Exception.pod0000644000175000001440000000756515000465233021365 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Exception - a collected report =head1 SYNOPSIS # created within a try block try { error "help!" }; my $exception = $@->wasFatal; $exception->throw if $exception; $@->reportFatal; # combination of above two lines my $message = $exception->message; # the Log::Report::Message if($message->inClass('die')) ... if($exception->inClass('die')) ... # same if($@->wasFatal(class => 'die')) ... # same =head1 DESCRIPTION In Log::Report, exceptions are not as extended as available in languages as Java: you do not create classes for them. The only thing an exception object does, is capture some information about an (untranslated) report. =head1 METHODS =head2 Constructors =over 4 =item Log::Report::Exception-EB(%options) -Option --Default message reason report_opts {} =over 2 =item message => Log::Report::Message =item reason => REASON =item report_opts => HASH =back =back =head2 Accessors =over 4 =item $obj-EB() Returns whether this exception has a severity which makes it fatal when thrown. [1.34] This can have been overruled with the C attribute. See L. example: if($ex->isFatal) { $ex->throw(reason => 'ALERT') } else { $ex->throw } =item $obj-EB( [$message] ) Change the $message of the exception, must be a L object. When you use a C object, you will get a new one returned. Therefore, if you want to modify the message in an exception, you have to re-assign the result of the modification. example: $e->message->concat('!!')); # will not work! $e->message($e->message->concat('!!')); $e->message(__x"some message {msg}", msg => $xyz); =item $obj-EB( [$reason] ) =item $obj-EB() =back =head2 Processing =over 4 =item $obj-EB($class|Regexp) Check whether any of the classes listed in the message match $class (string) or the Regexp. This uses L. =item $obj-EB( [$fh] ) The default filehandle is STDOUT. example: print $exception; # via overloading $exception->print; # OO style =item $obj-EB(%options) Insert the message contained in the exception into the currently defined dispatchers. The C name is commonly known exception related terminology for C. The %options overrule the captured options to L. This can be used to overrule a destination. Also, the reason can be changed. example: overrule defaults to report try { report {to => 'stderr'}, ERROR => 'oops!' }; $@->reportFatal(to => 'syslog'); $exception->throw(to => 'syslog'); $@->wasFatal->throw(reason => 'WARNING'); =item $obj-EB( [$locale] ) [1.11] as L, and escape HTML volatile characters. =item $obj-EB( [$locale] ) Prints the reason and the message. Differently from L, this only represents the textual content: it does not re-cast the exceptions to higher levels. example: printing exceptions print $_->toString for $@->exceptions; print $_ for $@->exceptions; # via overloading =back =head1 OVERLOADING =over 4 =item overload: B Produces "reason: message". =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report.pod0000644000175000001440000012473315000465233017424 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report - report a problem, with exceptions and translation support =head1 INHERITANCE Log::Report is an Exporter =head1 SYNOPSIS # Invocation with 'mode' to get trace and verbose messages use Log::Report mode => 'DEBUG'; # Usually invoked with a domain, which groups packages for translation use Log::Report 'my-domain', %options; # Interpolation syntax via String::Print # First step to translations, once you need it. print __x"my name is {name}", name => $n; # print, so no exception print __"Hello World\n"; # no interpolation, optional translation print __x'Hello World'; # SYNTAX ERROR!! ' is alternative for :: # Functions replacing die/warn/carp, casting exceptions. error "oops"; # exception like die(), no translation -f $config or panic "Help!"; # alert/error/fault/info/...more # Combined exception, interpolation, and optional translation error __x"Help!"; # __x() creates ::Message object error __x('gettext msgid', param => $value, ...) if $condition; # Also non fatal "exceptions" find their way to dispatchers info __x"started {pid}", pid => $$; # translatable debug "$i was here!"; # you probably do not want to translate debug panic "arrghhh"; # like Carp::Confess # Many destinations for an exception message (may exist in parallel) dispatcher PERL => 'default' # see Log::Report::Dispatcher: use die/warn , reasons => 'NOTICE-'; # this dispatcher is already present at start dispatcher SYSLOG => 'syslog'# also send to syslog , charset => 'iso-8859-1' # explicit character conversions , locale => 'en_US'; # overrule user's locale dispatcher close => 'default'; # stop default die/warn dispatcher # Fill-in values, like Locale::TextDomain and gettext # See Log::Report::Message section DETAILS fault __x"cannot allocate {size} bytes", size => $size; fault "cannot allocate $size bytes"; # no translation, ok fault __x"cannot allocate $size bytes"; # not translatable, wrong # Translation depending on count # Leading and trailing whitespace stay magically outside translation # tables. @files in scalar context. Special parameter with _ print __xn"found one file\n", "found {_count} files", @files; # Borrow from an other text-domain (see Log::Report::Message) print __x(+"errors in {line}", _domain => 'global', line => $line); # catch errors (implements hidden eval/die) try { error }; if($@) {...} # $@ isa Log::Report::Dispatcher::Try if(my $exception = $@->wasFatal) # ::Exception object # Language translations at the output component # Translation management via Log::Report::Lexicon use POSIX::1003::Locale qw/setlocale LC_ALL/; setlocale(LC_ALL, 'nl_NL'); info __"Hello World!"; # in Dutch, if translation table found # Exception classes, see Log::Report::Exception try { error __x"something", _class => 'parsing,schema' }; if($@->wasFatal->inClass('parsing')) ... =head1 DESCRIPTION Get messages to users and logs. C combines three tasks which are closely related in one: =over 4 =item . logging (like L and syslog), and =item . exceptions (like error and info), with =item . translations (like C and L) =back You B to use this module for all three reasons: pick what you need now, maybe extend the usage later. Read more about how and why in the L section, below. Especially, you should B. Also, you can study this module swiftly via the article published in the German Perl C<$foo-magazine>. English version: F =head1 FUNCTIONS =head2 Report Production and Configuration =over 4 =item B( <$type, $name, %options>|<$command, @names> ) The C function controls access to dispatchers: the back-ends which process messages, do the logging. Dispatchers are global entities, addressed by a symbolic $name. Please read L as well. The C suite has its own dispatcher @types, but also connects to external dispatching frameworks. Each need some (minor) conversions, especially with respect to translation of REASONS of the reports into log-levels as the back-end understands. [1.10] When you open a dispatcher with a $name which is already in use, that existing dispatcher gets closed. Except when you have given an 'dispatcher "do-not-reopen"' earlier, in which case the first object stays alive, and the second attempt ignored. [1.11] The automatically created default dispatcher will get replaced, even when this option is given, by another dispatcher which is named 'default'. The %options are a mixture of parameters needed for the Log::Report dispatcher wrapper and the settings of the back-end. See L, the documentation for the back-end specific wrappers, and the back-ends for more details. Implemented COMMANDs are C, C, C, C, C, C, C, C, C, and C. Most commands are followed by a LIST of dispatcher @names to be addressed. For C see section L; it requires a MODE argument before the LIST of NAMEs. Non-existing names will be ignored. When C is specified, then all existing dispatchers will get addressed. For C see L; it requires a CODE reference before the @names of the dispatchers which will have the it applied (defaults to all). With C, you only provide a REASON: it will return the list of dispatchers which need to be called in case of a message with the REASON is triggered. The C [1.09] returns the closest surrounding exception catcher, a L object. For both the creation as COMMANDs version of this method, all objects involved are returned as LIST, non-existing ones skipped. In SCALAR context with only one name, the one object is returned. example: play with dispatchers dispatcher Log::Dispatcher::File => mylog => , accept => 'MISTAKE-' # for wrapper , locale => 'pt_BR' # other language , filename => 'logfile'; # for back-end dispatcher close => 'mylog'; # cleanup my $obj = dispatcher find => 'mylog'; my @obj = dispatcher 'list'; dispatcher disable => 'syslog'; dispatcher enable => 'mylog', 'syslog'; # more at a time dispatcher mode => 'DEBUG', 'mylog'; dispatcher mode => 'DEBUG', 'ALL'; my $catcher = dispatcher 'active-try'; dispatcher 'do-not-reopen'; my @need_info = dispatcher needs => 'INFO'; if(dispatcher needs => 'INFO') ... # anyone needs INFO # Getopt::Long integration: see Log::Report::Dispatcher::mode() dispatcher PERL => 'default', mode => 'DEBUG', accept => 'ALL' if $debug; =item B( [%options], $reason, $message|, ) The C function is sending (for some $reason) a $message to be displayed or logged (by a `dispatcher'). This function is the core for L, L etc functions, which are nicer names for this exception throwing: better use those short names. The $reason is a string like 'ERROR' (for function C). The $message is a L object (which are created with the special translation syntax like L<__x()|Log::Report/"Messages (optionally translatable)">). The $message may also be a plain string, or an L object. The optional first parameter is a HASH which can be used to influence the dispatchers. The optional %options are listed below. Quite differently from other functions and methods, they have to be passed in a HASH as first parameter. This function returns the LIST of dispatchers which accepted the $message. When empty, no back-end has accepted it so the $message was "lost". Even when no back-end needs the message, the program will still exit when there is a $reason to C. -Option --Default errno $! or 1 is_fatal locale undef location undef stack undef to undef =over 2 =item errno => INTEGER When the $reason includes the error text (See L), you can overrule the error code kept in C<$!>. In other cases, the return code defaults to C<1> (historical UNIX behavior). When the message $reason (combined with the run-mode) is severe enough to stop the program, this value as return code of the program. The use of this option itself will not trigger an C. =item is_fatal => BOOLEAN Some logged exceptions are fatal, other aren't. The default usually is correct. However, you may want an error to be caught (usually with L), redispatch it to syslog, but without it killing the main program. =item locale => LOCALE Use this specific locale, in stead of the user's preference. =item location => STRING When defined, this location is used in the display. Otherwise, it is determined automatically if needed. An empty string will disable any attempt to display this line. =item stack => ARRAY When defined, that data is used to display the call stack. Otherwise, it is collected via C if needed. =item to => NAME|ARRAY-of-NAMEs Sent the $message only to the NAMEd dispatchers. Ignore unknown NAMEs. Still, the dispatcher needs to be enabled and accept the REASONs. =back example: for use of L # long syntax example report TRACE => "start processing now"; report INFO => '500: ' . __'Internal Server Error'; # explicit dispatcher, no translation report {to => 'syslog'}, NOTICE => "started process $$"; notice "started process $$", _to => 'syslog'; # same # short syntax examples trace "start processing now"; warning __x'Disk {percent%.2f}% full', percent => $p if $p > 97; # error message, overruled to be printed in Brazilian report {locale => 'pt_BR'} , WARNING => "do this at home!"; =item B(CODE, %options) Execute the CODE while blocking all dispatchers as long as it is running. The exceptions which occur while running the CODE are caught until it has finished. When there where no fatal errors, the result of the CODE execution is returned. After the CODE was tried, the C<$@> will contain a L object, which contains the collected messages. Read that manual page to understand C. Run-time errors from Perl and die's, croak's and confess's within the program (which shouldn't appear, but you never know) are collected into an L object, using L. The %options are passed to the constructor of the try-dispatcher, see L. For instance, you may like to add C<< mode => 'DEBUG' >>, or C<< accept => 'ERROR-' >>. B that the parameter to C is a CODE reference. This means that you shall not use a comma after the block when there are %options specified. On the other hand, you shall use a semi-colon after the block if there are no arguments. B that the {} are interpreted as subroutine, which means that, for instance, it has its own C<@_>. The manual-page of Try::Tiny lists a few more side-effects of this. example: my $x = try { 3/$x }; # mind the ';' !! if($@) { # signals something went wrong if(try {...}) { # block ended normally, returns bool try { ... } # no comma!! mode => 'DEBUG', accept => 'ERROR-'; try sub { ... }, # with comma, also \&function mode => 'DEBUG', accept => 'ALL'; my $response = try { $ua->request($request) }; if(my $e = $@->wasFatal) ... =back =head2 Abbreviations for report() The following functions are all wrappers for calls to L, and available when "syntax is SHORT" (by default, see L). You cannot specify additional options to influence the behavior of C, which are usually not needed anyway. =over 4 =item B($message) Short for C<< report ALERT => $message >> =item B($message) Short for C<< report ASSERT => $message >> =item B($message) Short for C<< report ERROR => $message >> =item B($message) Short for C<< report FAILURE => $message >> =item B($message) Short for C<< report FAULT => $message >> =item B($message) Short for C<< report INFO => $message >> =item B($message) Short for C<< report MISTAKE => $message >> =item B($message) Short for C<< report NOTICE => $message >> =item B($message) Short for C<< report PANIC => $message >> =item B($message) Short for C<< report TRACE => $message >> =item B($message) Short for C<< report WARNING => $message >> =back =head2 Messages (optionally translatable) Even when you do not support translations (yet) you may want to use message objects to improve the logging feature. For instance, you get very powerful interpolation from L. The language translations are initiate by limited set of functions which contain B (C<__>) in their name. Most of them return a L object. B that -in general- its considered very bad practice to combine multiple translations into one message: translating may also affect the order of the translated components. Besides, when the person which translates only sees smaller parts of the text, his (or her) job becomes more complex. So: print __"Hello" . ', ' . __"World!"; # works, but to be avoided print __"Hello, World!"; # preferred, complete sentence The the former case, tricks with overloading used by the L objects will still make delayed translations work. In normal situations, it is not a problem to translate interpolated values: print __"the color is {c}", c => __"red"; B that using C<< __'Hello' >> will produce a syntax error like "String found where operator expected at .... Can't find string terminator "'" anywhere before EOF". The first quote is the cause of the complaint, but the second generates the error. In the early days of Perl, the single quote was used to separate package name from function name, a role which was later replaced by a double-colon. So C<< __'Hello' >> gets interpreted as C<< __::Hello ' >>. Then, there is a trailing single quote which has no counterpart. =over 4 =item B($msgid) Label to indicate that the string is a text which will be translated later. The function itself does nothing. See also L. This no-op function is used as label to the xgettext program to build the translation tables. example: how to use N__() # add three msgids to the translation table my @colors = (N__"red", N__"green", N__"blue"); my @colors = N__w "red green blue"; # same print __ $colors[1]; # translate green # using __(), would work as well my @colors = (__"red", __"green", __"blue"); print $colors[1]; # however: this will always create all Log::Report::Message objects, # where maybe only one is used. =item B($single_msgid, $plural_msgid) Label to indicate that the two MSGIDs are related, the first as single, the seconds as its plural. Only used to find the text fragments to be translated. The function itself does nothing. example: how to use L my @save = N__n "save file", "save files"; my @save = (N__n "save file", "save files"); my @save = N__n("save file", "save files"); # be warned about SCALARs in prototype! print __n @save, $nr_files; # wrong! print __n $save[0], $save[1], @files, %vars; =item B(STRING) This extension to the Locale::TextDomain syntax, is a combined C (list of quoted words) and L into a list of translatable words. example: of L my @colors = (N__"red", N__"green", N__"blue"); my @colors = N__w"red green blue"; # same print __ $colors[1]; =item B<__>($msgid) This function (name is B under-score characters) will cause the $msgid to be replaced by the translations when doing the actual output. Returned is a L object, which will be used in translation later. Translating is invoked when the object gets stringified. When you have no translation tables, the $msgid will be shown untranslated. If you need options for L then use L<__x()|Log::Report/"Messages (optionally translatable)">; the prototype of this function does not permit parameters: it is a prefix operator! example: how to use __() print __"Hello World"; # translated into user's language print __'Hello World'; # syntax error! print __('Hello World'); # ok, translated print __"Hello", " World"; # World not translated my $s = __"Hello World"; # creates object, not yet translated print ref $s; # Log::Report::Message print $s; # ok, translated print $s->toString('fr'); # ok, forced into French =item B<__n>($msgid, $plural_msgid, $count, PAIRS) It depends on the value of $count (and the selected language) which text will be displayed. When translations can not be performed, then $msgid will be used when $count is 1, and PLURAL_MSGSID in other cases. However, some languages have more complex schemes than English. The PAIRS are options for L and variables to be filled in. example: how to use __n() print __n "one", "more", $a; print __n("one", "more", $a), "\n"; print +(__n "one", "more", $a), "\n"; # new-lines are ignore at lookup, but printed. print __n "one\n", "more\n", $a; # count is in scalar context # the value is also available as _count print __n "found one\n", "found {_count}\n", @r; # ARRAYs and HASHes are counted print __n "one", "more", \@r; =item B<__nx>($msgid, $plural_msgid, $count, PAIRS) It depends on the value of $count (and the selected language) which text will be displayed. See details in L<__n()|Log::Report/"Messages (optionally translatable)">. After translation, the VARIABLES will be filled-in. The PAIRS are options for L and variables to be filled in. example: how to use __nx() print __nx "one file", "{_count} files", $nr_files; print __nx "one file", "{_count} files", @files; local $" = ', '; print __nx "one file: {f}", "{_count} files: {f}", @files, f => \@files; =item B<__x>($msgid, PAIRS) Translate the $msgid and then interpolate the VARIABLES in that string. Of course, translation and interpolation is delayed as long as possible. Both OPTIONS and VARIABLES are key-value pairs. The PAIRS are options for L and variables to be filled in. =item B<__xn>($single_msgid, $plural_msgid, $count, $paurs) Same as L<__nx()|Log::Report/"Messages (optionally translatable)">, because we have no preferred order for 'x' and 'n'. =back =head3 Messages with msgctxt In Log::Report, the message context (mgsctxt in the PO-files --in the translation tables) can be used in a very powerful way. Read all about it in L The msgctxt versions of the tranditional gettext infrastructure are far less useful for Log::Report, because we can easily work with different text domains within the same program. That should avoid most of the accidental translation conflicts between components of the code. Just for compatibility with Locale::TextDomain and completeness, the 'p' versions of above methods are supported. See examples for these functions in Locale::TextDomain. B Functions C and C seem not to be usable in reality, hence not implemented. The script xgettext-perl and L (both in the L distribution) do not yet support these functions. =over 4 =item B<__np>($msgctxt, $msgid, $plural, count) =item B<__npx>($msgctxt, $msgid, $plural, count, PAIRS) =item B<__p>($msgctxt, $msgid) =item B<__px>($msgctxt, $msgid, PAIRS) =back =head2 Configuration =over 4 =item $obj-EB( [$level,][$domain,] %options ) The import is automatically called when the package is compiled. For all packages but one in your distribution, it will only contain the name of the $domain. For one package, the import list may additionally contain textdomain configuration %options. These %options are used for all packages which use the same $domain. These are alternatives: # Do not use variables in the %*config! They are not yet initialized # when Log::Report->import is run!!! use Log::Report 'my-domain', %config, %domain_config; use Log::Report 'my-domain', %config; textdomain 'my-domain', %domain_config; # vars allowed The latter syntax has major advantages, when the configuration of the domain is determined at run-time. It is probably also easier to understand. See L, for the B for the domain configuration. Here, we only list the options which are related to the normal import behavior. The export $level is a plus (+) followed by a number, for instance C<+1>, to indicate to on which caller level we need to work. This is used in L. It defaults to '0': my direct caller. -Option --Default import undef message_class Log::Report::Message mode 'NORMAL' syntax 'SHORT' =over 2 =item import => FUNCTION|ARRAY [0.998] When not specified, the C option determines the list of functions which are being exported. With this option, the C option is ignored and only the specified FUNCTION(s) are imported. =item message_class => CLASS [1.08] Use a more powerful message object class, for instance because your messages need extra attributes. The provided CLASS must extend L =item mode => LEVEL This sets the default mode for all created dispatchers. You can also selectively change the output mode, like dispatcher PERL => 'default', mode => 3 =item syntax => 'REPORT'|'SHORT'|'LONG' The SHORT syntax will add the report abbreviations (like function L) to your name-space. Otherwise, each message must be produced with L. C is an alternative to C: both do not pollute your namespace with the useful abbrev functions. =back example: of import use Log::Report mode => 3; # '3' or 'DEBUG' use Log::Report 'my-domain'; # in each package producing messages use Log::Report 'my-domain' # in one package, top of distr , mode => 'VERBOSE' , syntax => 'REPORT' # report ERROR, not error() , translator => Log::Report::Translator::POT->new ( lexicon => '/home/mine/locale' # translation tables ) , native_language => 'nl_NL'; # untranslated msgs are Dutch use Log::Report import => 'try'; # or ARRAY of functions =item B( <[$name],$config>|<$name, 'DELETE'|'EXISTS'>|$domain ) [1.00] Without CONFIGuration, this returns the L object which administers the $domain, by default the domain effective in the scope of the package. A very special case is "DELETE", which will remove the domain configuration. [1.20] "EXISTS" will check for existence: when it exists, it will be returned, but a domain will not be automagically created. [1.20] You may also pass a pre-configured domain. =back =head2 Reasons =over 4 =item Log::Report-EB( $reason, [$reasons] ) Returns true when the reporter needs any of the $reasons, when any of the active dispatchers is collecting messages in the specified level. This is useful when the processing of data for the message is relatively expensive, but for instance only required in debug mode. example: if(Log::Report->needs('TRACE')) { my @args = ...expensive calculation...; trace "your options are: @args"; } =back =head1 DETAILS =head2 Introduction Getting messages to users and logs. The distincting concept of this module, is that three tasks which are strongly related are merged into one simple syntax. The three tasks: =over 4 =item produce some text on a certain condition, =item translate it to the proper language, and =item deliver it in some way to a user. =back Text messages in Perl are produced by commands like C, C, C, C, or C. But where is that output directed to? Translations is hard. There is no clean exception mechanism. Besides, the C/C/C together produce only three different output "levels" with a message. Think of the variation syslog offers: more than 7 levels. Many people manually implement their own tricks to get additional levels, like verbose and debug flags. Log::Report offers that variety. The (optional) translations use the beautiful syntax defined by Locale::TextDomain, with some own extensions (of course). A very important difference is that translations are delayed till the delivery step: until a dispatcher actually writes your message into a file, sends it to syslog, or shows it on the screen. This means that the pop-up in the graphical interface of the user may show the text in the language of the user --say Chinese in utf8--, but at the same time syslog may write the latin1 English version of the same message. =head2 Background ideas The following ideas are the base of this implementation: =over 4 =item . simplification Handling errors and warnings is probably the most labor-intensive task for a programmer: when programs are written correctly, up-to three-quarters of the code is related to testing, reporting, and handling (problem) conditions. Simplifying the way to create reports, simplifies programming and maintenance. =item . multiple dispatchers It is not the location where the (for instance) error occurs which determines what will happen with the text, but the main application which uses the the complaining module has control. Messages have a reason. Based on the `reason' classification, they can get ignored, send to one or multiple dispatchers, like Log::Dispatch, Log::Log4perl, or UNIX syslog. =item . delayed translations The background ideas are that of Locale::TextDomain, based on C. However, in the C infrastructure, translations are postponed until the text is dispatched to a screen or log-file; the same report can be sent to syslog in (for instance) English and to the user interface in Dutch. =item . context sensitive Using contexts, you can set-up how to translate or rewrite messages, to improve messages. A typical problem is whether to use gender in text (use 'his' or 'her'): you can set a gender in a context, and the use translation tables to pick the right one. =back =head2 Error handling models There are two approaches to handling errors and warnings. In the first approach, as produced by C, C and the C family of commands, the program handles the problem immediately on the location where the problem appears. In the second approach, an I is thrown on the spot where the problem is created, and then somewhere else in the program the condition is handled. The implementation of exceptions in Perl5 is done with a eval-die pair: on the spot where the problem occurs, C is called. But, because of the execution of that routine is placed within an C, the program as a whole will not die, just the execution of a part of the program will seize. However, what if the condition which caused the routine to die is solvable on a higher level? Or what if the user of the code doesn't bother that a part fails, because it has implemented alternatives for that situation? Exception handling is quite clumsy in Perl5. The C set of distributions let modules concentrate on the program flow, and let the main program decide on the report handling model. The infrastructure to translate messages into multiple languages, whether to create exceptions or carp/die, to collect longer explanations with the messages, to log to mail or syslog, and so on, is decided in pluggable back-ends. =head3 The Reason for the report Traditionally, perl has a very simple view on error reports: you either have a warning or an error. However, it would be much clearer for user's and module-using applications, when a distinction is made between various causes. For instance, a configuration error is quite different from a disk-full situation. In C, the produced reports in the code tell I is wrong. The main application defines loggers, which interpret the cause into (syslog) levels. Defined by C are =over 4 =item . trace (debug, program) The message will be used when some logger has debugging enabled. The messages show steps taken by the program, which are of interest by the developers and maintainers of the code, but not for end-users. =item . assert (program) Shows an unexpected condition, but continues to run. When you want the program to abort in such situation, that use C. =item . info (verbose, program) These messages show larger steps in the execution of the program. Experienced users of the program usually do not want to see all these intermediate steps. Most programs will display info messages (and higher) when some C flag is given on the command-line. =item . notice (program) An user may need to be aware of the program's accidental smart behavior, for instance, that it initializes a lasting C directory in your home directory. Notices should be sparse. =item . warning (program) The program encountered some problems, but was able to work around it by smart behavior. For instance, the program does not understand a line from a log-file, but simply skips the line. =item . mistake (user) When a user does something wrong, but what is correctable by smart behavior of the program. For instance, in some configuration file, you can fill-in "yes" or "no", but the user wrote "yeah". The program interprets this as "yes", producing a mistake message as warning. It is much nicer to tell someone that he/she made a mistake, than to call that an error. =item . error (user) The user did something wrong, which is not automatically correctable or the program is not willing to correct it automatically for reasons of code quality. For instance, an unknown option flag is given on the command-line. These are configuration issues, and have no useful value in C<$!>. The program will be stopped, usually before taken off. =item . fault (system) The program encountered a situation where it has no work-around. For instance, a file cannot be opened to be written. The cause of that problem can be some user error (i.e. wrong filename), or external (you accidentally removed a directory yesterday). In any case, the C<$!> (C<$ERRNO>) variable is set here. =item . alert (system) Some external cause disturbs the execution of the program, but the program stays alive and will try to continue operation. For instance, the connection to the database is lost. After a few attempts, the database can be reached and the program continues as if nothing happened. The cause is external, so C<$!> is set. Usually, a system administrator needs to be informed about the problem. =item . failure (system) Some external cause makes it impossible for this program to continue. C<$!> is set, and usually the system administrator wants to be informed. The program will die. The difference with C is subtile and not always clear. A fault reports an error returned by an operating system call, where the failure would report an operational problem, like a failing mount. =item . panic (program) All above report classes are expected: some predictable situation is encountered, and therefore a message is produced. However, programs often do some internal checking. Of course, these conditions should never be triggered, but if they do... then we can only stop. For instance, in an OO perl module, the base class requires all sub-classes to implement a certain method. The base class will produce a stub method with triggers a panic when called. The non-dieing version of this test C. =back I or being C are run-time behaviors, and have nothing directly to do with the type of message which is produced. These two are B which can be set on the dispatchers: one dispatcher may be more verbose that some other. On purpose, we do not use the terms C or C, because the dispatcher can be configured what to do in cause of which condition. For instance, it may decide to stop execution on warnings as well. The terms C and C are avoided, because the program cause versus user cause distinction (warn vs carp) is reflected in the use of different reasons. There is no need for C and C either, because the dispatcher can be configured to produce stack-trace information (for a limited sub-set of dispatchers) =head3 Report levels Various frameworks used with perl programs define different labels to indicate the reason for the message to be produced. Perl5 Log::Dispatch Syslog Log4Perl Log::Report print 0,debug debug debug trace print 0,debug debug debug assert print 1,info info info info warn\n 2,notice notice info notice warn 3,warning warn warn mistake carp 3,warning warn warn warning die\n 4,error err error error die 5,critical crit fatal fault croak 6,alert alert fatal alert croak 7,emergency emerg fatal failure confess 7,emergency emerg fatal panic =head3 Run modes The run-mode change which messages are passed to a dispatcher, but from a different angle than the dispatch filters; the mode changes behavioral aspects of the messages, which are described in detail in L. However, it should behave as you expect: the DEBUG mode shows more than the VERBOSE mode, and both show more than the NORMAL mode. B<. Example: extract run mode from Getopt::Long> The C function will count the number of C options on the command-line when a C<+> is after the option name. use Log::Report; use Getopt::Long qw(:config no_ignore_case bundling); my $mode; # defaults to NORMAL GetOptions 'v+' => \$mode , 'verbose=i' => \$mode , 'mode=s' => \$mode or exit 1; dispatcher 'PERL', 'default', mode => $mode; Now, C<-vv> will set C<$mode> to C<2>, as will C<--verbose 2> and C<--verbose=2> and C<--mode=ASSERT>. Of course, you do not need to provide all these options to the user: make a choice. B<. Example: the mode of a dispatcher> my $mode = dispatcher(find => 'myname')->mode; B<. Example: run-time change mode of a dispatcher> To change the running mode of the dispatcher, you can do dispatcher mode => DEBUG => 'myname'; However, be warned that this does not change the types of messages accepted by the dispatcher! So: probably you will not receive the trace, assert, and info messages after all. So, probably you need to replace the dispatcher with a new one with the same name: dispatcher FILE => 'myname', to => ..., mode => 'DEBUG'; This may reopen connections (depends on the actual dispatcher), which might be not what you wish to happened. In that case, you must take the following approach: # at the start of your program dispatcher FILE => 'myname', to => ... , accept => 'ALL'; # overrule the default 'NOTICE-' !! # now it works dispatcher mode => DEBUG => 'myname'; # debugging on ... dispatcher mode => NORMAL => 'myname'; # debugging off Of course, this comes with a small overall performance penalty. =head3 Exceptions The simple view on live says: you 're dead when you die. However, more complex situations try to revive the dead. Typically, the "die" is considered a terminating exception, but not terminating the whole program, but only some logical block. Of course, a wrapper round that block must decide what to do with these emerging problems. Java-like languages do not "die" but throw exceptions which contain the information about what went wrong. Perl modules like C simulate this. It's a hassle to create exception class objects for each emerging problem, and the same amount of work to walk through all the options. Log::Report follows a simpler scheme. Fatal messages will "die", which is caught with "eval", just the Perl way (used invisible to you). However, the wrapper gets its hands on the message as the user has specified it: untranslated, with all unprocessed parameters still at hand. try { fault __x "cannot open file {file}", file => $fn }; if($@) # is Log::Report::Dispatcher::Try { my $cause = $@->wasFatal; # is Log::Report::Exception $cause->throw if $cause->message->msgid =~ m/ open /; # all other problems ignored } See L and L. =head2 Comparison Some notes on differences between the Log::Report approach and other Perl concepts. =head3 die/warn/Carp Perl's built-in exception system is very primitive: "die" and "warn". Most programming languages provide a much more detailed exception mechanism. A typical perl program can look like this: my $dir = '/etc'; File::Spec->file_name is_absolute($dir) or die "ERROR: directory name must be absolute.\n"; -d $dir or die "ERROR: what platform are you on?"; until(opendir DIR, $dir) { warn "ERROR: cannot read system directory $dir: $!"; sleep 60; } print "Processing directory $dir\n" if $verbose; while(defined(my $file = readdir DIR)) { if($file =~ m/\.bak$/) { warn "WARNING: found backup file $dir/$f\n"; next; } die "ERROR: file $dir/$file is binary" if $debug && -B "$dir/$file"; print "DEBUG: processing file $dir/$file\n" if $debug; open FILE, "<", "$dir/$file" or die "ERROR: cannot read from $dir/$f: $!"; close FILE or croak "ERROR: read errors in $dir/$file: $!"; } Where C, C, and C are used for various tasks. With C, you would write use Log::Report; # can be left-out when there is no debug/verbose dispatcher PERL => 'default', mode => 'DEBUG'; my $dir = '/etc'; File::Spec->file_name is_absolute($dir) or mistake "directory name must be absolute"; -d $dir or panic "what platform are you on?"; until(opendir DIR, $dir) { alert "cannot read system directory $dir"; sleep 60; } info "Processing directory $dir"; while(defined(my $file = readdir DIR)) { if($file =~ m/\.bak$/) { notice "found backup file $dir/$f"; next; } assert "file $dir/$file is binary" if -B "$dir/$file"; trace "processing file $dir/$file"; unless(open FILE, "<", "$dir/$file") { error "no permission to read from $dir/$f" if $!==ENOPERM; fault "unable to read from $dir/$f"; } close FILE or failure "read errors in $dir/$file"; } A lot of things are quite visibly different, and there are a few smaller changes. There is no need for a new-line after the text of the message. When applicable (error about system problem), then the C<$!> is added automatically. =head3 Log::Dispatch and Log::Log4perl The two major logging frameworks for Perl are Log::Dispatch and Log::Log4perl; both provide a pluggable logging interface. Both frameworks do not have (gettext or maketext) language translation support, which has various consequences. When you wish for to report in some other language, it must be translated before the logging function is called. This may mean that an error message is produced in Chinese, and therefore also ends-up in the syslog file in Chinese. When this is not your language, you have a problem. Log::Report translates only in the back-end, which means that the user may get the message in Chinese, but you get your report in your beloved Dutch. When no dispatcher needs to report the message, then no time is lost in translating. With both logging frameworks, you use terminology comparable to syslog: the module programmer determines the seriousness of the error message, not the application which integrates multiple modules. This is the way perl programs usually work, but often the cause for inconsequent user interaction. =head3 Locale::gettext and Locate::TextDomain Both on GNU gettext based implementations can be used as translation frameworks. Locale::TextDomain syntax is supported, with quite some extensions. Read the excellent documentation of Locale::Textdomain. Only the tried access via C<$__> and C<%__> are not supported. The main difference with these modules is the moment when the translation takes place. In Locale::TextDomain, an C<__x()> will result in an immediate translation request via C. C's version of C<__x()> will only capture what needs to be translated in an object. When the object is used in a print statement, only then the translation will take place. This is needed to offer ways to send different translations of the message to different destinations. To be able to postpone translation, objects are returned which stringify into the translated text. =head1 DIAGNOSTICS =over 4 =item Error: in SCALAR context, only one dispatcher name accepted The L method returns the L objects which it has accessed. When multiple names where given, it wishes to return a LIST of objects, not the count of them. =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Log/Report.pm0000644000175000001440000003522215000465232017247 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report;{ our $VERSION = '1.40'; } use base 'Exporter'; use warnings; use strict; use List::Util qw/first/; use Scalar::Util qw/blessed/; use Log::Report::Util; my $lrm = 'Log::Report::Message'; ### if you change anything here, you also have to change Log::Report::Minimal my @make_msg = qw/__ __x __n __nx __xn N__ N__n N__w __p __px __np __npx/; my @functions = qw/report dispatcher try textdomain/; my @reason_functions = qw/trace assert info notice warning mistake error fault alert failure panic/; our @EXPORT_OK = (@make_msg, @functions, @reason_functions); sub _whats_needed(); sub dispatcher($@); sub textdomain(@); sub trace(@); sub assert(@); sub info(@); sub notice(@); sub warning(@); sub mistake(@); sub error(@); sub fault(@); sub alert(@); sub failure(@); sub panic(@); sub __($); sub __x($@); sub __n($$$@); sub __nx($$$@); sub __xn($$$@); sub N__($); sub N__n($$); sub N__w(@); sub __p($$); sub __px($$@); sub __np($$$$); sub __npx($$$$@); # # Some initiations # my $reporter = {}; my $default_mode = 0; my @nested_tries; # we can only load these after Log::Report has compiled, because # they use this module themselves as well. require Log::Report::Die; require Log::Report::Domain; require Log::Report::Message; require Log::Report::Exception; require Log::Report::Dispatcher; require Log::Report::Dispatcher::Try; textdomain 'log-report'; my $default_dispatcher = dispatcher PERL => 'default', accept => 'NOTICE-'; sub report($@) { my $opts = ref $_[0] eq 'HASH' ? +{ %{ (shift) } } : {}; my ($reason, $message) = (shift, shift); my $stop = exists $opts->{is_fatal} ? $opts->{is_fatal} : is_fatal $reason; my $try = $nested_tries[-1]; # WARNING: overloaded boolean, use 'defined' my @disp; if(defined $try) { push @disp, @{$reporter->{needs}{$reason} || []} unless $stop || $try->hides($reason); push @disp, $try if $try->needs($reason) || $opts->{is_fatal}; } else { @disp = @{$reporter->{needs}{$reason} || []}; } is_reason $reason or error __x"token '{token}' not recognized as reason", token=>$reason; # return when no-one needs it: skip unused trace() fast! @disp || $stop or return; my $to = delete $opts->{to}; if($to) { # explicit destination, still disp may not need it. if(ref $to eq 'ARRAY') { my %disp = map +($_->name => $_), @disp; @disp = grep defined, @disp{@$to}; } else { @disp = grep $_->name eq $to, @disp; } push @disp, $try if defined $try; @disp || $stop or return; } unless(Log::Report::Dispatcher->can('collectLocation')) { # internal Log::Report error can result in "deep recursions". eval "require Carp"; Carp::confess($message); } $opts->{location} ||= Log::Report::Dispatcher->collectLocation; my $exception; if(!blessed $message) { # untranslated message into object @_%2 and error __x"odd length parameter list with '{msg}'", msg => $message; $message = $lrm->new(_prepend => $message, @_); } elsif($message->isa('Log::Report::Exception')) { $exception = $message; $message = $exception->message; } elsif($message->isa('Log::Report::Message')) { @_==0 or error __x"a message object is reported with more parameters"; } else { # foreign object my $text = "$message"; # hope stringification is overloaded $text =~ s/\s*$//gs; @_%2 and error __x"odd length parameter list with object '{msg}'", msg => $text; $message = $lrm->new(_prepend => $text, @_); } $message->to(undef) if $to; # overrule destination of message if(my $disp_name = $message->to) { @disp = grep $_->name eq $disp_name, @disp; push @disp, $try if defined $try && $disp_name ne 'try'; @disp or return; } $opts->{errno} //= $message->errno // (use_errno($reason) ? ($!+0 || $?) : is_fatal($reason) ? 1 : undef); my $domain = $message->domain; if(my $filters = $reporter->{filters}) { DISPATCHER: foreach my $d (@disp) { my ($r, $m) = ($reason, $message); foreach my $filter (@$filters) { next if keys %{$filter->[1]} && !$filter->[1]{$d->name}; ($r, $m) = $filter->[0]->($d, $opts, $r, $m, $domain); $r or next DISPATCHER; } $d->log($opts, $r, $m, $domain); } } else { $_->log($opts, $reason, $message, $domain) for @disp; } if($stop) { # $^S = $EXCEPTIONS_BEING_CAUGHT; parse: undef, eval: 1, else 0 (defined($^S) ? $^S : 1) or exit($opts->{errno} || 0); $! = $opts->{errno} || 0; $@ = $exception || Log::Report::Exception->new(report_opts => $opts , reason => $reason, message => $message); die; # $@->PROPAGATE() will be called, some eval will catch this } @disp; } my %disp_actions = map +($_ => 1), qw/ close find list disable enable mode needs filter active-try do-not-reopen /; my $reopen_disp = 1; sub dispatcher($@) { if(! $disp_actions{$_[0]}) { my ($type, $name) = (shift, shift); # old dispatcher with same name will be closed in DESTROY my $disps = $reporter->{dispatchers}; if(!$reopen_disp) { my $has = first {$_->name eq $name} @$disps; if(defined $has && $has ne $default_dispatcher) { my $default = $name eq 'default' ? ' (refreshing configuration instead)' : ''; trace "not reopening $name$default"; return $has; } } my @disps = grep $_->name ne $name, @$disps; trace "reopening dispatcher $name" if @disps != @$disps; my $disp = Log::Report::Dispatcher ->new($type, $name, mode => $default_mode, @_); push @disps, $disp if $disp; $reporter->{dispatchers} = \@disps; _whats_needed; return $disp ? ($disp) : undef; } my $command = shift; if($command eq 'list') { mistake __"the 'list' sub-command doesn't expect additional parameters" if @_; my @disp = @{$reporter->{dispatchers}}; push @disp, $nested_tries[-1] if @nested_tries; return @disp; } if($command eq 'needs') { my $reason = shift || 'undef'; error __"the 'needs' sub-command parameter '{reason}' is not a reason" unless is_reason $reason; my $disp = $reporter->{needs}{$reason}; return $disp ? @$disp : (); } if($command eq 'filter') { my $code = shift; error __"the 'filter' sub-command needs a CODE reference" unless ref $code eq 'CODE'; my %names = map +($_ => 1), @_; push @{$reporter->{filters}}, [ $code, \%names ]; return (); } if($command eq 'active-try') { return $nested_tries[-1]; } if($command eq 'do-not-reopen') { $reopen_disp = 0; return (); } my $mode = $command eq 'mode' ? shift : undef; my $all_disp = @_==1 && $_[0] eq 'ALL'; my $disps = $reporter->{dispatchers}; my @disps; if($all_disp) { @disps = @$disps } else { # take the dispatchers in the specified order. Both lists # are small, so O(x²) is small enough for my $n (@_) { push @disps, grep $_->name eq $n, @$disps } } error __"only one dispatcher name accepted in SCALAR context" if @disps > 1 && !wantarray && defined wantarray; if($command eq 'close') { my %kill = map +($_->name => 1), @disps; @$disps = grep !$kill{$_->name}, @$disps; $_->close for @disps; } elsif($command eq 'enable') { $_->_disabled(0) for @disps } elsif($command eq 'disable') { $_->_disabled(1) for @disps } elsif($command eq 'mode') { Log::Report::Dispatcher->defaultMode($mode) if $all_disp; $_->_set_mode($mode) for @disps; } # find does require reinventarization _whats_needed if $command ne 'find'; wantarray ? @disps : $disps[0]; } END { $_->close for @{$reporter->{dispatchers}} } # _whats_needed # Investigate from all dispatchers which reasons will need to be # passed on. After dispatchers are added, enabled, or disabled, # this method shall be called to re-investigate the back-ends. sub _whats_needed() { my %needs; foreach my $disp (@{$reporter->{dispatchers}}) { push @{$needs{$_}}, $disp for $disp->needs; } $reporter->{needs} = \%needs; } sub try(&@) { my $code = shift; @_ % 2 and report {location => [caller 0]}, PANIC => __x"odd length parameter list for try(): forgot the terminating ';'?"; unshift @_, mode => 'DEBUG' if $reporter->{needs}{TRACE}; my $disp = Log::Report::Dispatcher::Try->new(TRY => 'try', @_); # L::R native messages are logged directly in $disp via @nested_tries push @nested_tries, $disp; # user's __DIE__ handlers would frustrate the exception mechanism local $SIG{__DIE__}; my ($ret, @ret); if(!defined wantarray) { eval { $code->() } } # VOID context elsif(wantarray) { @ret = eval { $code->() } } # LIST context else { $ret = eval { $code->() } } # SCALAR context my $err = $@; pop @nested_tries; # remove $disp my $is_exception = blessed $err && $err->isa('Log::Report::Exception'); if(!$is_exception && $err && !$disp->wasFatal) { # Decode errors which do not origin from Log::Report reports # Native exceptions are already logged. my ($opts, $reason, $text) = blessed $err ? Log::Report::Die::exception_decode($err) : Log::Report::Die::die_decode($err, on_die => $disp->die2reason); $disp->log($opts, $reason, __$text); } $disp->died($err) if $is_exception ? $err->isFatal : $err; $@ = $disp; wantarray ? @ret : $ret; } #------------ sub trace(@) {report TRACE => @_} sub assert(@) {report ASSERT => @_} sub info(@) {report INFO => @_} sub notice(@) {report NOTICE => @_} sub warning(@) {report WARNING => @_} sub mistake(@) {report MISTAKE => @_} sub error(@) {report ERROR => @_} sub fault(@) {report FAULT => @_} sub alert(@) {report ALERT => @_} sub failure(@) {report FAILURE => @_} sub panic(@) {report PANIC => @_} #------------- sub __($) { my ($cpkg, $fn, $linenr) = caller; $lrm->new(_msgid => shift, _domain => pkg2domain($cpkg), _use => "$fn line $linenr"); } # label "msgid" added before first argument sub __x($@) { my ($cpkg, $fn, $linenr) = caller; @_%2 or error __x"even length parameter list for __x at {where}", where => "$fn line $linenr"; my $msgid = shift; $lrm->new(_msgid => $msgid, _expand => 1, _domain => pkg2domain($cpkg), _use => "$fn line $linenr", @_); } sub __n($$$@) { my ($single, $plural, $count) = (shift, shift, shift); my ($cpkg, $fn, $linenr) = caller; $lrm->new(_msgid => $single, _plural => $plural, _count => $count, _domain => pkg2domain($cpkg), _use => "$fn line $linenr" , @_); } sub __nx($$$@) { my ($single, $plural, $count) = (shift, shift, shift); my ($cpkg, $fn, $linenr) = caller; $lrm->new(_msgid => $single, _plural => $plural, _count => $count, _expand => 1, _domain => pkg2domain($cpkg), _use => "$fn line $linenr", @_); } sub __xn($$$@) # repeated for prototype { my ($single, $plural, $count) = (shift, shift, shift); my ($cpkg, $fn, $linenr) = caller; $lrm->new(_msgid => $single, _plural => $plural, _count => $count, _expand => 1, _domain => pkg2domain($cpkg), _use => "$fn line $linenr", @_); } sub N__($) { $_[0] } sub N__n($$) {@_} sub N__w(@) {split " ", $_[0]} #------------- sub __p($$) { __($_[0])->_msgctxt($_[1]) } sub __px($$@) { my ($ctxt, $msgid) = (shift, shift); __x($msgid, @_)->_msgctxt($ctxt); } sub __np($$$$) { my ($ctxt, $msgid, $plural, $count) = @_; __n($msgid, $msgid, $plural, $count)->_msgctxt($ctxt); } sub __npx($$$$@) { my ($ctxt, $msgid, $plural, $count) = splice @_, 0, 4; __nx($msgid, $msgid, $plural, $count, @_)->_msgctxt($ctxt); } #------------- sub import(@) { my $class = shift; if($INC{'Log/Report/Minimal.pm'}) { my ($pkg, $fn, $line) = caller; # do not report on LR:: modules if(index($pkg, 'Log::Report::') != 0) { # @pkgs empty during release testings of L::R distributions my @pkgs = Log::Report::Optional->usedBy; die "Log::Report loaded too late in $fn line $line, put in $pkg before ", (join ',', @pkgs) if @pkgs; } } my $to_level = ($_[0] && $_[0] =~ m/^\+\d+$/ ? shift : undef) || 0; my $textdomain = @_%2 ? shift : undef; my %opts = @_; my ($pkg, $fn, $linenr) = caller $to_level; ### Log::Report options if(exists $opts{mode}) { $default_mode = delete $opts{mode} || 0; Log::Report::Dispatcher->defaultMode($default_mode); dispatcher mode => $default_mode, 'ALL'; } my @export; if(my $in = delete $opts{import}) { push @export, ref $in eq 'ARRAY' ? @$in : $in; } else { push @export, @functions, @make_msg; my $syntax = delete $opts{syntax} || 'SHORT'; if($syntax eq 'SHORT') { push @export, @reason_functions } elsif($syntax ne 'REPORT' && $syntax ne 'LONG') { error __x"syntax flag must be either SHORT or REPORT, not `{flag}' in {fn} line {line}", flag => $syntax, fn => $fn, line => $linenr; } } if(my $msg_class = delete $opts{message_class}) { $msg_class->isa($lrm) or error __x"message_class {class} does not extend {base}" , base => $lrm, class => $msg_class; $lrm = $msg_class; } $class->export_to_level(1+$to_level, undef, @export); ### Log::Report::Domain configuration if(defined $textdomain) { pkg2domain $pkg, $textdomain, $fn, $linenr; my $domain = textdomain $textdomain; $domain->configure(%opts, where => [$pkg, $fn, $linenr ]) if keys %opts; } elsif(keys %opts) { error __x"no domain for configuration options in {fn} line {line}", fn => $fn, line => $linenr; } } # deprecated, since we have a ::Domain object in 1.00 sub translator($;$$$$) { # replaced by (textdomain $domain)->configure my ($class, $name) = (shift, shift); my $domain = textdomain $name or error __x"textdomain `{domain}' for translator not defined", domain => $name; @_ or return $domain->translator; my ($translator, $pkg, $fn, $line) = @_; ($pkg, $fn, $line) = caller # direct call, not via import unless defined $pkg; $translator->isa('Log::Report::Translator') or error __x"translator must be a {pkg} object for {domain}", pkg => 'Log::Report::Translator', domain => $name; $domain->configure(translator => $translator, where => [$pkg, $fn, $line]); } sub textdomain(@) { if(@_==1 && blessed $_[0]) { my $domain = shift; $domain->isa('Log::Report::Domain') or panic; return $reporter->{textdomains}{$domain->name} = $domain; } if(@_==2) { # used for 'maintenance' and testing return delete $reporter->{textdomains}{$_[0]} if $_[1] eq 'DELETE'; return $reporter->{textdomains}{$_[0]} if $_[1] eq 'EXISTS'; } my $name = (@_%2 ? shift : pkg2domain((caller)[0])) || 'default'; my $domain = $reporter->{textdomains}{$name} ||= Log::Report::Domain->new(name => $name); $domain->configure(@_, where => [caller]) if @_; $domain; } #-------------- sub needs(@) { my $thing = shift; my $self = ref $thing ? $thing : $reporter; first {$self->{needs}{$_}} @_; } #-------------- 1; Log-Report-1.40/lib/Dancer2/0000755000175000001440000000000015000465237016174 5ustar00markovusers00000000000000Log-Report-1.40/lib/Dancer2/Logger/0000755000175000001440000000000015000465237017413 5ustar00markovusers00000000000000Log-Report-1.40/lib/Dancer2/Logger/LogReport.pod0000644000175000001440000000604015000465233022030 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Dancer2::Logger::LogReport - reroute Dancer2 logs into Log::Report =head1 INHERITANCE Dancer2::Logger::LogReport is a Moo::Object =head1 SYNOPSIS # This module is loaded when configured. It does not provide # end-user functions or methods. # See DETAILS =head1 DESCRIPTION [The Dancer2 plugin was contributed by Andrew Beverley] This logger allows the use of the many logging backends available in L. It will process all of the Dancer2 log messages, and also allow any other module to use the same logging facilities. The same log messages can be sent to multiple destinations at the same time via flexible dispatchers. If using this logger, you may also want to use L Many log back-ends, like syslog, have more levels of system messages. Modules who explicitly load this module can use the missing C, C, C, and C log levels. The C name is provided as well: when you are debugging, you add a 'trace' to your program... it's just a better name than 'debug'. You will need to load Log::Report in order to use the additional levels; if doing so directly within a Dancer2 application (not a sub-module), then you will either need to load Log::Report with C or use L to prevent namespace clashes. =head2 Log Format If using this module on its own (such as a drop-in replacement for Dancer2::Logger::Syslog), then the logging format is configured as with any other Dancer logger. If using this module with L, then log_format is ignored and messages are not formatted, in order to keep the message format consistent regardless of where the message was generated (be it another module using Log::Report, the plugin, or Dancer itself). In this case, the log format should be configured using the applicable dispatcher (such as L). If also using with the L logging functions, then you probably want to set a very simple C, because the dispatchers do already add some of the fields that the default C format adds. For instance, to get the filename/line-number in messages depends on the dispatcher 'mode' (f.i. 'DEBUG'). You also want to set the Dancer2 log level to C, because level filtering is controlled per dispatcher (as well). See L for examples. =head1 METHODS =over 4 =item $obj-EB($level, $params) =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Dancer2/Logger/LogReport.pm0000644000175000001440000000445715000465232021673 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Dancer2::Logger::LogReport;{ our $VERSION = '1.40'; } # ABSTRACT: Dancer2 logger engine for Log::Report use strict; use warnings; use Moo; use Dancer2::Core::Types; use Scalar::Util qw/blessed/; use Log::Report 'log-report', syntax => 'REPORT'; our $AUTHORITY = 'cpan:MARKOV'; my %level_dancer2lr = ( core => 'TRACE' , debug => 'TRACE' ); with 'Dancer2::Core::Role::Logger'; # Set by calling function has dispatchers => ( is => 'ro' , isa => Maybe[HashRef] ); sub BUILD { my $self = shift; my $configs = $self->dispatchers || {default => undef}; $self->{use} = [ keys %$configs ]; dispatcher 'do-not-reopen'; foreach my $name (keys %$configs) { my $config = $configs->{$name} || {}; if(keys %$config) { my $type = delete $config->{type} or die "dispatcher configuration $name without type"; dispatcher $type, $name, %$config; } } } around 'error' => sub { my ($orig, $self) = (shift, shift); # If it's a route exception (generated by Dancer) and we're also using the # Plugin, then the plugin will handle the exception using its own hook into # the error system. This should be able to removed in the future with # https://github.com/PerlDancer/Dancer2/pull/1287 return if $_[0] =~ /^Route exception/ && $INC{'Dancer2/Plugin/LogReport.pm'}; $self->log(error => @_); }; sub log # no protoypes in Dancer2 { my ($self, $level, $msg) = @_; my %options; # If only using the logger on its own (without the associated plugin), make # it behave like a normal Dancer logger unless ($INC{'Dancer2/Plugin/LogReport.pm'}) { $msg = $self->format_message($level, $msg); $options{is_fatal} = 0; } # the levels are nearly the same. my $reason = $level_dancer2lr{$level} || uc $level; report \%options, $reason => $msg; undef; } 1; Log-Report-1.40/lib/Dancer2/Plugin/0000755000175000001440000000000015000465237017432 5ustar00markovusers00000000000000Log-Report-1.40/lib/Dancer2/Plugin/LogReport/0000755000175000001440000000000015000465237021347 5ustar00markovusers00000000000000Log-Report-1.40/lib/Dancer2/Plugin/LogReport/Message.pod0000644000175000001440000000427315000465233023441 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Dancer2::Plugin::LogReport::Message - extended Log::Report message class =head1 INHERITANCE Dancer2::Plugin::LogReport::Message is a Log::Report::Message =head1 SYNOPSIS In your template: [% FOR message IN messages %]
[% message.toString | html_entity %]
[% END %] =head1 DESCRIPTION [The Dancer2 plugin was contributed by Andrew Beverley] This class is an extension of L, with functions specifically designed for Dancer applications. Minimal functions are provided (currently only aimed at Bootstrap), but ideas for new ones are welcome. Extends L<"DESCRIPTION" in Log::Report::Message|Log::Report::Message/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Message|Log::Report::Message/"METHODS">. =over 4 =item $obj-EB() Get a suitable bootstrap context color for the message. This can be used as per the SYNOPSIS. C is used for L messages, C colors are used for messages C and below, C is used for C and C, C is used for all other messages =item $obj-EB() Get or set the reason of a message =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Message|Log::Report::Message/"DETAILS">. =head1 OVERLOADING Extends L<"OVERLOADING" in Log::Report::Message|Log::Report::Message/"OVERLOADING">. =over 4 =item overload: B Inherited, see L =item overload: B Inherited, see L =item overload: B Inherited, see L =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Dancer2/Plugin/LogReport/Message.pm0000644000175000001440000000203215000465232023261 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Dancer2::Plugin::LogReport::Message;{ our $VERSION = '1.40'; } use parent 'Log::Report::Message'; use strict; use warnings; sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $self; } sub reason { my $self = shift; $self->{reason} = $_[0] if exists $_[0]; $self->{reason}; } my %reason2color = ( TRACE => 'info' , ASSERT => 'info' , INFO => 'info' , NOTICE => 'info' , WARNING => 'warning' , MISTAKE => 'warning' ); sub bootstrap_color { my $self = shift; return 'success' if $self->inClass('success'); $reason2color{$self->reason} || 'danger'; } 1; Log-Report-1.40/lib/Dancer2/Plugin/LogReport.pod0000644000175000001440000004266615000465233022065 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Dancer2::Plugin::LogReport - logging and exceptions via Log::Report =head1 INHERITANCE Dancer2::Plugin::LogReport is a Dancer2::Plugin =head1 SYNOPSIS # Load the plugin into Dancer2 # see Log::Report::import() for %options use Dancer2::Plugin::LogReport %options; # Stop execution, redirect, and display an error to the user $name or error "Please enter a name"; # Add debug information to logger trace "We're here"; # Handling user errors cleanly if (process( sub {MyApp::Model->create_user} )) { # Success, redirect user elsewhere } else { # Failed, continue as if submit hadn't been made. # Error message will be in session for display later. } # Send errors to template for display hook before_template => sub { my $tokens = shift; $tokens->{messages} = session 'messages'; session 'messages' => []; } =head1 DESCRIPTION [The Dancer2 plugin was contributed by Andrew Beverley] When you need to translate your templates as well (not only the messages in your code) then have a look at L. This module provides easy access to the extensive logging facilities provided by L. Along with L, this brings together all the internal Dancer2 logging, handling for expected and unexpected exceptions, translations and application logging. Logging is extremely flexible using many of the available L. Multiple dispatchers can be used, each configured separately to display different messages in different formats. By default, messages are logged to a session variable for display on a webpage, and to STDERR. Messages within this plugin use the extended L class rather than the standard L class. Note that it is currently recommended to use the plugin in all apps within a Dancer2 program, not only some. Therefore, wherever you C you should also C. This does not apply if using the same app name (C). In all other modules, you can just C. Read the L in below in this manual-page. =head1 METHODS =over 4 =item $obj-EB() C allows alternative handlers to be defined in place of (or in addition to) the default redirect handler that is called on a fatal error. Calls should be made with 1 parameter: the subroutine to call in the case of a fatal error. The subroutine is passed 3 parameters: the DSL, the message in question, and the reason. The subroutine should return true or false depending on whether it handled the error. If it returns false, the next fatal handler is called, and if there are no others then the default redirect fatal handler is called. example: Error handler based on URL (e.g. API) fatal_handler sub { my ($dsl, $msg, $reason) = @_; return if $dsl->app->request->uri !~ m!^/api/!; status $reason eq 'PANIC' ? 'Internal Server Error' : 'Bad Request'; $dsl->send_as(JSON => { error => 1, error_description => $msg->toString, }, { content_type => 'application/json; charset=UTF-8', }); }; example: Return JSON responses for requests with content-type of application/json fatal_handler sub { my ($dsl, $msg, $reason, $default) = @_; (my $ctype = $dsl->request->header('content-type')) =~ s/;.*//; return if $ctype ne 'application/json'; status $reason eq 'PANIC' ? 'Internal Server Error' : 'Bad Request'; $dsl->send_as(JSON => { error => 1, description => $msg->toString, }, { content_type => 'application/json; charset=UTF-8', }); }; =item $obj-EB() C is an eval, but one which expects and understands exceptions generated by L. Any messages will be logged as normal in accordance with the dispatchers, but any fatal exceptions will be caught and handled gracefully. This allows much simpler error handling, rather than needing to test for lots of different scenarios. In a module, it is enough to simply use the C keyword in the event of a fatal error. The return value will be 1 for success or 0 if a fatal exception occurred. See the L for an example of how this is expected to be used. This module is configured only once in your application. The other modules which make your website do not need to require this plugin, instead they can C to get useful functions like error and fault. =back =head2 Handlers All the standard L functions are available to use. Please see the L for details of when each one should be used. L to class messages (which can then be tested later): notice __x"Class me up", _class => 'label'; ... if ($msg->inClass('label')) ... L has a special message class, C, which prevents the message from being saved to the messages session variable. This is useful, for example, if you are writing messages within the session hooks, in which case recursive loops can be experienced. =over 4 =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() This is a special additional type, equivalent to C. The difference is that messages using this keyword will have the class C added, which can be used to color the messages differently to the end user. For example, L uses this to display the message in green. =item $obj-EB() =item $obj-EB() =back =head1 DETAILS This chapter will guide you through the myriad of ways that you can use L in your Dancer2 application. We will set up our application to do the following: =over 4 =item Messages to the user We'll look at an easy way to output messages to the user's web page, whether they be informational messages, warnings or errors. =item Debug information We'll look at an easy way to log debug information, at different levels. =item Manage unexpected exceptions We'll handle unexpected exceptions cleanly, in the unfortunate event that they happen in your production application. =item Email alerts of significant errors If we do get unexpected errors then we want to be notified them. =item Log DBIC information and errors We'll specifically look at nice ways to log SQL queries and errors when using DBIx::Class. =back =head2 Larger example In its simplest form, this module can be used for more flexible logging get '/route' => sub { # Stop execution, redirect, and display an error to the user $name or error "Please enter a name"; # The same but translated $name or error __"Please enter a name"; # The same but translated and with variables $name or error __x"{name} is not valid", name => $name; # Show the user a warning, but continue execution mistake "Not sure that's what you wanted"; # Add debug information, can be caught in syslog by adding # the (for instance) syslog dispatcher trace "Hello world"; }; =head2 Setup and Configuration To make full use of L, you'll need to use both L and L. =head3 Dancer2::Logger::LogReport Set up L by adding it to your Dancer2 application configuration (see L). By default, all messages will go to STDERR. To get all message out "the Perl way" (using print, warn and die) just use logger: "LogReport" At start, these are handled by a L object, named 'default'. If you open a new dispatcher with the name 'default', the output via the perl mechanisms will be stopped. To also send messages to your syslog: logger: "LogReport" engines: logger: LogReport: log_format: %a%i%m # See Dancer2::Logger::LogReport app_name: MyApp dispatchers: default: # Name type: SYSLOG # Log::Reporter::dispatcher() options identity: myapp facility: local0 flags: "pid ndelay nowait" mode: DEBUG To send messages to a file: logger: "LogReport" engines: logger: LogReport: log_format: %a%i%m # See Dancer2::Logger::LogReport app_name: MyApp dispatchers: logfile: # "default" dispatcher stays open as well type: FILE to: /var/log/myapp.log charset: utf-8 mode: DEBUG See L for full details of options. Finally: a Dancer2 script may run many applications. Each application can have its own logger configuration. However, Log::Report dispatchers are global, so will be shared between Dancer2 applications. Any attempt to create a new Log::Report dispatcher by the same name (as will happen when a new Dancer2 application is started with the same configuration) will be ignored. =head3 Dancer2::Plugin::LogReport To use the plugin, you simply use it in your application: package MyApp; use Log::Report (); # use early and minimal once use Dancer2; use Dancer2::Plugin::LogReport %config; Dancer2::Plugin::LogReport takes the same C<%config> options as L itself (see L). If you want to send messages from your modules/models, there is no need to use this specific plugin. Instead, you should simply C to negate the need of loading all the Dancer2 specific code. =head2 In use =head3 Logging debug information In its simplest form, you can now use all the L to send messages to your dispatchers (as configured in the Logger configuration): trace "I'm here"; warning "Something dodgy happened"; panic "I'm bailing out"; # Additional, special Dancer2 keyword success "Settings saved successfully"; =head3 Exceptions Log::Report is a combination of a logger and an exception system. Messages to be logged are I to all listening dispatchers to be handled. This module will also catch any unexpected exceptions: # This will be caught, the error will be logged (full stacktrace to STDOUT, # short message to the session messages), and the user will be forwarded # (default to /). This would also be sent to syslog with the appropriate # dispatcher. get 'route' => sub { my $foo = 1; my $bar = $foo->{x}; # whoops } For a production application (C), the message saved in the session will be the generic text "An unexpected error has occurred". This can be customised in the configuration file, and will be translated. =head3 Sending messages to the user To make it easier to send messages to your users, messages at the following levels are also stored in the user's session: C, C, C, C, C, C, C and C. You can pass these to your template and display them at each page render: hook before_template => sub { my $tokens = shift; $tokens->{messages} = session 'messages'; session 'messages' => []; # Clear the message queue } Then in your template (for example the main layout): [% FOR message IN messages %]
[% message.toString | html_entity %]
[% END %] The C of the message is compatible with Bootstrap contextual colors: C, C, C or C. When you use L as well, which enables the translations of your whole templates, then add C: [% message.toString(locale) | html_entity %] Now, anywhere in your application that you have used Log::Report, you can warning "Hey user, you should now about this"; and the message will be sent to the next page the user sees. =head3 Handling user errors Sometimes we write a function in a model, and it would be nice to have a nice easy way to return from the function with an error message. One way of doing this is with a separate error message variable, but that can be messy code. An alternative is to use exceptions, but these can be a pain to deal with in terms of catching them. Here's how to do it with Log::Report. In this example, we do use exceptions, but in a neat, easier to use manner. First, your module/model: package MyApp::CD; sub update { my ($self, %values) = @_; $values{title} or error "Please enter a title"; $values{description} or warning "No description entered"; } Then, in your controller: package MyApp; use Dancer2; post '/cd' => sub { my %values = ( title => param('title'); description => param('description'); ); if (process sub { MyApp::CD->update(%values) } ) { success "CD updated successfully"; redirect '/cd'; } template 'cd' => { values => \%values }; } Now, when update() is called, any exceptions are caught. However, there is no need to worry about any error messages. Both the error and warning messages in the above code will have been stored in the messages session variable, where they can be displayed using the code in the previous section. The C will have caused the code to stop running, and process() will have returned false. C will have simply logged the warning and not caused the function to stop running. =head3 Logging DBIC database queries and errors If you use L in your application, you can easily integrate its logging and exceptions. To log SQL queries: # Log all queries and execution time $schema->storage->debugobj(new Log::Report::DBIC::Profiler); $schema->storage->debug(1); By default, exceptions from DBIC are classified at the level "error". This is normally a user level error, and thus may be filtered as normal program operation. If you do not expect to receive any DBIC exceptions, then it is better to class them at the level "panic": # panic() DBIC errors $schema->exception_action(sub { panic @_ }); # Optionally get a stracktrace too $schema->stacktrace(1); If you are occasionally running queries where you expect to naturally get exceptions (such as not inserting multiple values on a unique constraint), then you can catch these separately: try { $self->schema->resultset('Unique')->create() }; # Log any messages from try block, but only as trace $@->reportAll(reason => 'TRACE'); =head3 Email alerts of exceptions If you have an unexpected exception in your production application, then you probably want to be notified about it. One way to do so is configure rsyslog to send emails of messages at the panic level. Use the following configuration to do so: # Normal logging from LOCAL0 local0.* -/var/log/myapp.log # Load the mail module $ModLoad ommail # Configure sender, receiver and mail server $ActionMailSMTPServer localhost $ActionMailFrom root $ActionMailTo root # Set up an email template $template mailSubject,"Critical error on %hostname%" $template mailBody,"RSYSLOG Alert\r\nmsg='%msg%'\r\nseverity='%syslogseverity-text%'" $ActionMailSubject mailSubject # Send an email no more frequently than every minute $ActionExecOnlyOnceEveryInterval 60 # Configure the level of message to notify via email if $syslogfacility-text == 'local0' and $syslogseverity < 3 then :ommail:;mailBody $ActionExecOnlyOnceEveryInterval 0 With the above configuration, you will only be emailed of severe errors, but can view the full log information in /var/log/myapp.log =head1 CONFIGURATION All configuration is optional. The example configuration file below shows the configuration options and defaults. plugins: LogReport: # Whether to handle Dancer HTTP errors such as 404s. Currently has # no effect due to unresolved issues saving messages to the session # and accessing the DSL at that time. handle_http_errors: 1 # Where to forward users in the event of an uncaught fatal # error within a GET request forward_url: / # Or you can specify a template instead [1.13] forward_template: error_template_file # Defaults to empty # For a production server (show_errors: 0), this is the text that # will be displayed instead of unexpected exception errors fatal_error_message: An unexpected error has occurred # The levels of messages that will be saved to the session, and # thus displayed to the end user session_messages: [ NOTICE, WARNING, MISTAKE, ERROR, FAULT, ALERT, FAILURE, PANIC ] =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Dancer2/Plugin/LogReport.pm0000644000175000001440000002522215000465232021703 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Dancer2::Plugin::LogReport;{ our $VERSION = '1.40'; } use warnings; use strict; use version; BEGIN { use Log::Report () } # require very early XXX MO: useless? use Dancer2::Plugin 0.207; use Dancer2::Plugin::LogReport::Message; use Log::Report 'log-report', syntax => 'REPORT', message_class => 'Dancer2::Plugin::LogReport::Message'; use Scalar::Util qw/blessed refaddr/; my %_all_dsls; # The DSLs for each app within the Dancer application my $_settings; # "use" import sub import { my $class = shift; # Import Log::Report into the caller. Import options get passed through my $level = version->parse($Dancer2::Plugin::VERSION) > 0.166001 ? '+1' : '+2'; Log::Report->import($level, @_, syntax => 'LONG'); # Ensure the overridden import method is called (from Exporter::Tiny) # note this does not (currently) pass options through. my $caller = caller; $class->SUPER::import( {into => $caller} ); } my %session_messages; # The default reasons that a message will be displayed to the end user my @default_reasons = qw/NOTICE WARNING MISTAKE ERROR FAULT ALERT FAILURE PANIC/; my $hide_real_message; # Used to hide the real message to the end user my $messages_variable = $_settings->{messages_key} || 'messages'; # Dancer2 import on_plugin_import { # The DSL for the particular app that is loading the plugin my $dsl = shift; # capture global singleton $_all_dsls{refaddr($dsl->app)} = $dsl; my $settings = $_settings = plugin_setting; # Any exceptions in routes should not be happening. Therefore, # raise to PANIC. $dsl->app->add_hook( Dancer2::Core::Hook->new( name => 'core.app.route_exception', code => sub { my ($app, $error) = @_; # If there is no request object then we are in an early hook # and Dancer will not handle an exception cleanly (which will # result in a stacktrace to the browser, a potential security # vulnerability). Therefore in this case do not raise as fatal. my $is_fatal = $app->request ? 1 : 0; report {is_fatal => $is_fatal}, 'PANIC' => $error; }, ), ); if($settings->{handle_http_errors}) { # Need after_error for HTTP errors (eg 404) so as to # be able to change the forwarding location $dsl->app->add_hook( Dancer2::Core::Hook->new( name => 'after_error', code => sub { my $error = shift; my $msg = __($error->status . ": " . Dancer2::Core::HTTP->status_message($error->status)); #XXX This doesn't work at the moment. The DSL at this point # doesn't seem to respond to changes in the session or # forward requests _forward_home($msg); }, ), ); } $dsl->app->add_hook( Dancer2::Core::Hook->new( name => 'after_layout_render', code => sub { my $session = $dsl->app->session; $session->write($messages_variable => []); }, ), ); # Define which messages are saved to the session for later display # to the user. This can be configured in the config file, or we # choose some sensible defaults. my $sm = $settings->{session_messages} // \@default_reasons; $session_messages{$_} = 1 for ref $sm eq 'ARRAY' ? @$sm : $sm; if(my $forward_template = $settings->{forward_template}) { # Add a route for the specified template $dsl->app->add_route ( method => 'get' , regexp => qr!^/\Q$forward_template\E$!, , code => sub { shift->app->template($forward_template) } ); # Forward to that new route $settings->{forward_url} = $forward_template; } # This is so that all messages go into the session, to be displayed # on the web page (if required) dispatcher CALLBACK => 'error_handler' , callback => \&_error_handler , mode => 'DEBUG' unless dispatcher find => 'error_handler'; Log::Report::Dispatcher->addSkipStack( sub { $_[0][0] =~ m/ ^ Dancer2\:\:(?:Plugin|Logger) | ^ Dancer2\:\:Core\:\:Role\:\:DSL | ^ Dancer2\:\:Core\:\:App /x }); }; # ";" required! sub process($$) { my ($dsl, $coderef) = @_; ref $coderef eq 'CODE' or report PANIC => "plugin process() requires a CODE"; try { $coderef->() } hide => 'ALL', on_die => 'PANIC'; my $e = $@; # fragile $e->reportAll(is_fatal => 0); $e->success || 0; } register process => \&process; my @user_fatal_handlers; plugin_keywords fatal_handler => sub { my ($plugin, $sub) = @_; push @user_fatal_handlers, $sub; }; sub _get_dsl() { # Similar trick to Log::Report::Dispatcher::collectStack(), this time to # work out which Dancer app we were called from. We then use that app's # DSL. If we use the wrong DSL, then the request object will not be # available and we won't be able to forward if needed package DB; use Scalar::Util qw/blessed refaddr/; my (@ret, $ref, $i); do { @ret = caller ++$i } until !@ret || ( blessed $DB::args[0] && blessed $DB::args[0] eq 'Dancer2::Core::App' && ( $ref = refaddr $DB::args[0] ) ) || ( blessed $DB::args[1] && blessed $DB::args[1] eq 'Dancer2::Core::App' && ( $ref = refaddr $DB::args[1] ) ); $ref ? $_all_dsls{$ref} : undef; } sub _message_add($) { my $msg = shift; return if ! $session_messages{$msg->reason} || $msg->inClass('no_session'); # Get the DSL, only now that we know it's needed my $dsl = _get_dsl(); if (!$dsl) { report {to => 'default'}, NOTICE => "Unable to write message $msg to the session. " . "Have you loaded Dancer2::Plugin::LogReport to all your separate Dancer apps?"; return; } my $app = $dsl->app; # Check that we can write to the session before continuing. We can't # check $app->session as that can be true regardless. Instead, we check # for request(), which is used to access the cookies of a session. return unless $app->request; # In a production server, we don't want the end user seeing (unexpected) # exception messages, for both security and usability. If we detect # that this is a production server (show_errors is 0), then we change # the specific error to a generic error, when displayed to the user. # The message can be customised in the config file. # We evaluate this each message to allow show_errors to be set in the # application (specifically makes testing a lot easier) my $fatal_error_message = !$dsl->app->config->{show_errors} && ($_settings->{fatal_error_message} // "An unexpected error has occurred"); $hide_real_message->{$_} = $fatal_error_message for qw/FAULT ALERT FAILURE PANIC/; my $r = $msg->reason; if(my $newm = $hide_real_message->{$r}) { $msg = __$newm; $msg->reason($r); } my $session = $app->session; my $msgs = $session->read($messages_variable); push @$msgs, $msg; $session->write($messages_variable => $msgs); return ($dsl || undef, $msg); } #------ sub _forward_home($) { my ($dsl, $msg) = _message_add(shift); $dsl ||= _get_dsl(); my $page = $_settings->{forward_url} || '/'; # Don't forward if it's a GET request to the error page, as it will cause a # recursive loop. In this case, return the fatal error message as plain # text to render that instead. If we can't do that because it's too early # in the request, then let Dancer handle this with its default error # handling my $req = $dsl->app->request or return; return $dsl->send_as(plain => "$msg") if $req->uri eq $page && $req->is_get; $dsl->redirect($page); } sub _error_handler($$$$) { my ($disp, $options, $reason, $message) = @_; my $default_handler = sub { # Check whether this fatal message has been caught, in which case we # don't want to redirect return _message_add($message) if exists $options->{is_fatal} && !$options->{is_fatal}; _forward_home($message); }; my $user_fatal_handler = sub { my $return; foreach my $ufh (@user_fatal_handlers) { last if $return = $ufh->(_get_dsl, $message, $reason); } $default_handler->($message) if !$return; }; my $fatal_handler = @user_fatal_handlers ? $user_fatal_handler : $default_handler; $message->reason($reason); my %handler = ( # Default do nothing for the moment (TRACE|ASSERT|INFO) default => sub { _message_add $message } # A user-created error condition that is not recoverable. # This could have already been caught by the process # subroutine, in which case we should continue running # of the program. In all other cases, we should bail # out. , ERROR => $fatal_handler # 'FAULT', 'ALERT', 'FAILURE', 'PANIC' # All these are fatal errors. , FAULT => $fatal_handler , ALERT => $fatal_handler , FAILURE => $fatal_handler , PANIC => $fatal_handler ); my $call = $handler{$reason} || $handler{default}; $call->(); } sub _report($@) { my ($reason, $dsl) = (shift, shift); my $msg = (blessed($_[0]) && $_[0]->isa('Log::Report::Message')) ? $_[0] : Dancer2::Core::Role::Logger::_serialize(@_); if ($reason eq 'SUCCESS') { $msg = __$msg unless blessed $msg; $msg = $msg->clone(_class => 'success'); $reason = 'NOTICE'; } report uc($reason) => $msg; } register trace => sub { _report(TRACE => @_) }; register assert => sub { _report(ASSERT => @_) }; register notice => sub { _report(NOTICE => @_) }; register mistake => sub { _report(MISTAKE => @_) }; register panic => sub { _report(PANIC => @_) }; register alert => sub { _report(ALERT => @_) }; register fault => sub { _report(FAULT => @_) }; register failure => sub { _report(FAILURE => @_) }; register success => sub { _report(SUCCESS => @_) }; register_plugin for_versions => ['2']; #---------- 1; Log-Report-1.40/lib/MojoX/0000755000175000001440000000000015000465237015752 5ustar00markovusers00000000000000Log-Report-1.40/lib/MojoX/Log/0000755000175000001440000000000015000465237016473 5ustar00markovusers00000000000000Log-Report-1.40/lib/MojoX/Log/Report.pm0000644000175000001440000000217115000465232020300 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package MojoX::Log::Report;{ our $VERSION = '1.40'; } use Mojo::Base 'Mojo::Log'; # implies use strict etc use Log::Report 'log-report', import => 'report'; sub new(@) { my $class = shift; my $self = $class->SUPER::new(@_); # issue with Mojo, where the base-class registers a function --not # a method-- to handle the message. $self->unsubscribe('message'); # clean all listeners $self->on(message => '_message'); # call it OO $self; } my %level2reason = qw/ debug TRACE info INFO warn WARNING error ERROR fatal ALERT /; sub _message($$@) { my ($self, $level) = (shift, shift); report +{is_fatal => 0} # do not die on errors , $level2reason{$level}, join('', @_); } 1; Log-Report-1.40/lib/MojoX/Log/Report.pod0000644000175000001440000000303115000465233020443 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME MojoX::Log::Report - divert log messages into Log::Report =head1 INHERITANCE MojoX::Log::Report is a Mojo::Log =head1 SYNOPSIS use MojoX::Log::Report; my $log = MojoX::Log::Report->new(%options); $app->log($log); # install logger in the Mojo::App =head1 DESCRIPTION [Included since Log::Report v1.00] Mojo likes to log messages directly into a file, by default. Log::Report constructs a L object first. Be aware that this extension does catch the messages to be logged, but that the dispatching of the error follows a different route now. For instance, you cannot use C<$ENV{MOJO_LOG_LEVEL}> to control the output level, but you need to use L action C. Mojo defines five "levels" of messages, which map onto Log::Report's reasons this way: debug TRACE info INFO warn WARNING error ERROR fatal ALERT =head1 METHODS =head2 Constructors =over 4 =item MojoX::Log::Report-EB(%options) Inherited %options C and C are ignored. =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Dancer/0000755000175000001440000000000015000465237016112 5ustar00markovusers00000000000000Log-Report-1.40/lib/Dancer/Logger/0000755000175000001440000000000015000465237017331 5ustar00markovusers00000000000000Log-Report-1.40/lib/Dancer/Logger/LogReport.pod0000644000175000001440000000455715000465233021761 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Dancer::Logger::LogReport - reroute Dancer logs into Log::Report =head1 INHERITANCE Dancer::Logger::LogReport is a Dancer::Logger::Abstract Dancer::Logger::LogReport is an Exporter =head1 SYNOPSIS # When your main program is not a Dancer object use My::Dancer::App; use Log::Report; ... start dispatcher ... error "something is wrong"; # Log::Report::error() # When your main program is a Dancer object use Dancer; use Dancer::Logger::LogReport; use Log::Report import => 'dispatcher'; ... start dispatcher ... error "something is wrong"; # Dancer::error() # In any case, your main program needs to start log dispatcers # Both Dancer and other Log::Report based modules will send # their messages here: dispatcher FILE => 'default', ...; # In your config logger: log_report logger_format: %i%m # keep it simple log: debug # filtered by dispatchers =head1 DESCRIPTION The L exception/translation framework defines a large number of logging back-ends. The same log messages can be sent to multiple destinations at the same time via flexible dispatchers. When you use this logger in your Dancer application, it will nicely integrate with non-Dancer modules which need logging. Many log back-ends, like syslog, have more levels of system messages. Modules who explicitly load this module can use the missing C, C, C, and C log levels. The C name is provided as well: when you are debugging, you add a 'trace' to your program... its just a better name than 'debug'. You probably want to set a very simple C, because the dispatchers do already add some of the fields that the default C format adds. For instance, to get the filename/line-number in messages depends on the dispatcher 'mode' (f.i. 'DEBUG'). You also want to set the log level to C, because level filtering is controlled per dispatcher (as well) =head1 SEE ALSO This module is part of Log-Report distribution version 1.40, built on April 18, 2025. Website: F =head1 LICENSE Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.40/lib/Dancer/Logger/LogReport.pm0000644000175000001440000000416715000465232021607 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. # This code is part of distribution Log-Report. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Dancer::Logger::LogReport;{ our $VERSION = '1.40'; } use base 'Dancer::Logger::Abstract', 'Exporter'; use strict; use warnings; use Scalar::Util qw/blessed/; use Log::Report 'log-report', import => 'report'; use Log::Report::Dispatcher (); our $AUTHORITY = 'cpan:MARKOV'; our @EXPORT = qw/ trace assert notice alert panic /; my %level_dancer2lr = ( core => 'TRACE' , debug => 'TRACE' ); # Add some extra 'levels' sub trace { goto &Dancer::Logger::debug } sub assert { goto &Dancer::Logger::assert } sub notice { goto &Dancer::Logger::notice } sub panic { goto &Dancer::Logger::panic } sub alert { goto &Dancer::Logger::alert } sub Dancer::Logger::assert { my $l = logger(); $l && $l->_log(assert => _serialize(@_)) } sub Dancer::Logger::notice { my $l = logger(); $l && $l->_log(notice => _serialize(@_)) } sub Dancer::Logger::alert { my $l = logger(); $l && $l->_log(alert => _serialize(@_)) } sub Dancer::Logger::panic { my $l = logger(); $l && $l->_log(panic => _serialize(@_)) } #sub init(@) #{ my $self = shift; # $self->SUPER::init(@_); #} sub _log { my ($self, $level, $params) = @_; # all dancer levels are the same as L::R levels, except: my $msg; if(blessed $params && $params->isa('Log::Report::Message')) { $msg = $params; } else { $msg = $self->format_message($level => $params); $msg =~ s/\n+$//; } # The levels are nearly the same. my $reason = $level_dancer2lr{$level} // uc $level; # Gladly, report() does not get confused between Dancer's use of # Try::Tiny and Log::Report's try() which starts a new dispatcher. report {is_fatal => 0}, $reason => $msg; undef; } 1; Log-Report-1.40/README0000644000175000001440000000142414637476636015055 0ustar00markovusers00000000000000=== README for Log-Report version 1.37 = Generated on Fri Jun 28 11:08:46 2024 by OODoc 2.03 There are various ways to install this module: (1) if you have a command-line, you can do: perl -MCPAN -e 'install ' (2) if you use Windows, have a look at http://ppm.activestate.com/ (3) if you have downloaded this module manually (as root/administrator) gzip -d Log-Report-1.37.tar.gz tar -xf Log-Report-1.37.tar cd Log-Report-1.37 perl Makefile.PL make # optional make test # optional make install For usage, see the included manual-pages or http://search.cpan.org/dist/Log-Report-1.37/ Please report problems to http://rt.cpan.org/Dist/Display.html?Queue=Log-Report Log-Report-1.40/t/0000755000175000001440000000000015000465237014413 5ustar00markovusers00000000000000Log-Report-1.40/t/54try.t0000644000175000001440000000575414637476635015625 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test try() use warnings; use strict; use Test::More; use Log::Report undef, syntax => 'SHORT'; use Carp; # required for tests eval { use POSIX ':locale_h', 'setlocale'; # avoid user's environment setlocale(LC_ALL, 'POSIX'); }; # start a new logger my $text = ''; open my($fh), '>', \$text; dispatcher FILE => 'out', to => $fh, accept => 'NOTICE-', format => sub {shift}; dispatcher close => 'default'; cmp_ok(length $text, '==', 0, 'created normal file logger'); my $text_l1 = length $text; notice "test"; my $text_l2 = length $text; cmp_ok($text_l2, '>', $text_l1); my @l1 = dispatcher 'list'; cmp_ok(scalar(@l1), '==', 1); is($l1[0]->name, 'out'); try { my @l2 = dispatcher 'list'; cmp_ok(scalar(@l2), '==', 2); is($l2[1]->name, 'try', 'only try dispatcher'); error "this is an error"; }; my $caught = $@; # be careful with this... Test::More may spoil it. my @l3 = dispatcher 'list'; cmp_ok(scalar(@l3), '==', 1); is($l3[0]->name, 'out', 'original dispatcher restored'); isa_ok($caught, 'Log::Report::Dispatcher::Try'); ok($caught->failed); ok($caught ? 1 : 0); my @r1 = $caught->exceptions; cmp_ok(scalar(@r1), '==', 1); isa_ok($r1[0], 'Log::Report::Exception'); my @r2 = $caught->wasFatal; cmp_ok(scalar(@r2), '==', 1); isa_ok($r2[0], 'Log::Report::Exception'); eval { try { try { failure "oops! no network" }; $@->reportAll; }; $@->reportAll; }; like($@, qr[^failure: oops]i); ### context my $context; my $scalar = try { $context = !wantarray && defined wantarray ? 'SCALAR' : 'OTHER'; my @x = 1..10; @x; }; is($context, 'SCALAR', 'try in SCALAR context'); cmp_ok($scalar, '==', 10); try { $context = !defined wantarray ? 'VOID' : 'OTHER'; 3; }; is($context, 'VOID', 'try in VOID context'); my @list = try { $context = wantarray ? 'LIST' : 'OTHER'; 1..5; }; is($context, 'LIST', 'try in LIST context'); cmp_ok(scalar @list, '==', 5); ### Bug reported by Andy Beverley 2022-12-17 local $@; try { report {is_fatal => 1}, INFO => __"oops"; } on_die => 'PANIC'; ok defined($@->wasFatal->message), 'Can reach message'; ### convert die/croak/confess # conversions by Log::Report::Die, see t/*die.t my $die = try { die "oops" }; ok(ref $@, 'caught die'); isa_ok($@, 'Log::Report::Dispatcher::Try'); my $die_ex = $@->wasFatal; isa_ok($die_ex, 'Log::Report::Exception'); is($die_ex->reason, 'ERROR'); like("$@", qr[^try-block stopped with ERROR: oops at ] ); my $croak = try { croak "oops2" }; ok(ref $@, 'caught croak'); isa_ok($@, 'Log::Report::Dispatcher::Try'); my $croak_ex = $@->wasFatal; isa_ok($croak_ex, 'Log::Report::Exception'); is($croak_ex->reason, 'ERROR'); like("$@", qr[^try-block stopped with ERROR: oops2 at ] ); my $confess = try { confess "oops3" }; ok(ref $@, 'caught confess'); isa_ok($@, 'Log::Report::Dispatcher::Try'); my $confess_ex = $@->wasFatal; isa_ok($confess_ex, 'Log::Report::Exception'); is($confess_ex->reason, 'PANIC'); like("$@", qr[^try-block stopped with PANIC: oops3 at ] ); done_testing; Log-Report-1.40/t/00use.t0000644000175000001440000000256315000464120015530 0ustar00markovusers00000000000000#!/usr/bin/env perl use warnings; use strict; use Test::More tests => 11; # The versions of the following packages are reported to help understanding # the environment in which the tests are run. This is certainly not a # full list of all installed modules. my @show_versions = qw/ Dancer2 Log::Dispatch Log::Log4perl Mojolicious Plack::Test POSIX PPI String::Print Sys::Syslog Test::Pod XML::LibXML /; # Log::Report::Optional # Log::Report::Lexicon warn "Perl $]\n"; foreach my $package (sort @show_versions) { eval "require $package"; my $report = !$@ ? "version ". ($package->VERSION || 'unknown') : $@ =~ m/^Can't locate/ ? "not installed" : "reports error"; warn "$package $report\n"; } use_ok('Log::Report'); use_ok('Log::Report::Die'); use_ok('Log::Report::Dispatcher'); use_ok('Log::Report::Dispatcher::File'); use_ok('Log::Report::Dispatcher::Try'); use_ok('Log::Report::Dispatcher::Perl'); use_ok('Log::Report::Dispatcher::Callback'); use_ok('Log::Report::Domain'); use_ok('Log::Report::Exception'); use_ok('Log::Report::Message'); use_ok('Log::Report::Translator'); # Log::Report::Dispatcher::Syslog requires optional Sys::Syslog # Log::Report::Dispatcher::LogDispatch requires optional Log::Dispatch # Log::Report::Dispatcher::Log4perl requires optional Log::Log4perl Log-Report-1.40/t/70dancer2.t0000644000175000001440000001554714667530603016311 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use version; use Test::More; BEGIN { eval "require Dancer2"; plan skip_all => 'Dancer2 is not installed' if $@; plan skip_all => "Dancer2 is too old: $Dancer2::VERSION" if version->parse($Dancer2::VERSION) <= 0.207; # for to_app() warn "Dancer2 version $Dancer2::VERSION\n"; eval "require Plack::Test"; $@ and plan skip_all => 'Unable to load Plack::Test'; eval "require HTTP::Cookies"; $@ and plan skip_all => 'Unable to load HTTP::Cookies'; eval "require HTTP::Request::Common"; $@ and plan skip_all => 'Unable to load HTTP::Request::Common'; HTTP::Request::Common->import; plan tests => 4; } { package TestApp; use Dancer2; # Import options can be passed to Log::Report. use Dancer2::Plugin::LogReport 'test_app', import => 'dispatcher'; # or you can just use the plugin to get syntax => 'LONG' # use Dancer2::Plugin::LogReport; set session => 'Simple'; set logger => 'LogReport'; dispatcher close => 'default'; hook before => sub { if (query_parameters->get('is_fatal')) { my $foo; $foo->bar; } }; # Unhandled exception in default route get '/' => sub { my $foo; $foo->bar; }; get '/write_message/:level/:text' => sub { my $level = param('level'); my $text = param('text'); eval qq($level "$text"); }; get '/read_message' => sub { my $all = session 'messages'; my $message = pop @$all or return ''; "$message"; }; get '/process' => sub { process(sub { error "Fatal error text" }); }; get '/show_error/:show_error' => sub { set show_errors => route_parameters->get('show_error'); }; # Route to add custom handlers during later tests get '/add_fatal_handler/:type' => sub { my $type = param 'type'; if ($type eq 'json') { fatal_handler sub { my ($dsl, $msg, $reason) = @_; return unless $dsl->app->request->uri =~ /api/; $dsl->send_as(JSON => {message => $msg->toString}); }; } elsif ($type eq 'html') { fatal_handler sub { my ($dsl, $msg, $reason) = @_; return unless $dsl->app->request->uri =~ /html/; $dsl->send_as(html => "

".$msg->toString."

"); }; } }; } my $url = 'http://localhost'; my $jar = HTTP::Cookies->new(); my $test = Plack::Test->create( TestApp->to_app ); # Basic tests to log messages and read from session subtest 'Basic messages' => sub { # Log a notice message { my $req = GET "$url/write_message/notice/notice_text"; $jar->add_cookie_header($req); my $res = $test->request( $req ); ok $res->is_success, "get /write_message"; $jar->extract_cookies($res); # Get the message $req = GET "$url/read_message"; $jar->add_cookie_header($req); $res = $test->request( $req ); is ($res->content, 'notice_text'); } # Log a trace message { my $req = GET "$url/write_message/trace/trace_text"; $jar->add_cookie_header($req); my $res = $test->request( $req ); ok $res->is_success, "get /write_message"; $jar->extract_cookies($res); # This time it shouldn't make it to the messages session $req = GET "$url/read_message"; $jar->add_cookie_header($req); $res = $test->request( $req ); is ($res->content, ''); } }; # Tests to check fatal errors, and catching with process() subtest 'Throw error' => sub { # Throw an uncaught error. Should redirect. { my $req = GET "$url/write_message/error/error_text"; my $res = $test->request( $req ); ok $res->is_redirect, "get /write_message"; } # The same, this time caught and displayed { my $req = GET "$url/process"; $jar->add_cookie_header($req); my $res = $test->request( $req ); ok $res->is_success, "get /write_message"; is $res->content, '0'; # Check caught message is in session $jar->extract_cookies($res); $req = GET "$url/read_message"; $jar->add_cookie_header($req); $res = $test->request( $req ); is ($res->content, 'Fatal error text'); } }; # Tests to check unexpected exceptions subtest 'Unexpected exception default page' => sub { # An exception generated from the default route which cannot redirect to # the default route, so it throws a plain text error { my $req = GET "$url/"; my $res = $test->request( $req ); ok !$res->is_redirect, "No redirect for exception on default route"; is $res->content, "An unexpected error has occurred", "Plain text exception text correct"; } # The same as previous, but this time we enable the development setting # show_error, which means that the content returned is the actual Perl # error string { # First set show_error parameter $test->request(GET "$url/show_error/1"); my $req = GET "$url/"; my $res = $test->request( $req ); ok !$res->is_redirect, "get /write_message"; like $res->content, qr/Can't call method "bar" on an undefined value/; # Then set show_error back to disabled $test->request(GET "$url/show_error/0"); } # This time the exception occurs in an early hook and we are not able to do # anything as the request hasn't been populated yet. Therefore we should # expect Dancer's default error handling { my $req = GET "$url/?is_fatal=1"; my $res = $test->request( $req ); ok !$res->is_redirect, "get /write_message"; like $res->content, qr/Error 500 - Internal Server Error/; } }; # Tests to check custom fatal error handlers subtest 'Custom handler' => sub { # Add 2 custom fatal handlers - shoudl only match relevant URLs $test->request(GET "$url/add_fatal_handler/json"); $test->request(GET "$url/add_fatal_handler/html"); # Throw uncaught errors to see if correct handlers are called. # JSON (for API) { my $req = GET "$url/write_message/error/api_text"; my $res = $test->request( $req ); ok $res->is_success, "get /write_message"; is $res->content, '{"message":"api_text"}'; } # HTML without redirect { my $req = GET "$url/write_message/error/html_text"; my $res = $test->request( $req ); ok $res->is_success, "get /write_message"; is $res->content, '

html_text

'; } # And default (redirect) { my $req = GET "$url/write_message/error/error_text"; my $res = $test->request( $req ); ok $res->is_redirect, "get /write_message"; } }; done_testing; Log-Report-1.40/t/DieTests.pm0000644000175000001440000001052515000465232016473 0ustar00markovusers00000000000000# Copyrights 2007-2025 by [Mark Overmeer ]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.03. package DieTests;{ our $VERSION = '1.40'; } use warnings; use strict; use Log::Report::Die qw/die_decode/; use Log::Report qw/log-report/; use Carp; use Test::More; BEGIN { plan skip_all => "Error messages on $^O differ too much." if $^O =~ /haiku$/; plan tests => 27; } use DieTests; $! = 3; my $errno = $!+0; my $errstr = "$!"; sub process($) { my $err = shift; my ($opt, $reason, $message) = die_decode $err; # $err =~ s/\d+\.?$/XX/; my $errno = $opt->{errno} || 'no errno'; my $loc = $opt->{location}; my $loca = $loc ? "$loc->[1]#XX" : 'no location'; my $stack = join "\n", map { join '#', $_->[0], $_->[1], 'XX' } @{$opt->{stack}}; my $r = <<__RESULT; $reason: $message ($errno) $loca $stack __RESULT $r =~ s!\\!/!g; # Windows $r; } sub run_tests() { ### #### Testing die_decode itself ### ok(1, "err $errno is '$errstr'"); # die eval { die "ouch" }; my $die_text1 = $@; is(process($die_text1), <<__OUT, "die"); ERROR: ouch (no errno) t/DieTests.pm#XX __OUT eval { die "ouch\n" }; my $die_text2 = $@; is(process($die_text2), <<__OUT, "die"); ERROR: ouch (no errno) no location __OUT eval { $! = $errno; die "ouch $!" }; my $die_text3 = $@; is(process($die_text3), <<__OUT, "die"); FAULT: ouch (3) t/DieTests.pm#XX __OUT eval { $! = $errno; die "ouch $!\n" }; my $die_text4 = $@; is(process($die_text4), <<__OUT, "die"); FAULT: ouch (3) no location __OUT # croak eval { croak "ouch" }; my $croak_text1 = $@; is(process($croak_text1), <<__OUT, "croak"); ERROR: ouch (no errno) t/41die.t#XX __OUT eval { croak "ouch\n" }; my $croak_text2 = $@; is(process($croak_text2), <<__OUT, "croak"); ERROR: ouch (no errno) t/41die.t#XX __OUT eval { $! = $errno; croak "ouch $!" }; my $croak_text3 = $@; is(process($croak_text3), <<__OUT, "croak"); FAULT: ouch (3) t/41die.t#XX __OUT eval { $! = $errno; croak "ouch $!\n" }; my $croak_text4 = $@; is(process($croak_text4), <<__OUT, "croak"); FAULT: ouch (3) t/41die.t#XX __OUT # confess eval { confess "ouch" }; my $confess_text1 = $@; is(process($confess_text1), <<__OUT, "confess"); PANIC: ouch (no errno) t/DieTests.pm#XX eval {...}#t/DieTests.pm#XX DieTests::run_tests()#t/41die.t#XX main::simple_wrapper()#t/41die.t#XX __OUT eval { confess "ouch\n" }; my $confess_text2 = $@; is(process($confess_text2), <<__OUT, "confess"); PANIC: ouch (no errno) t/DieTests.pm#XX eval {...}#t/DieTests.pm#XX DieTests::run_tests()#t/41die.t#XX main::simple_wrapper()#t/41die.t#XX __OUT eval { $! = $errno; confess "ouch $!" }; my $confess_text3 = $@; is(process($confess_text3), <<__OUT, "confess"); FAULT: ouch (3) t/DieTests.pm#XX eval {...}#t/DieTests.pm#XX DieTests::run_tests()#t/41die.t#XX main::simple_wrapper()#t/41die.t#XX __OUT if($^O eq 'MSWin32') { # perl bug http://rt.perl.org/rt3/Ticket/Display.html?id=81586 pass 'Win32/confess bug #81586'; } else { eval { $! = $errno; confess "ouch $!\n" }; my $confess_text4 = $@; is(process($confess_text4), <<__OUT, "confess"); FAULT: ouch (3) t/DieTests.pm#XX eval {...}#t/DieTests.pm#XX DieTests::run_tests()#t/41die.t#XX main::simple_wrapper()#t/41die.t#XX __OUT } ### #### Testing try{} with various die's ## my $r = try { die "Arggghh!"; 1 }; ok(defined $@, "try before you die"); ok(!$r, "no value returned"); isa_ok($@, 'Log::Report::Dispatcher::Try'); my $fatal1 = $@->wasFatal; isa_ok($fatal1, 'Log::Report::Exception'); my $msg1 = $fatal1->message; isa_ok($msg1, 'Log::Report::Message'); is("$msg1", 'Arggghh!'); try { eval "program not perl"; die $@ if $@ }; ok(defined $@, "parse not perl"); my $fatal2 = $@->wasFatal; isa_ok($fatal2, 'Log::Report::Exception'); my $msg2 = $fatal2->message; isa_ok($msg2, 'Log::Report::Message'); like("$msg2", qr/^syntax error at \(eval \d+\) line 1, near \"program not \"/); eval <<'__TEST' try { require "Does::Not::Exist"; }; ok(defined $@, "perl error"); my $fatal3 = $@->wasFatal; isa_ok($fatal3, 'Log::Report::Exception'); my $msg3 = $fatal3->message; isa_ok($msg3, 'Log::Report::Message'); like("$msg3", qr/^Can\'t locate Does\:\:Not\:\:Exist in \@INC /); __TEST } # run_tests() 1; Log-Report-1.40/t/42exc-dbix-class.t0000644000175000001440000000571414637476635017606 0ustar00markovusers00000000000000#!/usr/bin/env perl # Convert dbix exceptions into report use warnings; use strict; use Log::Report; use Log::Report::Die 'exception_decode'; use Test::More; use Data::Dumper; $! = 3; my $errno = $!+0; { # I do not want a dependency: fake implementation of this object package DBIx::Class::Exception; sub new($) { bless { msg => $_[1] }, $_[0] } use overload '""' => sub { shift->{msg} }, fallback => 1; } sub exception($) { DBIx::Class::Exception->new($_[0]) } my $dbix1 = <<__WITHOUT_STACKTRACE; help at /tmp/a.pl line 6. __WITHOUT_STACKTRACE is_deeply [ exception_decode(exception $dbix1) ] , [ { location => [ $0, '/tmp/a.pl', '6', undef ] } , 'ERROR' , 'help' ], 'set 1'; my $dbix2 = <<__WITH_STACKTRACE; main::f(): help at /tmp/a.pl line 6. main::f() called at /tmp/a.pl line 8 main::g() called at /tmp/a.pl line 10 __WITH_STACKTRACE is_deeply [ exception_decode(exception $dbix2) ] , [ { location => [ 'main', '/tmp/a.pl', '6', 'f' ] , stack => [ [ 'main::f', '/tmp/a.pl', '8' ] , [ 'main::g', '/tmp/a.pl', '10' ] ] } , 'PANIC' , 'help' ], 'set 2'; my $dbix3 = <<__WITHOUT_STACKTRACE; # not inside function {UNKNOWN}: help at /tmp/a.pl line 6. __WITHOUT_STACKTRACE is_deeply [ exception_decode(exception $dbix3) ] , [ { location => [ $0, '/tmp/a.pl', '6', undef ] } , 'ERROR' , 'help' ], 'set 3'; my $dbix4 = <<'__FROM_DB'; # contributed by Andrew DBIx::Class::Storage::DBI::_dbh_execute(): DBI Exception: DBD::Pg::st execute failed: ERROR: duplicate key value violates unique constraint "gdpaanswer_pkey" DETAIL: Key (identifier)=(18.5) already exists. [for Statement "INSERT INTO "gdpaanswer" ( "answer", "identifier", "section", "site_id") VALUES ( ?, ?, ?, ?)" with ParamValues: 1='2', 2='18.5', 3='18', 4=undef] at /home/abeverley/git/Isaas/bin/../lib/Isaas/DBIC.pm line 18 __FROM_DB #warn "DBIx4:", Dumper exception_decode(exception $dbix4); is_deeply [ exception_decode(exception $dbix4) ] , [ { location => [ 'DBIx::Class::Storage::DBI' , '/home/abeverley/git/Isaas/bin/../lib/Isaas/DBIC.pm' , '18' , '_dbh_execute' ] } , 'ERROR' , q{DBI Exception: DBD::Pg::st execute failed: ERROR: duplicate key value violates unique constraint "gdpaanswer_pkey" DETAIL: Key (identifier)=(18.5) already exists. [for Statement "INSERT INTO "gdpaanswer" ( "answer", "identifier", "section", "site_id") VALUES ( ?, ?, ?, ?)" with ParamValues: 1='2', 2='18.5', 3='18', 4=undef]} ], 'set 4'; ### Test automatic conversion try { die exception $dbix1 }; my $exc = $@->wasFatal; isa_ok $exc, 'Log::Report::Exception'; is "$exc", "error: help\n"; my $msg = $exc->message; isa_ok $msg, 'Log::Report::Message'; is $msg->toString, 'help'; ### Test report with object try { error exception $dbix1 }; my $err = $@->wasFatal; isa_ok $err, 'Log::Report::Exception'; is "$err", "error: help at /tmp/a.pl line 6.\n"; done_testing; 1; Log-Report-1.40/t/12missing.t0000644000175000001440000000206414637476635016441 0ustar00markovusers00000000000000#!/usr/bin/env perl # Try reporting of misisng parameter. use warnings; use strict; use lib 'lib', '../lib'; use Test::More; use Log::Report; # no domains, no translator use Scalar::Util qw/refaddr/; dispatcher close => 'default'; my $a = __x"testA {a}", a => undef; isa_ok($a, 'Log::Report::Message'); is $a->toString, "testA undef"; ### warn on normal message my $linenr = __LINE__ + 1; my $b = __x"testB {b}"; my $bs = try { $b->toString }; (my $warning) = $@->exceptions; isa_ok $warning, 'Log::Report::Exception'; is $bs, "testB undef"; is $warning->reason, 'WARNING'; is $warning->message, "Missing key 'b' in format 'testB {b}', file $0 line $linenr"; ### warn on exception $linenr = __LINE__ + 1; try { error __x"testC {c}" }; my $error = $@->wasFatal; my $cs = try { $error->toString }; ($warning) = $@->exceptions; isa_ok $warning, 'Log::Report::Exception'; is $cs, "error: testC undef\n"; is $warning->reason, 'WARNING'; is $warning->message, "Missing key 'c' in format 'testC {c}', file $0 line $linenr"; done_testing; Log-Report-1.40/t/43exc-xml-libxml.t0000644000175000001440000000220115000464120017572 0ustar00markovusers00000000000000#!/usr/bin/env perl # Convert XML::LibXML exceptions into report use warnings; use strict; use Log::Report; use Log::Report::Die 'exception_decode'; use Test::More; #use Data::Dumper; BEGIN { eval 'require XML::LibXML::Error'; plan skip_all => 'XML::LibXML::Error not available' if $@; eval 'require XML::LibXML'; plan skip_all => 'Your installation of XML::LibXML is broken' if $@; } # The XML::LibXML::Error object does not have a constructor, so we # need to trigger one. my $xml = eval { XML::LibXML->load_xml(string => \'') }; ok ! defined $xml, 'parse broken xml'; my $error = $@; isa_ok $error, 'XML::LibXML::Error'; #warn Dumper exception_decode($error); my @dec = exception_decode($error); my $msg = pop @dec; # error code changed from libxml2 2.9.9 to 2.9.10 my $rc = delete $dec[0]{errno}; $dec[0]{errno} = 'RC'; cmp_ok $rc, '>', 13000, 'error code'; is_deeply \@dec, , [ { location => [ 'libxml', '', '1', 'parser' ], errno => 'RC' } , 'ERROR' ], 'error 1'; # the message may vary over libxml2 versions $msg =~ s/\r?\n\s*/ /g; like $msg, qr/bad\-xml|Start tag expected/, $msg; done_testing; 1; Log-Report-1.40/t/11concat.t0000644000175000001440000000211514637476635016233 0ustar00markovusers00000000000000#!/usr/bin/env perl # Try concatenation use warnings; use strict; use lib 'lib', '../lib'; use Test::More tests => 16; use Log::Report; # no domains, no translator use Scalar::Util qw/refaddr blessed/; ### examples from Log::Report::Message and more my $a = __"Hello"; isa_ok($a, 'Log::Report::Message'); my $b = $a . " World!\n"; isa_ok($b, 'Log::Report::Message'); cmp_ok(refaddr $a, '!=', refaddr $b); # must clone is("$b", "Hello World!\n"); my $c = 'a' . 'b' . __("c") . __("d") . "e" . __("f"); isa_ok($c, 'Log::Report::Message'); is("$c", "abcdef"); is($c->prepend, 'ab'); isa_ok($c->append, 'Log::Report::Message'); is($c->msgid, 'c'); is($c->untranslated->toString, 'abcdef'); my $d = __("Hello")->concat(' ')->concat(__"World!")->concat("\n"); isa_ok($d, 'Log::Report::Message'); is("$d", "Hello World!\n"); is($d->untranslated->toString, "Hello World!\n"); my $h = __"Hello"; my $w = __"World!"; my $e = "$h $w\n"; isa_ok($e, 'Log::Report::Message'); is("$e", "Hello World!\n"); ### issue #123835 ok ! blessed(($h.$w)->toString), 'append/prepend must be stringified as well'; Log-Report-1.40/t/09message.t0000644000175000001440000000257014637476635016424 0ustar00markovusers00000000000000#!/usr/bin/env perl # Try constructing a message object use warnings; use strict; use Test::More tests => 22; use Scalar::Util 'refaddr'; use Log::Report; use Log::Report::Message; ### direct creation my $msg = Log::Report::Message->new ( _msgid => 'try' , _domain => 'test' , _class => 'monkey, donkey' , var => 42 ); ok(defined $msg, 'created message manually'); isa_ok($msg, 'Log::Report::Message'); is($msg->msgid, 'try'); is($msg->domain, 'test'); is($msg->valueOf('_domain'), 'test'); is($msg->valueOf('var'), 42); my @c = $msg->classes; cmp_ok(scalar @c, '==', 2, 'list classes'); is($c[0], 'monkey'); is($c[1], 'donkey'); ok($msg->inClass('monkey'), 'inClass'); ok($msg->inClass('donkey')); is($msg->inClass( qr/^d/ ), 'donkey'); is($msg->inClass( qr/key/ ), 'monkey'); ### indirect creation, non-translated try { report ERROR => 'not translated', _classes => 'one two' }; my $err = $@; isa_ok($err, 'Log::Report::Dispatcher::Try'); my $fatal = $err->wasFatal; isa_ok($fatal, 'Log::Report::Exception'); my $message = $fatal->message; isa_ok($message, 'Log::Report::Message'); is("$message", 'not translated', 'untranslated'); is($message->inClass('one'), 'one'); is($message->inClass('two'), 'two'); is($fatal->inClass('two'), 'two'); my $fatal2 = $err->wasFatal(class => 'two'); isa_ok($fatal2, 'Log::Report::Exception'); cmp_ok(refaddr $fatal, '==', refaddr $fatal2); Log-Report-1.40/t/31stack.t0000644000175000001440000000110014637476635016064 0ustar00markovusers00000000000000#!/usr/bin/env perl # test the lexicon index. use warnings; use strict; use lib 'lib', '../lib'; use Test::More tests => 1; use Log::Report; use Log::Report::Dispatcher; my $stack; my $start = __LINE__; sub hhh(@) { $stack = Log::Report::Dispatcher->collectStack(3) } sub ggg(@) { shift; hhh(@_) } sub fff(@) { ggg(reverse @_) } fff(42, 3.2, "this is a text"); is_deeply($stack, [ [ 'main::hhh(3.2, 42)', $0, $start+2 ] , [ 'main::ggg("this is a text", 3.2, 42)', $0, $start+3 ] , [ 'main::fff(42, 3.2, "this is a text")', $0, $start+5 ] ] ); Log-Report-1.40/t/53log4perl.t0000644000175000001440000000345214637476635016527 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test Log::Log4perl (only very simple tests) use warnings; use strict; use File::Temp qw/tempfile/; use Test::More; use Fcntl qw/SEEK_CUR/; use Log::Report undef, syntax => 'SHORT'; BEGIN { eval "require Log::Log4perl"; plan skip_all => 'Log::Log4perl not installed' if $@; my $sv = Log::Log4perl->VERSION; eval { Log::Log4perl->VERSION(1.00) }; plan skip_all => "Log::Log4perl too old (is $sv, requires 1.00)" if $@; plan tests => 5; } my ($out, $outfn) = tempfile; my $name = 'logger'; # adapted from the docs my $conf = <<__CONFIG; log4perl.category.$name = INFO, Logfile log4perl.appender.Logfile = Log::Log4perl::Appender::File log4perl.appender.Logfile.filename = $outfn log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout log4perl.appender.Logfile.layout.ConversionPattern = %d %F{2} %L> %m %n __CONFIG dispatcher LOG4PERL => $name, config => \$conf; dispatcher close => 'default'; cmp_ok(-s $outfn, '==', 0); my $date_qr = qr!\d{4}/\d{2}/\d{2} \d{2}:\d{2}:\d{2}!; my ($line_number, $log_line, $expected_msg); notice "this is a test"; $line_number = __LINE__; my $s1 = -s $outfn; cmp_ok($s1, '>', 0); $log_line = <$out>; #warn "LINE1 = $log_line"; $log_line =~ s!\\!/!g; # windows $expected_msg = "$line_number> notice: this is a test"; # do not anchor at the end: $ does not match on Windows like($log_line, qr!^$date_qr t[/\\]53log4perl\.t \Q$expected_msg\E!); warning "some more"; $line_number = __LINE__; my $s2 = -s $outfn; cmp_ok $s2, '>', $s1; seek $out, 0, SEEK_CUR; $log_line = <$out>; #warn "LINE2 = $log_line"; $log_line =~ s!\\!/!g; # windows $expected_msg = "$line_number> warning: some more"; like($log_line, qr!^$date_qr t[/\\]53log4perl\.t \Q$expected_msg\E!); unlink $outfn; Log-Report-1.40/t/52logdisp.t0000644000175000001440000000165014637476635016435 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test Log::Dispatch (only very simple tests) use warnings; use strict; use lib 'lib', '../lib'; use File::Temp qw/tempfile/; use Test::More; use Log::Report undef, syntax => 'SHORT'; BEGIN { eval "require Log::Dispatch"; plan skip_all => 'Log::Dispatch not installed' if $@; my $sv = Log::Dispatch->VERSION; eval { Log::Dispatch->VERSION(2.00) }; plan skip_all => "Log::Dispatch too old (is $sv, requires 2.00)" if $@; plan tests => 5; use_ok('Log::Report::Dispatcher::LogDispatch'); } use_ok('Log::Dispatch::File'); my ($out, $outfn) = tempfile; dispatcher 'Log::Dispatch::File' => 'logger' , filename => $outfn , to_level => ['ALERT-' => 'err']; dispatcher close => 'default'; cmp_ok(-s $outfn, '==', 0); notice "this is a test"; my $s1 = -s $outfn; cmp_ok($s1, '>', 0); warning "some more"; my $s2 = -s $outfn; cmp_ok($s2, '>', $s1); unlink $outfn; Log-Report-1.40/t/55throw.t0000644000175000001440000000157714637476635016152 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test throw() use warnings; use strict; use Test::More tests => 9; use Log::Report undef, syntax => 'SHORT'; eval { use POSIX ':locale_h', 'setlocale'; # avoid user's environment setlocale(LC_ALL, 'POSIX'); }; # start a new logger my $text = ''; open my($fh), '>', \$text; dispatcher close => 'default'; dispatcher FILE => 'out', to => $fh, accept => 'ALL', format => sub {shift}; cmp_ok(length $text, '==', 0, 'file logger'); try { error "test" }; ok($@, 'caugth rethrown error'); my $e1 = $@->wasFatal; isa_ok($e1, 'Log::Report::Exception'); is($e1->reason, 'ERROR'); my $m1 = $e1->message; isa_ok($m1, 'Log::Report::Message'); is("$m1", 'test'); # Now, rethrow the exception try { $e1->throw(reason => 'ALERT') }; ok(!$@, 'caught rethrown, non fatal'); my @e2 = $@->exceptions; cmp_ok(scalar @e2, '==', 1); my $e2 = $e2[0]; is("$e2", "alert: test\n"); Log-Report-1.40/t/51syslog.t0000644000175000001440000000111614637476635016310 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test syslog, but only mildly use warnings; use strict; use Test::More; use Log::Report undef, syntax => 'SHORT'; BEGIN { eval "require Sys::Syslog"; plan skip_all => 'Sys::Syslog not installed' if $@; my $sv = Sys::Syslog->VERSION; eval { Sys::Syslog->VERSION(0.11) }; plan skip_all => "Sys::Syslog too old (is $sv, requires 0.11)" if $@; plan tests => 1; use_ok('Log::Report::Dispatcher::Syslog'); } dispatcher SYSLOG => 'syslog', to_prio => ['ALERT-' => 'err']; dispatcher close => 'default'; notice "this is a test"; Log-Report-1.40/t/41die.t0000644000175000001440000000051614637476635015533 0ustar00markovusers00000000000000#!/usr/bin/env perl # Convert die into report use warnings; use strict; use lib 't'; use POSIX; eval { setlocale(LC_ALL, 'POSIX') }; $! = 3; my $errno = $!+0; my $errstr = "$!"; #### Carp only works in package != main use DieTests; # we need a short stack trace sub simple_wrapper() { DieTests::run_tests() } simple_wrapper(); Log-Report-1.40/t/60mojo.t0000644000175000001440000000155114637476635015737 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test MojoX::Log::Report use warnings; use strict; use lib 'lib', '../lib'; use Test::More; use Log::Report undef; use Data::Dumper; BEGIN { eval "require Mojolicious"; plan skip_all => 'Mojolicious is not installed' if $@; plan skip_all => 'installed Mojolicious too old (requires 2.16)' if $Mojolicious::VERSION < 2.16; plan tests => 7; } use_ok('MojoX::Log::Report'); my $log = MojoX::Log::Report->new; isa_ok($log, 'MojoX::Log::Report'); isa_ok($log, 'Mojo::Log'); my $tmp; dispatcher close => 'default'; try { $log->error("going to die"); $tmp = 42 } mode => 3; my $err = $@; #warn Dumper $err; cmp_ok($tmp, '==', 42, 'errors not cast directly'); ok($err->success, 'block continued succesfully'); my @exc = $err->exceptions; cmp_ok(scalar @exc, '==', 1, "caught 1"); is("$exc[0]", "error: going to die\n"); Log-Report-1.40/t/10interp.t0000644000175000001440000001130514637476635016265 0ustar00markovusers00000000000000#!/usr/bin/env perl # Try __ use warnings; use strict; use lib 'lib', '../lib'; use Test::More tests => 69; use Log::Report; # no domains, no translator use Scalar::Util qw/reftype/; ### examples from Log::Report::Message and more # Check overloading sub ol_is($$;$) { # since Test::More 0.95_01, is() does not stringify its arguments. # This means that overloading does not kick in. How to test # overloading now? my ($f, $s, $comment) = @_; overload::Overloaded($f) || overload::Overloaded($s) or die "both not overloaded, in '$f' and '$s'"; is("$f", "$s", $comment); } my $a = __"Hello"; ok(defined $a); is(ref $a, 'Log::Report::Message'); is(reftype $a, 'HASH'); ol_is(__"Hello World", 'Hello World'); ol_is(__"Hello World {a}", 'Hello World {a}'); ol_is(__('Hello World {a}'), 'Hello World {a}'); my $c = __x"Hello"; ok(defined $c); is(ref $c, 'Log::Report::Message'); is(reftype $c, 'HASH'); ol_is(__x("Hello World", a => 42), 'Hello World'); ol_is(__x("Hello World {a}", a => 42), 'Hello World 42'); ol_is((__x"Hello World {a}", a => 42), 'Hello World 42'); ol_is((__x "Hello World {a}", a => 42), 'Hello World 42'); ol_is((__x "{a}{a}{a}", a => 42), '424242'); my $d = __n"Hello","World",3; ok(defined $d); is(ref $d, 'Log::Report::Message'); is(reftype $d, 'HASH'); ol_is(__n("Hello", "World", 1), 'Hello'); ol_is(__n("Hello", "World", 0), 'World'); ol_is(__n("Hello", "World", 2), 'World'); my $e = __nx"Hello","World",3,a=>42; ok(defined $e); is(ref $e, 'Log::Report::Message'); is(reftype $e, 'HASH'); ol_is(__nx("Hel{a}lo", "Wor{a}ld", 1,a=>42), 'Hel42lo'); ol_is(__nx("Hel{a}lo", "Wor{a}ld", 0,a=>42), 'Wor42ld'); ol_is(__nx("Hel{a}lo", "Wor{a}ld", 2,a=>42), 'Wor42ld'); ol_is(__xn("Hel{a}lo", "Wor{a}ld", 2,a=>42), 'Wor42ld'); my $e1 = 1; ol_is((__nx "one", "more", $e1++), "one"); ol_is((__nx "one", "more", $e1), "more"); my @files = 'monkey'; my $nr_files = @files; ol_is((__nx "one file", "{_count} files", $nr_files), 'one file'); ol_is((__nx "one file", "{_count} files", @files), 'one file'); push @files, 'donkey'; $nr_files = @files; ol_is((__nx "one file", "{_count} files", $nr_files), '2 files'); ol_is((__nx "one file", "{_count} files", @files), '2 files'); my $f = N__"Hi"; ok(defined $f); is(ref $f, ''); is(N__"Hi", "Hi"); is((N__"Hi"), "Hi"); is(N__("Hi"), "Hi"); my @g = N__n "Hi", "bye"; cmp_ok(scalar @g, '==', 2); is($g[0], 'Hi'); is($g[1], 'bye'); # # Use _count directly # ol_is(__nx("single {_count}", "multi {_count}", 0), 'multi 0'); ol_is(__nx("single {_count}", "multi {_count}", 1), 'single 1'); ol_is(__nx("single {_count}", "multi {_count}", 2), 'multi 2'); # # Expand arrays # { local $" = ', '; my @one = 'rabbit'; ol_is((__x "files: {f}", f => \@files), "files: monkey, donkey", 'check join on $"'); ol_is((__xn "one file: {f}", "{_count} files: {f}", @files, f => \@files), "2 files: monkey, donkey"); ol_is((__x "files: {f}", f => \@one), "files: rabbit"); ol_is((__xn "one file: {f}", "{_count} files: {f}", @one, f => \@one), "one file: rabbit"); } { local $" = '#'; ol_is((__x "files: {f}", f => \@files), "files: monkey#donkey"); ol_is((__x "files: {f}", f => \@files, _join => ', ') , "files: monkey, donkey", 'check _join'); } # # clone # my $s2 = __x "found {nr} files", nr => 5; my $t2 = $s2->(nr => 3); isa_ok($t2, 'Log::Report::Message'); ol_is($s2, 'found 5 files'); ol_is($t2, 'found 3 files'); # clone by overload my $s = __x "A={a};B={b}", a=>11, b=>12; isa_ok($s, 'Log::Report::Message'); is(reftype $s, 'HASH'); is($s->toString, "A=11;B=12"); my $t = $s->(b=>13); isa_ok($t, 'Log::Report::Message'); is(reftype $t, 'HASH'); isnt("$s", "$t"); is($t->toString, "A=11;B=13"); is($s->toString, "A=11;B=12"); # unchanged # # format # use constant PI => 4 * atan2(1, 1); my $approx = 'approx pi: 3.141593'; my $approx2 = sprintf "approx pi: %.6f", PI; $approx2 =~ s/,/./g; # locale numeric :( is($approx2, $approx, 'sprintf'); ol_is((__x "approx pi: {approx}", approx => sprintf("%.6f", PI)), $approx, 'sprintf nested'); my $app = __x "approx pi: {pi%.6f}", pi => PI; $app =~ s/\,/./g; # translated under locale, which may use ',' is($app, $approx, 'interpolated format'); ol_is((__x "{perms} {links%2d} {user%-8s} {size%8d} {fn}" , perms => '-rw-r--r--', links => 1, user => 'superman' , size => '1234567', fn => '/etc/profile') , '-rw-r--r-- 1 superman 1234567 /etc/profile'); # # trailing newline # my $msg1 = __x"who am i\n \n "; is($msg1->msgid, 'who am i', 'ignore white-space at the end'); is($msg1->append, "\n \n "); my $msg2 = __x"\n \t who am i"; is($msg2->msgid, 'who am i', 'ignore white-space before '); is($msg2->prepend, "\n \t "); Log-Report-1.40/t/50file.t0000644000175000001440000000600314637476635015706 0ustar00markovusers00000000000000#!/usr/bin/env perl # test the file back-end, without translations use warnings; use strict; use Test::More tests => 39; use Log::Report; use POSIX 'locale_h'; setlocale(LC_ALL, 'en_US'); my @disp = dispatcher 'list'; cmp_ok(scalar(@disp), '==', 1); isa_ok($disp[0], 'Log::Report::Dispatcher'); # start new dispatcher to file my $file1 = ''; open my($fh1), ">", \$file1 or die $!; my $d = dispatcher FILE => 'file1', to => $fh1, format => sub {shift}; @disp = dispatcher 'list'; cmp_ok(scalar(@disp), '==', 2); ok(defined $d, 'created file dispatcher'); isa_ok($d, 'Log::Report::Dispatcher::File'); ok($d==$disp[0] || $d==$disp[1], 'in disp list'); ok(!$d->isDisabled); is($d->name, 'file1'); my @needs = $d->needs; cmp_ok(scalar(@needs), '>', 7, 'needs'); is($needs[0], 'NOTICE'); is($needs[-1], 'PANIC'); # start a second dispatcher to a file, which does accept everything # trace-info. my $file2 = ''; open my($fh2), ">", \$file2 or die $!; my $e = dispatcher FILE => 'file2' , format_reason => 'UPPERCASE' , to => $fh2, accept => '-INFO' , format => sub {shift}; ok(defined $e, 'created second disp'); isa_ok($e, 'Log::Report::Dispatcher::File'); @disp = dispatcher 'list'; cmp_ok(scalar(@disp), '==', 3); @needs = $e->needs; cmp_ok(scalar(@needs), '>=', 3, 'needs'); is($needs[0], 'TRACE'); is($needs[-1], 'INFO'); # silence default dispatcher for tests dispatcher close => 'default'; @disp = dispatcher 'list'; cmp_ok(scalar(@disp), '==', 2); # # Start producing messages # cmp_ok(length $file1, '==', 0); cmp_ok(length $file2, '==', 0); trace "trace"; cmp_ok(length $file1, '==', 0, 'disp1 ignores trace'); my $t = length $file2; cmp_ok($t, '>', 0, 'disp2 take trace'); is($file2, "TRACE: trace\n"); my $linenr = __LINE__ +1; assert "assertive"; cmp_ok(length $file1, '==', 0, 'disp1 ignores assert'); my $t2 = length $file2; cmp_ok($t2, '>', $t, 'disp2 take assert'); is(substr($file2, $t), "ASSERT: assertive\n at $0 line $linenr\n"); info "just to inform you"; cmp_ok(length $file1, '==', 0, 'disp1 ignores info'); my $t3 = length $file2; cmp_ok($t3, '>', $t2, 'disp2 take info'); is(substr($file2, $t2), "INFO: just to inform you\n"); notice "note this!"; my $s = length $file1; cmp_ok($s, '>', 0, 'disp1 take notice'); is($file1, "notice: note this!\n"); # format_reason LOWERCASE my $t4 = length $file2; cmp_ok($t4, '==', $t3, 'disp2 ignores notice'); warning "oops, be warned!"; my $s2 = length $file1; cmp_ok($s2, '>', $s, 'disp1 take warning'); like(substr($file1, $s), qr/^warning: oops, be warned!/); my $t5 = length $file2; cmp_ok($t5, '==', $t4, 'disp2 ignores warnings'); # # test filters # my (@messages, @messages2); dispatcher filter => sub { push @messages, $_[3]; @_[2,3] }, 'file1'; dispatcher filter => sub { push @messages2, $_[3]; @_[2,3] }, 'file2'; notice "here are"; cmp_ok(scalar(@messages), '==', 1, 'capture message'); is($messages[0]->toString, 'here are', 'toString'); is($messages[0]->toHTML, 'here <we> are', 'toHTML'); cmp_ok(scalar(@messages2), '==', 0, 'do not capture message'); Log-Report-1.40/examples/0000755000175000001440000000000015000465237015766 5ustar00markovusers00000000000000Log-Report-1.40/examples/dancer/0000755000175000001440000000000015000465237017222 5ustar00markovusers00000000000000Log-Report-1.40/examples/dancer/dancer1.pl0000644000175000001440000000121214637476635021113 0ustar00markovusers00000000000000#!/usr/bin/env perl # Daemon at localhost:3000 use Dancer; use Dancer::Logger::LogReport; use Log::Report import => 'dispatcher'; dispatcher FILE => 'logfile' # open additional log destination # , mode => 'DEBUG' # extended information , to => '/tmp/dancer-demo.log'; dispatcher close => 'default'; # closes warn/die default dispatcher set logger => 'log_report'; set log => 'debug'; set logger_format => 'LOG: %i%m'; get '/' => sub { error "we reached the log"; # use Dancer's error() syntax! notice "one more"; # additional levels, same syntax return "Hello World!\n"; }; start; Log-Report-1.40/MANIFEST0000644000175000001440000000354615000465237015311 0ustar00markovusers00000000000000ChangeLog MANIFEST Makefile.PL README README.md examples/dancer/dancer1.pl lib/Dancer/Logger/LogReport.pm lib/Dancer/Logger/LogReport.pod lib/Dancer2/Logger/LogReport.pm lib/Dancer2/Logger/LogReport.pod lib/Dancer2/Plugin/LogReport.pm lib/Dancer2/Plugin/LogReport.pod lib/Dancer2/Plugin/LogReport/Message.pm lib/Dancer2/Plugin/LogReport/Message.pod lib/Log/Report.pm lib/Log/Report.pod lib/Log/Report/DBIC/Profiler.pm lib/Log/Report/DBIC/Profiler.pod lib/Log/Report/Die.pm lib/Log/Report/Die.pod lib/Log/Report/Dispatcher.pm lib/Log/Report/Dispatcher.pod lib/Log/Report/Dispatcher/Callback.pm lib/Log/Report/Dispatcher/Callback.pod lib/Log/Report/Dispatcher/File.pm lib/Log/Report/Dispatcher/File.pod lib/Log/Report/Dispatcher/Log4perl.pm lib/Log/Report/Dispatcher/Log4perl.pod lib/Log/Report/Dispatcher/LogDispatch.pm lib/Log/Report/Dispatcher/LogDispatch.pod lib/Log/Report/Dispatcher/Perl.pm lib/Log/Report/Dispatcher/Perl.pod lib/Log/Report/Dispatcher/Syslog.pm lib/Log/Report/Dispatcher/Syslog.pod lib/Log/Report/Dispatcher/Try.pm lib/Log/Report/Dispatcher/Try.pod lib/Log/Report/Domain.pm lib/Log/Report/Domain.pod lib/Log/Report/Exception.pm lib/Log/Report/Exception.pod lib/Log/Report/Message.pm lib/Log/Report/Message.pod lib/Log/Report/Translator.pm lib/Log/Report/Translator.pod lib/Log/Report/messages/first-domain.utf-8.po lib/Log/Report/messages/log-report.utf-8.po lib/Log/Report/messages/log-report/nl_NL.po lib/MojoX/Log/Report.pm lib/MojoX/Log/Report.pod t/00use.t t/09message.t t/10interp.t t/11concat.t t/12missing.t t/31stack.t t/41die.t t/42exc-dbix-class.t t/43exc-xml-libxml.t t/50file.t t/51syslog.t t/52logdisp.t t/53log4perl.t t/54try.t t/55throw.t t/60mojo.t t/70dancer2.t t/DieTests.pm xt/99pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Log-Report-1.40/xt/0000755000175000001440000000000015000465237014603 5ustar00markovusers00000000000000Log-Report-1.40/xt/99pod.t0000644000175000001440000000041614637476635015760 0ustar00markovusers00000000000000#!/usr/bin/env perl use warnings; use strict; use Test::More; BEGIN { eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; plan skip_all => "devel home uses OODoc" if $ENV{MARKOV_DEVEL}; } all_pod_files_ok(); Log-Report-1.40/Makefile.PL0000644000175000001440000000453115000464120016113 0ustar00markovusers00000000000000use ExtUtils::MakeMaker; use 5.010; my $version = '1.40'; my %prereq = ( Test::More => '0.86' , Sys::Syslog => '0.27' , Encode => '2.00' , Scalar::Util => 0 , Devel::GlobalDestruction => '0.09' , Log::Report::Optional => '1.07' , String::Print => '0.91' ); # Upgrade L::R::Lexicon if installed eval "require Log::Report::Extract"; #warn $@; unless($@) { my $v = $Log::Report::Extract::VERSION || '1.00'; if($v < 1.00) { warn <<'__CHANGES_100'; sleep 10 } *************************************************************** WARNING: with Log::Report 1.00, the distribution got spit into four separate components. If you use *translations*, then you have to upgrade Log::Report::Lexicon as well. You may need to add dependencies to that module as well. *************************************************************** __CHANGES_100 } #use Data::Dumper; #warn Dumper \%prereq; WriteMakefile ( NAME => 'Log::Report' , VERSION => $version , PREREQ_PM => \%prereq , AUTHOR => 'Mark Overmeer ' , ABSTRACT => 'report a problem, pluggable handlers and language support' , LICENSE => 'perl_5' , META_MERGE => { 'meta-spec' => { version => 2 } , resources => { repository => { type => 'git' , url => 'https://github.com/markov2/perl5-Log-Report.git' , web => 'https://github.com/markov2/perl5-Log-Report' } , homepage => 'http://perl.overmeer.net/CPAN/' , license => [ 'http://dev.perl.org/licenses/' ] } } ); sub MY::postamble { <<'__POSTAMBLE' } # for OODoc's oodist, DIST RAWDIR = ../public_html/log-report/raw DISTDIR = ../public_html/log-report/source # for OODoc's oodist, POD FIRST_YEAR = 2007 EMAIL = markov@cpan.org WEBSITE = http://perl.overmeer.net/CPAN/ EXTENDS = ../Log-Report-Optional:../String-Print:../Log-Report-Lexicon:../Log-Report-Template SKIP_LINKS = Dancer2::Config # for OODoc's oodist, HTML HTML_OUTPUT = ../public_html/logreport/html HTML_DOCROOT = /logreport/html HTML_PACKAGE = ../public_html/log-report/htmlpkg __POSTAMBLE # for translation tables #linkext:: # ../Log-Report-Lexicon/bin/xgettext-perl --mode=VERBOSE -p lib/Log/Report/messages lib Log-Report-1.40/ChangeLog0000644000175000001440000007421415000465232015725 0ustar00markovusers00000000000000 ==== version history of distribution Log::Report Unless noted otherwise, these changes where initiated and applied by Mark Overmeer. TODO: . connect to Message::Passing framework version 1.40: Fri 18 Apr 17:05:09 CEST 2025 Fixes: - own translation tables contained stuff moved to Lexicon Improvements: - reduce number of textdomain lookups at import. - refer to Dancer2::Template::TTLogReport - show version of XML::LibXML for tests 42/43 - fix test for libxml2 use [cpantesters] version 1.39: Mon 9 Sep 19:57:06 CEST 2024 Fixes: - fix output of error [Andy Beverley] version 1.38: Mon 9 Sep 11:00:15 CEST 2024 Fixes: - Require Dancer2 >= 0.207 for test [cpantesters], [GitHub issue #13] - error code must be set when the script exists with error or panic [Any Beverley] Improvements: - add _errno attribute to messages version 1.37: Fri 28 Jun 11:08:19 CEST 2024 Fixes: - Work with Dancer2 change to send_as [Andy Beverley] version 1.36: Fri 27 Oct 15:05:13 CEST 2023 Fixes: - Adapt test to new Dancer2 numbering scheme. [Petr Pisar] version 1.35: Fri 27 Oct 08:27:54 CEST 2023 Fixes: - Try blocks will always capture fatal messages, even when not in the 'accept'-set. [Andy Beverley] - Adapt to new Dancer2 numbering scheme. [Tom Hukins] Improvements: - Dancer2 process() will warn when used incorrectly. [Andy Beverley] version 1.34: Thu 15 Sep 09:43:40 CEST 2022 Fixes: - ::Exception::isFatal() did not respect the is_fatal overrule. Spotted by [Andy Berverley] version 1.33: Sat Jul 17 10:56:52 CEST 2021 Changes: - the $@->died with always return the original die causing object or string. In most cases, you want to use $@->wasFatal, which is the translated (hence compatible) ::Exception object. [Andy Beverley] version 1.32: Tue 26 Jan 09:13:31 CET 2021 Fixes: - ::Dancer2, use correct VERSION, github issue#3 - ::Dancer2, fix stacktrace sent to browser with show_errors disabled by [Andy Beverley], github issue#7 version 1.31: Fri 15 Jan 16:35:39 CET 2021 Fixes: - another attempt on issue #6, exceptions with specific destination are not caught by ::Try - previous release broke ::Try::hide() [Andy Beverley] version 1.30: Fri 15 Jan 12:46:14 CET 2021 Fixes: - recursive errors when file cannot be written for ::File dispatcher github issue#4 [Tom Hukins] - exceptions with specific destination are not caught by ::Try github issue#6 [Andy Beverley] - redirected exception messages forget their explicit dispatcher destination. Github issue#6 Improvements: - use ::Util::expand_reasons() for ::Try::hide() - require Log::Report::Options 1.07 for more expand_reasons options version 1.29: Fri 8 Nov 09:18:01 CET 2019 Fixes: - error code changed from libxml2 2.9.9 to 2.9.10 rt.cpan.org#130934 [Petr Pisar] Improvements: - skip tests with error messages for Haiku, because they are quite different. [cpantesters] version 1.28: Tue 14 May 09:27:50 CEST 2019 Fixes: - Dancer2 version 0.166001 is too old as well. [cpantesters] - call to wasFatal($class)/reportFatal($class) without exception autovivified an 'undef' in the exception list. [Andrew Beverley] - fatal exception not always the last in try() block. version 1.27: Fri 1 Jun 10:00:10 CEST 2018 Fixes: - fix metadata [Mohammad S Anwar] Improvements: - Dancer2 add custom fatal handlers [Andrew Beverley] version 1.26: Tue Jan 23 23:45:55 CET 2018 Improvements: - convert to GIT - publish via GitHUB version 1.25: Fri 8 Dec 09:18:23 CET 2017 Fixes: - $msg->tostring on append/prepend object lost $locale. version 1.24: Fri 8 Dec 09:10:18 CET 2017 Fixes: - $msg->toString should stringify when append/prepend are objects. rt.cpan.org#123835 [Andy Beverley] Improvements: - Log4perl dispatcher: do accept init of Log::Log4perl outside the dispatcher [Abe Timmerman] version 1.23: Thu 2 Nov 10:40:24 CET 2017 Improvements: - understand objects in report() rt.cpan.org #123241 [Andy Beverley] - understand DBIx::Class::Exception in try{} - understand XML::LibXML::Error in try{} version 1.22: Thu 12 Oct 12:18:54 CEST 2017 Improvements: - try() also collects DEBUG info when one of the dispatches wants it. - document that ::Translator::POT does not require charset anymore. - support __p, __px, etc from Locale::TextDomain version 1.21: Mon 3 Jul 15:31:19 CEST 2017 Fixes: - _prepend and _append texts doubled. rt.cpan.org#122304 [Andreas Koenig] - accidental stringification of exceptions rt.cpan.org#122324 [Slaven Rezic] Improvements: - also \n of msgid moves to _prepend or _append version 1.20: Tue 27 Jun 16:41:36 CEST 2017 Fixes: - Dancer2 sporadic missing request. [Andrew Beverley] - attribute _lang overrules default locale in translation - remove Log::Report::Lexicon dependency from ::Translator - formatter PRINTP cannot be used, remove docs which tell that - exceptions triggered translation too often Improvements: - add textdomain($name, 'EXISTS') - add textdomain($domain_object); - short-cut when translating without context - use String::Print::printi() to interpolate: that code was forked-off earlier, and now mature. version 1.19: Thu 9 Feb 17:35:43 CET 2017 Fixes: - Dancer2 change when a stack-level needs to be skipped for reporting the location of the exception [Andrew Beverley] - more modules optional during Dancer2 tests Improvements: - Dancer2 interface changes [Andrew Beverley] - spell fixes. rt.cpan.org#118561 [Gregor Herrmann, Debian] - spell fixes. rt.cpan.org#118562 [Gregor Herrmann, Debian] - free format calls in ::File and ::Syslog get additional info, which can be used in line formatting. - Use Dancer2::Logger::LogReport without Dancer2::Plugin::LogReport [Andrew Beverley] version 1.18: Fri 21 Oct 09:50:51 CEST 2016 Fixes: - die_decode() should not return an 'ALERT' reason, because that is not deadly. Dies are always deadly. Improvements: - ::Try has new attribute on_die, to specify whether a die in the code should produce PANICs or ERRORs. Request by [Andrew Beverley] - ::Die::die_decode() got on_die parameter. - the Dancer2 logger will always PANIC on dies. version 1.17: Mon Sep 19 23:42:56 CEST 2016 Improvements: - typo rt.cpan.org#114072, second attempt [Gregor Herrmann, Debian] - include examples in manual pages. version 1.16: Fri 27 May 08:54:01 CEST 2016 Fixes: - ::Dancer2: support for Dancer2 >v0.166001 [Russell Jenkins] Improvements: - typo rt.cpan.org#114072 [Gregor Herrmann, Debian] version 1.15: Mon 18 Apr 13:54:12 CEST 2016 Improvements: - dancer2: test import parameters [Andrew Beverley] https://github.com/PerlDancer/Dancer2/issues/1156 version 1.14: Tue 12 Apr 15:10:27 CEST 2016 Fixes: - dancer2: regression test only for recent Dancer2 [cpantesters] rt.cpan.org#111770 [Riba Sushi] Improvements: - typo rt.cpan.org#111985 [Gregor Herrmann, Debian] - dancer2: treat all exceptions equal [Andrew Beverley] version 1.13: Wed 3 Feb 11:34:18 CET 2016 Fixes: - init of lexicon with HASH rt.cpan.org#111420 [Paulo A Ferreira] Improvements: - skip Log::Report wrappers from stacktrace and location. - added ::Dispatcher::addSkipStack() and ::skipStack() - add forward_url to Dancer2 plugin example [Andrew Beverley] - ignore $SIG{__DIE__} within try blocks [Milos Lazarevic] - dancer2: add regression test for plugin [Andrew Beverley] - dancer2: add forward_template option [Raj Barath] version 1.12: Mon Jan 18 21:55:35 CET 2016 Fixes: - reopen default dispatcher creates a double. [Andrew Beverley] Improvements: - remove mode=DEBUG from Dancer2::* version 1.11: Mon 18 Jan 17:07:43 CET 2016 Fixes: - warning when log outside sub [Andrew Beverley] - missing register of fault and failure [Andrew Beverley] - some module is textdomain logreport, should be log-report. [Andrew Beverley] - Dancer2::Logger::LogReport should not set the mode Improvements: - dispatcher 'do-not-reopen' does not protect the default dispatcher [Andrew Beverley] - produce error when setContext is used while context_rules are not provided. - added ::Exception::toHTML() and ::Message::toHTML() version 1.10: Sat Nov 28 17:39:16 CET 2015 Fixes: - Dancer2 object build [Andrew Beverley] - ::Domain::setContext with PAIRS as parameter - collect stack for exceptions inside try block. [Andrew Beverley] Improvements: - keep dispatchers ordered. - interpolate context setting inside msg_id's as well - add ::Domain::updateContext() - new option dispatcher 'do-not-reopen' - ::Dispatcher::File option format() with CODE, now calls with additional parameter $msg. - ::Dispatcher::File option output() now with CODE, to dynamically return the logfile name. - added t/55throw.t - new method ::Try::hide() - renamed internal fields of ::Dispatcher::File, to lead with LRDF_ - new option ::Dispatcher::Syslog::new(format) version 1.09: Tue 20 Oct 09:26:00 CEST 2015 Fixes: - try: do not ignore is_fatal parameter Improvements: - dispatcher() new action 'active-try' - many, many improvements to Dancer2::* [Andrew Beverley] version 1.08: Thu 8 Oct 17:55:39 CEST 2015 Fixes: - tests on Windows [cpantesters] Improvements: - avoid use of 'package Dancer::Logger' to circumvent complaints of Pause. - Log::Report configure message_class [Andrew Beverley] - Dancer2 plugin improved a lot [Andrew Beverley] version 1.07: Tue Jul 21 17:38:01 CEST 2015 Fixes: - remove superfluous blank lines, when (translated) message ends on \n. Reported by [Andrew Beverley] - Dancer2::Plugin:: deep recursion in ERROR handler [Andrew Beverley] Improvements: - document HASH for ::Syslog::new(logsocket). Idea of [Andrew Beverley] - add Log::Report::DBIC::Profiler [Andrew Beverley] - loads of documentation on using Log::Report in Dancer2, written by [Andrew Beverley] - protect against two instances of ::Syslog at the same time: its impossible. version 1.06: Mon Jun 15 17:30:33 CEST 2015 Fixes: - t/60mojo.t will not run on old mojo's: requires 2.16 (2011) [cpantesters] - ::Dispatcher::File do not use %F/%T in strfime, which is not supported by Windows. - make ::Die understand multiline 'die()' messages. rt.cpan.org#101389 [Ken Neighbors] Improvements: - add Dancer::Log::Report and examples/dancer/ - add Dancer2::*, contributed by [Andrew Beverly] version 1.05: Tue Jun 24 09:38:15 CEST 2014 Fixes: - test in t/10interp.t failed for Perl 5.20, caused by a bugfix or change in overload::Overloaded [cpantesters] version 1.04: Tue Jun 3 10:42:11 CEST 2014 Fixes: - float serialization under locale in test [cpantesters] version 1.03: Thu May 22 11:54:24 CEST 2014 Fixes: - float serialization under locale in test [cpantesters] - non-errors and ::Dispatcher::Perl Improvements: - shorted display of string parameters in stack-trace to max 80 chars - Log4perl log-lines sometimes show dispatcher as source, skip them. - disable 'mode switch' trace for try() version 1.02: Mon Mar 10 16:03:13 CET 2014 Fixes: - add overload fallback to ::Exception and ::Dispatcher rt.cpan.org#92970 [Lukas Mai] - ::Domain::new(translator) with HASH did not initialize - warn better with ::Optional modules are used before Log::Report is used. Improvements: - changed documentation style - ::Lexicon::Index dir-scan immediately, hopefully before fork() version 1.01: Mon Jan 6 23:21:37 CET 2014 Fixes: - LC_MESSAGE missing on Windows [Michael Long] version 1.00: Sun Jan 5 17:23:44 CET 2014 Split into four components, adding - String::Print for formatting, permits positionals now - Log::Report::Optional as base, super lightweight - Log::Report::Lexicon when you need translations Changes: - configuration from ::translator() into ::Domain::configure() - domains are package bound, not line based. - removed isValidReason() and isFatal(), there are function in ::Util - dispatchers(list) inside try() also lists outside dispatchers - ::Dispatcher::Log4perl::new(accept) defaults to 'ALL', because the log4perl configuration will select what to log. - exceptions which get re-thrown with an other reason get rewritten. - alert and failure messages will always show their location - "switching to mode" message from level info to trace Fixes: - do not complain when N__w ends on \n - incorrect initialization of log4perl dispatcher - try inside BEGIN did not catch but died. rt.cpan.org#91671 [Kenney Westerhof] Improvements: - ::Dispatcher::File uses locking to permit parallel writes - ::Dispatcher::File::new(format) - ::Dispatcher::File::rotate() - ::Dispatcher::Log4perl more docs - explain why Log::Log4perl::caller_depth concept is broken - ::Dispatcher::Log4perl support for categories - ::Dispatcher::Syslog::new(include_domain) - ::Dispatcher::Syslog::new(charset) - ::Dispatcher::*::log() knows about textdomain of msg - ::Message::new(_lang) overrides language to be used in translation - add MojoX::Log::Report - new ::Domain, move all domain specific config from ::import() into that module (and/or ::Minimal::Domain) - ::textdomain() - ::Message overload fallback - remove "syntax => 'SHORT'" from examples: is the default - export level on Log::Report::import() version 0.999: Not (yet) released version 0.998: Tue Oct 22 09:55:06 CEST 2013 Fixes: - xgettext-perl: actually use the provided template pattern - xgettext-perl: only take template from .tt and .tt2 files - xgettext-perl: accept '-' (STDIN) for --from Improvements: - more documentation about the PPI extraction process, and how to use ::Message::new(_domain) - Log::Report import option 'import' version 0.997: Fri Sep 27 17:37:11 CEST 2013 Fixes: - error about double definedness of settings, dependent on the order of inclusion of modules. - setlocale does not return the old locale, but the new. Improvements: - xgettext-perl: do not PPI files unless they are Perl - xgettext-perl: do warn when ' (single quotes) are used, needs " (double quote) with __x - __x() now can have a _domain parameter version 0.996: Wed Sep 4 17:23:11 CEST 2013 Fixes: - you could not share one ::Translator::POT over two domains. discovered by [Richard Still] - third attempt to fix errors in t/53log4perl.t on Windows [cpantesters] - remove double reporting of errors which exceptions are caught with eval(). But better use try(). version 0.995: Thu Aug 29 09:19:13 CEST 2013 Fixes: - twice path '\' in t/53log4perl.t in Windows [cpantesters] Fixes: - link to paper [Richard Still] - chicken-egg problem with error on illegal mode setting. Improvements: - try to build new translation table at each 'make' version 0.993: Thu Mar 28 10:59:27 CET 2013 Fixes: - filename/linenumber caller-depth in Log4Perl. rt.cpan.org#83736 [Dominik Jarmulowicz] - actually try to use existing mo files. Improvements: - use Devel::GlobalDestruction rt.cpan.org#80612 [Riba Sushi] - ::Template extractor of translatable strings now understands [%|loc%]$msgid[%END%] and [%'$msgid'| loc %] - improvements on documentation. - move t/30index.t towards xt/30index.t, because the test is too sensitive for the actual environment. version 0.992: Fri Dec 21 11:59:55 CET 2012 Improvements: - add support for msgctxt in po-files to Log::Report::Lexicon::POT* - new option Log::Report::Lexicon::PO::new(plural_forms) - new generic base-class Log::Report::Lexicon::Table for Log::Report::Lexicon::POT* - ::POT.pm ignores any index when the msgid has no plural form. This results in a smaller memory foot-print. - support for MO files, in Log::Report::Lexicon::MOTcompact version 0.991: Mon Nov 26 09:27:08 CET 2012 Fixes: - t/50file.t test failed on HASH order [cpantesters] version 0.99: Wed Oct 3 09:13:58 CEST 2012 Changes: - do not call overloaded stringification in stack-trace. Fixes: - do only include .po files in the index which are not in a directory which starts with a dot (for instance, not in /.svn/) or do not start with a dot. [Richard Still] Improvements: - remove \r from the end of comment lines in PO files. version 0.98: Thu Sep 6 14:46:52 CEST 2012 Changes: - rewrote message-id extractor in ::Extract::Template to support more TemplateToolkit features. - print __x("who am i\n") is now interpreted as print __x("who am i"), "\n"; So: no trailing newlines in the PO-tables. Fixes: - PO file parse errors reported on the wrong location. - ::Message::toString() uses $" when an ARRAY of elements gets inlined. This should be the $" on the moment of message's definition, not the $" when it gets stringified. Improvements: - new option ::Message::new(_join) version 0.97: Mon Sep 3 15:54:04 CEST 2012 Changes: - repair mistake of 0.96: Log::Report::Translate::TemplateToolkit() must have been Log::Report::Message::fromTemplateToolkit() Improvements: - count for message with plural can be ARRAY or HASH, which get numified automatically. version 0.96: Fri Aug 31 16:43:31 CEST 2012 Fixes: - scan templates for msgid containing white-space. - ::Translate::translate() was documented to accept a language parameter. Fixed the docs and implemented it ;-) Improvements: - support for plural forms in templates. - explanation/support method how to integrate the translations with Template::Toolkit. version 0.95: Thu Aug 30 23:15:50 CEST 2012 Changes: - new parameters for xgettext-perl, now also able to handle extracting from templates. Script needs man-page. Fixes: - xgettext-perl showed counts twice. - text-domain specified as "qw/domain/" now gets recognized by PerlPPI. Improvements: - some spelling corrections by rt.cpan.org#70959 [Fabrizio Regalli] - synopsis fix in ::Dispatcher::Callback by [gbjk] - cleaned-up the synopsis of Log::Report a bit. - split base-class Log::Report::Extract from ::Extract::PerlPPI - remove dependency to Test::Pod - add Log::Report::Extract::Template and t/42templ.t version 0.94: Tue Aug 23 11:14:59 CEST 2011 Changes: - when an exception get throw()n again, but with a different "reason", the fatality "is_fatal" will automatically adapt. Improvements: - add Log::Report::Exception::isFatal() version 0.93: Thu Jun 30 09:45:24 CEST 2011 Fixes: - faults caused by $? should not exit with 0 rt.cpan.org #68496 [Zephaniah E. Hull] - die's in try blocks did not produce a Log::Report::Message reported by [Patrick Powell] - fix use for non-admin Windows users rt.cpan.org#67935 [unknown] Improvements: - ability to change message and reason of an ::Exception - lazy-load Log::Report::Die version 0.92: Fri Apr 15 10:26:33 CEST 2011 Fixes: - another attempt to silence test for Windows bug. Improvements: - additional doc to dispatcher(), triggered by [Patrick Powell] - add error 'xx', _to => $disp; as alternative to report {to => $disp}, ERROR => 'xx'; version 0.91: Wed Jan 26 16:24:25 CET 2011 Fixes: - enabling and disabling dispatchers did not work [Patrick Powell] Improvements: - produce nice error when __x received even length list. - added Log::Report::Dispatcher::Callback - typos in new Callback.pm [Patrick Powell] - disable test which fails on bug in confess on Windows http://rt.perl.org/rt3/Ticket/Display.html?id=81586 - improved output with new OODoc version 0.90: Wed Dec 22 16:29:51 CET 2010 Changes: - ::Exception stringifies with lowercase reason, was uppercase Fixes: - repair Log::Report::report(is_fatal) option. - reimplementation of totalDigits and fractionDigits facets, triggered by rt.cpan.org#63464 [mimon-cz] - fix handling results of filters Improvements: - reorder checks in report() to be faster when the message is ignored (for instance trace) version 0.28: Mon May 31 16:00:12 CEST 2010 Fixes: - ::Exception::toString() should produce a string, sometimes it was an overloaded ::Message object. - More test fixes to repair Test::More changes. - Avoid call to close on undef in END rt.cpan.org#57955 [Jan Henning Thorsen] version 0.27: Fri May 28 15:37:44 CEST 2010 Fixes: - turn autoflush on for FILE dispatcher. Found by [Robin V.] - Test::More 0.95_01 changes is() w.r.t. overloading... broken tests. rt.cpan.org#57703 [Slaven Rezic] version 0.26: Mon Feb 15 10:08:23 CET 2010 Changes: - default of 'syntax' changed from 'REPORT' to 'SHORT'. Improvements: - fixes in dispatcher doc "mode" table. - document use of ::Exception::throw a bit better. - more useful error when parameter list has odd length. version 0.25: Thu Jul 16 12:18:51 CEST 2009 Improvements: - new method Log::Report::Exception::toString(), also overloaded for stringification. version 0.24: Mon Apr 27 10:02:12 CEST 2009 Fixes: - default language switching broken. - fix t/50file.t in Dutch environment [Peter de Vos] version 0.23: Fri Apr 24 16:18:12 CEST 2009 Fixes: - remember global mode, for dispatchers started later. - let try() use dispatcher mode, not to loose trace etc. - resolve complaint on exit. Improvements: - when an empty list has to be expanded, it will show '(none)' - require Sys::Syslog 0.27 version 0.22: Mon Jan 26 09:05:55 CET 2009 Fixes: - do not use /bin/pwd in t/pod.t, because it fails on Windows [Serguei Trouchelle] - translate long Windows locales into short rt.cpan.org#41943 [Serguei Trouchelle] version 0.21: Wed Jan 21 10:31:48 CET 2009 Fixes: - avoid recursion when locale setting is not understood. rt.cpan.org#41943 [Serguei Trouchelle] Improvements: - add Log::Report::needs() for convenience version 0.20: Thu Dec 11 14:18:15 CET 2008 Fixes: - dispatcher does not convert output to a default charset, because the optimal default cannot be established on most platforms. version 0.19: Mon Nov 24 12:52:34 CET 2008 Fixes: - fix for Test::More interface change in 0.86. - be strict on the character-set of the messages which are written, by default in UTF-8. (LC_CTYPE for the File dispatcher if available) Improvements: - work around missing LC_MESSAGES on old perls [Toby Corkindale] - few improvements in main SYNOPSIS - removed ::Dispatcher::File setting of encoding in binmode, in favor of explicit (internal) encoding for all dispatched messages. - require Encode 2.00+ - test do not say 'ERROR' but 'WARNING' in t/04setlocale.t when the setlocale() call does not return the old value as it should, according to the standards. Less confusion to the end-user, hopefully. version 0.18: Fri May 9 15:36:06 CEST 2008 Fixes: - few fixes to Win32Locale and parse_locale() [Ari Jolma] - Require Sys::Syslog 0.24 version 0.17: Fri Apr 18 18:20:51 CEST 2008 Fixes: - strackTrace error with isa() when parameter string contains a '::' and when a parameter is undefined. Changes: - changing the run-mode will change the accepted reasons as well, because it was too complex to understand. Improvements: - complain if syntax option has an invalid value. - use warnings and strict in Win32Locale [cpants] - dispatcher command on "ALL" defined dispatchers. - use Log::Report mode => 'something' version 0.16: Thu Mar 27 11:32:08 CET 2008 Fixes: - assert, error, and such are functions, but where documented as being methods. - xgettext-perl -h did not exit. - complaints on Windows about prototype mistake when redefining LC_MESSAGES [Adam Kennedy] Improvements: - ::Lexicon::Index::list() got second optional argument, to filter filenames. - Silence symlink recursion errors in ::Lexicon::Index version 0.15: Mon Feb 25 15:36:37 CET 2008 Changes: - ::Dispatcher::Syslog::new(format_reason) change default to 'IGNORE'. - warning does not get a line-number/filename. Use alert if you need those. Improvements: - added logsocket option to SYSLOG dispatcher. - exception can be re-throw-n with a different reason. - stop parse_locale() from complaining about locale==undef - ::Util::parse_locale() does a better job trying to conform to various standards. In SCALAR context, it now returns more information. - avoid calling ::Dispatcher::DESTROY during global destruction, because Perl produces horrible complaints for some releases of Perl. - link manual-pages with Text::Catalog (renamed from Log::Report::View) version 0.14: Fri Nov 2 15:00:49 CET 2007 Fixes: - Another syntax error, now using Win32Locale. via cpantesters [mmusgrove] - Close DATA handle after reading Win32 locale table. via cpantesters [mmusgrove] version 0.13: Mon Oct 29 09:20:04 CET 2007 Fixes: - Stupid syntax error in the new Win32Locale. via cpantesters [mmusgrove] Improvements: - Log::Report::Dispatchers should now be able to handle situations where locale_h is not exported by POSIX. version 0.12: Tue Oct 23 15:26:07 CEST 2007 Improvements: - t/04locale.t also tries charset eq '' - t/04locale.t will produce a warning, not an error, when the setlocale() does not work - t/*.t will use the 'C' locale, not the less often supported 'POSIX'. - added Log::Report::Win32Locale, with experimental application in Log::Report::Lexicon::Index - on some platforms, LC_MESSAGES is not defined. Work-around in Log::Report::Translator::POT. version 0.11: Thu Oct 18 09:34:18 CEST 2007 Fixes: - Running tests, a temporary directory remained in /tmp. [Andreas Koenig] Improvements: - Makefile.PL use 5.008 i.s.o. 5.8.2, otherwise not understood by perl 5.5. [Slaven Rezic] - Added versions of optional modules to test output version 0.10: Mon Oct 15 17:55:44 CEST 2007 Changes: - WARNINGs should not included $!... use alert if you are tempted. Improvements: - few doc fixes. version 0.09: Thu Aug 9 22:46:56 CEST 2007 Changes: - a try{} block executes eval in the correct context, and returns its results. Just like eval() does. - a non-translated message MUST be only one string to be passed to report(), because other parameters are passed to the message constructor. Fixes: - stack-trace did not remove the trace of the Log::Report internal helpers. - if try died indirectly from a nested died try, then that object is not captured in died() itself. Improvements: - try() catches Perl die/croak/warn as well, and translates them using Log::Report::Die. - try() dies if parameter list has odd length (semi-colon forgotten) - implementation of exception classes. See Log::Report::(Message|Exception)::inClass version 0.08: Wed Jul 11 14:09:32 CEST 2007 Changes: - default dispatcher is now named 'default', type PERL Improvements: - added comments by [Guido Flohr] about use of Locale::gettext - NetBSD has locale C and POSIX in lower-case. [cpan-testers] - improve handling of undef values during expand - added PERL=Log::Report::Dispatcher::Perl version 0.07: Wed Jun 20 14:01:18 CEST 2007 Improvements: - another attempt to find-out why some platforms report a deep recursion. version 0.06: Sat Jun 9 10:33:23 CEST 2007 Improvements: - t/51syslog.t compares required version via UNIVERSAL::VERSION (cpan-tester David Cantrell) Other version checks adapted as well. - add t/pod.t, which tests produced pods - t/01locale.t even smarter, with help of Andreas Koenig version 0.05: Thu Jun 7 13:18:13 CEST 2007 Changes: - the stderr dispatcher will be opened when there is any file at STDERR, not only a tty. Improvements: - simplified t/50files.t - another attempt to get t/01locale.t correct on all platforms - ::Util; locale parser must accept C and POSIX - ::Dispatcher; make message output format translatable - ::Extract::PPI; report mistake when msgid ends with new-line - ::Extract::PPI; mistake when a variable is interpolated in msgid - ::Extract::PPI; qq{} msgids will now be detected as well - ::Extract::PPI; special characters the "" and qq{} strings with get interpreted (PPI does not do that automatically) - ::Extract::PPI: only report the nessecary - after a long discussion within Amsterdam.pm about concatenation of translated fragments, it was decided to permit it but put some extra warnings in the docs. - also warn about __'xx' meaning __::xx ' - updated log-report/nl_NL.po translations - configure native_language for a domain - untranslated messages will still be formatted according to the rules of the native_language - translator table setting per domain now integrated with other settings for the domain. - ran ispell on the man-pages version 0.04: Mon Jun 4 11:05:10 CEST 2007 - removed incorrect doc about "mode TRY", which does not exist. - included syslog in "reason" comparison table - have Makefile.PL install xgettext-perl - t/50file.t needed more work-arounds to pass automated module tests (which go without -t STDERR) - attempts to make test-scripts run on various platforms. version 0.03: Mon May 28 20:16:26 CEST 2007 - Log::Report::Message without msgid forgot _append. - Log::Report::Message must clone at concatenation. - remove translations from POT when not referenced anymore, and not translated either. - $@ after try will not show the message, because we want people to use reportAll() or reportFatal(). - dispatchers now have a format_reason, defaulting to LOWERCASE which looks nicer than uppercase. - added docs to ::Try - reorganized some docs. - Log::Report::Util lacked the trailing "1;" - fall-back to no translation in case of unknown locale in ::POT - test functionality of setlocale, and hopefully fixed things version 0.02: Mon May 28 00:49:52 CEST 2007 - added HTML documentation to http://perl.overmeer.net/log-report/ - added README and Changelog to MANIFEST - filters are not defined on the dispatcher object, but under control of Log::Report::report(). - Log::Report::Message new methods append(), msgid(), and prepend() - added Log::Report::Exception and Log::Report::Dispatcher::Try - added isValidReason() and isFatal() to Log::Report - added Log::Report::Message::untranslated(); - Log::Report::report() will convert untranslated strings into Log::Report::Message objects internally too. - by David Cantrell via cpan-testers: . require at least perl 5.8.2, for POSIX :local_h and because unique was broken before that release. . t/00use.t cannot test LogDispatch and Gettext, because they depend on optional module . t/50file.t failed because no -t STDERR version 0.01: Fri May 25 12:13:13 CEST 2007 - initial (quite complete) implementation. Log-Report-1.40/README.md0000644000175000001440000000446114637476635015457 0ustar00markovusers00000000000000# distribution Log-Report * My extended documentation: * Development via GitHub: * Download from CPAN: * Indexed from CPAN: Get messages to users and logs. Log::Report combines three tasks which are closely related in one: . logging (like Log::Log4Perl and syslog), and . exceptions (like error and info), with . translations (like gettext and Locale::TextDomain) You **do not need** to use this module for all three reasons: pick what you need now, maybe extend the usage later. To enable translations, you need to install "Log::Report::Lexicon" ## Development → Release Important to know, is that I use an extension on POD to write the manuals. The "raw" unprocessed version is visible on GitHub. It will run without problems, but does not contain manual-pages. Releases to CPAN are different: "raw" documentation gets removed from the code and translated into real POD and clean HTML. This reformatting is implemented with the OODoc distribution (A name I chose before OpenOffice existed, sorry for the confusion) Clone from github for the "raw" version. For instance, when you want to contribute a new feature. On github, you can find the processed version for each release. But the better source is CPAN; to get it installed simply run: ```sh cpan -i Log::Report ``` ## Contributing When you want to contribute to this module, you do not need to provide a perfect patch... actually: it is nearly impossible to create a patch which I will merge without modification. Usually, I need to adapt the style of code and documentation to my own strict rules. When you submit an extension, please contribute a set with 1. code 2. code documentation 3. regression tests in t/ **Please note:** When you contribute in any way, you agree to transfer the copyrights to Mark Overmeer (you will get the honors in the code and/or ChangeLog). You also automatically agree that your contribution is released under the same license as this project: licensed as perl itself. ## Copyright and License This project is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See Log-Report-1.40/META.yml0000644000175000001440000000157415000465237015430 0ustar00markovusers00000000000000--- abstract: 'report a problem, pluggable handlers and language support' author: - 'Mark Overmeer ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Log-Report no_index: directory: - t - inc requires: Devel::GlobalDestruction: '0.09' Encode: '2.00' Log::Report::Optional: '1.07' Scalar::Util: '0' String::Print: '0.91' Sys::Syslog: '0.27' Test::More: '0.86' resources: homepage: http://perl.overmeer.net/CPAN/ license: http://dev.perl.org/licenses/ repository: https://github.com/markov2/perl5-Log-Report.git version: '1.40' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Log-Report-1.40/META.json0000644000175000001440000000277015000465237015577 0ustar00markovusers00000000000000{ "abstract" : "report a problem, pluggable handlers and language support", "author" : [ "Mark Overmeer " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Log-Report", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Devel::GlobalDestruction" : "0.09", "Encode" : "2.00", "Log::Report::Optional" : "1.07", "Scalar::Util" : "0", "String::Print" : "0.91", "Sys::Syslog" : "0.27", "Test::More" : "0.86" } } }, "release_status" : "stable", "resources" : { "homepage" : "http://perl.overmeer.net/CPAN/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "https://github.com/markov2/perl5-Log-Report.git", "web" : "https://github.com/markov2/perl5-Log-Report" } }, "version" : "1.40", "x_serialization_backend" : "JSON::PP version 4.16" }