Initial Commit

This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions

599
database/perl/vendor/lib/Log/Message.pm vendored Normal file
View File

@@ -0,0 +1,599 @@
package Log::Message;
use if $] > 5.017, 'deprecate';
use strict;
use Params::Check qw[check];
use Log::Message::Item;
use Log::Message::Config;
use Locale::Maketext::Simple Style => 'gettext';
local $Params::Check::VERBOSE = 1;
BEGIN {
use vars qw[$VERSION @ISA $STACK $CONFIG];
$VERSION = '0.08';
$STACK = [];
}
=pod
=head1 NAME
Log::Message - A generic message storing mechanism;
=head1 SYNOPSIS
use Log::Message private => 0, config => '/our/cf_file';
my $log = Log::Message->new( private => 1,
level => 'log',
config => '/my/cf_file',
);
$log->store('this is my first message');
$log->store( message => 'message #2',
tag => 'MY_TAG',
level => 'carp',
extra => ['this is an argument to the handler'],
);
my @last_five_items = $log->retrieve(5);
my @items = $log->retrieve( tag => qr/my_tag/i,
message => qr/\d/,
remove => 1,
);
my @items = $log->final( level => qr/carp/, amount => 2 );
my $first_error = $log->first()
# croak with the last error on the stack
$log->final->croak;
# empty the stack
$log->flush();
=head1 DESCRIPTION
Log::Message is a generic message storage mechanism.
It allows you to store messages on a stack -- either shared or private
-- and assign meta-data to it.
Some meta-data will automatically be added for you, like a timestamp
and a stack trace, but some can be filled in by the user, like a tag
by which to identify it or group it, and a level at which to handle
the message (for example, log it, or die with it)
Log::Message also provides a powerful way of searching through items
by regexes on messages, tags and level.
=head1 Hierarchy
There are 4 modules of interest when dealing with the Log::Message::*
modules:
=over 4
=item Log::Message
Log::Message provides a few methods to manipulate the stack it keeps.
It has the option of keeping either a private or a public stack.
More on this below.
=item Log::Message::Item
These are individual message items, which are objects that contain
the user message as well as the meta-data described above.
See the L<Log::Message::Item> manpage to see how to extract this
meta-data and how to work with the Item objects.
You should never need to create your own Item objects, but knowing
about their methods and accessors is important if you want to write
your own handlers. (See below)
=item Log::Message::Handlers
These are a collection of handlers that will be called for a level
that is used on a L<Log::Message::Item> object.
For example, if a message is logged with the 'carp' level, the 'carp'
handler from L<Log::Message::Handlers> will be called.
See the L<Log::Message::Handlers> manpage for more explanation about how
handlers work, which one are available and how to create your own.
=item Log::Message::Config
Per Log::Message object, there is a configuration required that will
fill in defaults if the user did not specify arguments to override
them (like for example what tag will be set if none was provided),
L<Log::Message::Config> handles the creation of these configurations.
Configuration can be specified in 4 ways:
=over 4
=item *
As a configuration file when you C<use Log::Message>
=item *
As arguments when you C<use Log::Message>
=item *
As a configuration file when you create a new L<Log::Message> object.
(The config will then only apply to that object if you marked it as
private)
=item *
As arguments when you create a new Log::Message object.
You should never need to use the L<Log::Message::Config> module yourself,
as this is transparently done by L<Log::Message>, but its manpage does
provide an explanation of how you can create a config file.
=back
=back
=head1 Options
When using Log::Message, or creating a new Log::Message object, you can
supply various options to alter its behaviour.
Of course, there are sensible defaults should you choose to omit these
options.
Below an explanation of all the options and how they work.
=over 4
=item config
The path to a configuration file to be read.
See the manpage of L<Log::Message::Config> for the required format
These options will be overridden by any explicit arguments passed.
=item private
Whether to create, by default, private or shared objects.
If you choose to create shared objects, all Log::Message objects will
use the same stack.
This means that even though every module may make its own $log object
they will still be sharing the same error stack on which they are
putting errors and from which they are retrieving.
This can be useful in big projects.
If you choose to create a private object, then the stack will of
course be private to this object, but it will still fall back to the
shared config should no private config or overriding arguments be
provided.
=item verbose
Log::Message makes use of another module to validate its arguments,
which is called L<Params::Check>, which is a lightweight, yet
powerful input checker and parser. (See the L<Params::Check>
manpage for details).
The verbose setting will control whether this module will
generate warnings if something improper is passed as input, or merely
silently returns undef, at which point Log::Message will generate a
warning.
It's best to just leave this at its default value, which is '1'
=item tag
The tag to add to messages if none was provided. If neither your
config, nor any specific arguments supply a tag, then Log::Message will
set it to 'NONE'
Tags are useful for searching on or grouping by. For example, you
could tag all the messages you want to go to the user as 'USER ERROR'
and all those that are only debug information with 'DEBUG'.
At the end of your program, you could then print all the ones tagged
'USER ERROR' to STDOUT, and those marked 'DEBUG' to a log file.
=item level
C<level> describes what action to take when a message is logged. Just
like C<tag>, Log::Message will provide a default (which is 'log') if
neither your config file, nor any explicit arguments are given to
override it.
See the Log::Message::Handlers manpage to see what handlers are
available by default and what they do, as well as to how to add your
own handlers.
=item remove
This indicates whether or not to automatically remove the messages
from the stack when you've retrieved them.
The default setting provided by Log::Message is '0': do not remove.
=item chrono
This indicates whether messages should always be fetched in
chronological order or not.
This simply means that you can choose whether, when retrieving items,
the item most recently added should be returned first, or the one that
had been added most long ago.
The default is to return the newest ones first
=back
=cut
### subs ###
sub import {
my $pkg = shift;
my %hash = @_;
$CONFIG = new Log::Message::Config( %hash )
or die loc(qq[Problem initialising %1], __PACKAGE__);
}
=head1 Methods
=head2 new
This creates a new Log::Message object; The parameters it takes are
described in the C<Options> section below and let it just be repeated
that you can use these options like this:
my $log = Log::Message->new( %options );
as well as during C<use> time, like this:
use Log::Message option1 => value, option2 => value
There are but 3 rules to keep in mind:
=over 4
=item *
Provided arguments take precedence over a configuration file.
=item *
Arguments to new take precedence over options provided at C<use> time
=item *
An object marked private will always have an empty stack to begin with
=back
=cut
sub new {
my $class = shift;
my %hash = @_;
my $conf = new Log::Message::Config( %hash, default => $CONFIG ) or return undef;
if( $conf->private || $CONFIG->private ) {
return _new_stack( $class, config => $conf );
} else {
my $obj = _new_stack( $class, config => $conf, stack => $STACK );
### if it was an empty stack, this was the first object
### in that case, set the global stack to match it for
### subsequent new, non-private objects
$STACK = $obj->{STACK} unless scalar @$STACK;
return $obj;
}
}
sub _new_stack {
my $class = shift;
my %hash = @_;
my $tmpl = {
stack => { default => [] },
config => { default => bless( {}, 'Log::Message::Config'),
required => 1,
strict_type => 1
},
};
my $args = check( $tmpl, \%hash, $CONFIG->verbose ) or (
warn(loc(q[Could not create a new stack object: %1],
Params::Check->last_error)
),
return
);
my %self = map { uc, $args->{$_} } keys %$args;
return bless \%self, $class;
}
sub _get_conf {
my $self = shift;
my $what = shift;
return defined $self->{CONFIG}->$what()
? $self->{CONFIG}->$what()
: defined $CONFIG->$what()
? $CONFIG->$what()
: undef; # should never get here
}
=head2 store
This will create a new Item object and store it on the stack.
Possible arguments you can give to it are:
=over 4
=item message
This is the only argument that is required. If no other arguments
are given, you may even leave off the C<message> key. The argument
will then automatically be assumed to be the message.
=item tag
The tag to add to this message. If not provided, Log::Message will look
in your configuration for one.
=item level
The level at which this message should be handled. If not provided,
Log::Message will look in your configuration for one.
=item extra
This is an array ref with arguments passed to the handler for this
message, when it is called from store();
The handler will receive them as a normal list
=back
store() will return true upon success and undef upon failure, as well
as issue a warning as to why it failed.
=cut
### should extra be stored in the item object perhaps for later retrieval?
sub store {
my $self = shift;
my %hash = ();
my $tmpl = {
message => {
default => '',
strict_type => 1,
required => 1,
},
tag => { default => $self->_get_conf('tag') },
level => { default => $self->_get_conf('level'), },
extra => { default => [], strict_type => 1 },
};
### single arg means just the message
### otherwise, they are named
if( @_ == 1 ) {
$hash{message} = shift;
} else {
%hash = @_;
}
my $args = check( $tmpl, \%hash ) or (
warn( loc(q[Could not store error: %1], Params::Check->last_error) ),
return
);
my $extra = delete $args->{extra};
my $item = Log::Message::Item->new( %$args,
parent => $self,
id => scalar @{$self->{STACK}}
)
or ( warn( loc(q[Could not create new log item!]) ), return undef );
push @{$self->{STACK}}, $item;
{ no strict 'refs';
my $sub = $args->{level};
$item->$sub( @$extra );
}
return 1;
}
=head2 retrieve
This will retrieve all message items matching the criteria specified
from the stack.
Here are the criteria you can discriminate on:
=over 4
=item tag
A regex to which the tag must adhere. For example C<qr/\w/>.
=item level
A regex to which the level must adhere.
=item message
A regex to which the message must adhere.
=item amount
Maximum amount of errors to return
=item chrono
Return in chronological order, or not?
=item remove
Remove items from the stack upon retrieval?
=back
In scalar context it will return the first item matching your criteria
and in list context, it will return all of them.
If an error occurs while retrieving, a warning will be issued and
undef will be returned.
=cut
sub retrieve {
my $self = shift;
my %hash = ();
my $tmpl = {
tag => { default => qr/.*/ },
level => { default => qr/.*/ },
message => { default => qr/.*/ },
amount => { default => '' },
remove => { default => $self->_get_conf('remove') },
chrono => { default => $self->_get_conf('chrono') },
};
### single arg means just the amount
### otherwise, they are named
if( @_ == 1 ) {
$hash{amount} = shift;
} else {
%hash = @_;
}
my $args = check( $tmpl, \%hash ) or (
warn( loc(q[Could not parse input: %1], Params::Check->last_error) ),
return
);
my @list =
grep { $_->tag =~ /$args->{tag}/ ? 1 : 0 }
grep { $_->level =~ /$args->{level}/ ? 1 : 0 }
grep { $_->message =~ /$args->{message}/ ? 1 : 0 }
grep { defined }
$args->{chrono}
? @{$self->{STACK}}
: reverse @{$self->{STACK}};
my $amount = $args->{amount} || scalar @list;
my @rv = map {
$args->{remove} ? $_->remove : $_
} scalar @list > $amount
? splice(@list,0,$amount)
: @list;
return wantarray ? @rv : $rv[0];
}
=head2 first
This is a shortcut for retrieving the first item(s) stored on the
stack. It will default to only retrieving one if called with no
arguments, and will always return results in chronological order.
If you only supply one argument, it is assumed to be the amount you
wish returned.
Furthermore, it can take the same arguments as C<retrieve> can.
=cut
sub first {
my $self = shift;
my $amt = @_ == 1 ? shift : 1;
return $self->retrieve( amount => $amt, @_, chrono => 1 );
}
=head2 last
This is a shortcut for retrieving the last item(s) stored on the
stack. It will default to only retrieving one if called with no
arguments, and will always return results in reverse chronological
order.
If you only supply one argument, it is assumed to be the amount you
wish returned.
Furthermore, it can take the same arguments as C<retrieve> can.
=cut
sub final {
my $self = shift;
my $amt = @_ == 1 ? shift : 1;
return $self->retrieve( amount => $amt, @_, chrono => 0 );
}
=head2 flush
This removes all items from the stack and returns them to the caller
=cut
sub flush {
my $self = shift;
return splice @{$self->{STACK}};
}
=head1 SEE ALSO
L<Log::Message::Item>, L<Log::Message::Handlers>, L<Log::Message::Config>
=head1 AUTHOR
This module by
Jos Boumans E<lt>kane@cpan.orgE<gt>.
=head1 Acknowledgements
Thanks to Ann Barcomb for her suggestions.
=head1 COPYRIGHT
This module is
copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.
All rights reserved.
This library is free software;
you may redistribute and/or modify it under the same
terms as Perl itself.
=cut
1;
# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4:

View File

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

View File

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

View File

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

View File

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

572
database/perl/vendor/lib/Log/Report.pm vendored Normal file
View File

@@ -0,0 +1,572 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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);
}
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;
}
$opts->{errno} ||= $!+0 || $? || 1
if use_errno($reason) && !defined $opts->{errno};
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;
}
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', @_);
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;
my $is_exception = blessed $err && $err->isa('Log::Report::Exception');
if(!$is_exception && $err && !$disp->wasFatal)
{ # Decode exceptions which do not origin from Log::Report reports
($err, 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;
my $domain;
if(defined $textdomain)
{ pkg2domain $pkg, $textdomain, $fn, $linenr;
$domain = textdomain $textdomain;
}
### 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(!%opts) { }
elsif($domain)
{ $domain->configure(%opts, where => [$pkg, $fn, $linenr ]) }
else
{ 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;

1172
database/perl/vendor/lib/Log/Report.pod vendored Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,39 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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;

View File

@@ -0,0 +1,46 @@
=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<Log::Report|Log::Report> to a
selected back-end (via a dispatcher, see L<Log::Report::Dispatcher|Log::Report::Dispatcher>)
=head1 SEE ALSO
This module is part of Log-Report distribution version 1.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,140 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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 = "$!";
my $dietxt = $text[0];
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';
($dietxt, \%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';
('caught '.ref $exception, \%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';
('caught '.ref $exc, \%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
( "caught ".ref $exception, \%opt, $reason, "$exception");
}
"to die or not to die, that's the question";

View File

@@ -0,0 +1,91 @@
=encoding utf8
=head1 NAME
Log::Report::Die - compatibility routines with Perl's die/croak/confess
=head1 INHERITANCE
Log::Report::Die
is a Exporter
=head1 SYNOPSIS
# use internally only
=head1 DESCRIPTION
This module is used internally, to translate output of 'die' and Carp
functions into L<Log::Report::Message|Log::Report::Message> objects. Also, it tries to
convert other kinds of exception frameworks into our message object.
=head1 FUNCTIONS
=over 4
=item B<die_decode>(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<Log::Report::report()|Log::Report/"Report Production and Configuration">. This is done in a very
smart way, even trying to find the stringifications of C<$!>.
Return are four elements: the error string which is used to trigger
a C<Log::Report> compatible C<die()>, and the options, reason, and
text message. The options is a HASH which, amongst other things,
may contain a stack trace and location.
Translated components will have exception classes C<perl>, and C<die> or
C<confess>. On the moment, the C<croak> cannot be distiguished from the
C<confess> (when used in package main) or C<die> (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_decode>($exception, %options)
[1.23] This function attempts to translate object of other exception frameworks
into information to create a L<Log::Report::Exception|Log::Report::Exception>. It returns the
same list of parameters as L<die_decode()|Log::Report::Die/"FUNCTIONS"> 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.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,361 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
use warnings;
use strict;
use Log::Report 'log-report';
use Log::Report::Util qw/parse_locale expand_reasons %reason_code
escape_chars/;
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<dispatcher mode => $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 = $opts->{errno} ? strerror($opts->{errno}) : 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;

View File

@@ -0,0 +1,408 @@
=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<Log::Report|Log::Report>, dispatchers are used to handle (exception) messages
which are created somewhere else. Those message were produced (thrown)
by L<Log::Report::error()|Log::Report/"Abbreviations for report()"> and friends.
This base-class handles the creation of dispatchers, plus the common
filtering rules. See the L</DETAILS> section, below.
=head1 METHODS
=head2 Constructors
=over 4
=item $obj-E<gt>B<close>()
Terminate the dispatcher activities. The dispatcher gets disabled,
to avoid the case that it is accidentally used. Returns C<undef> (false)
if the dispatcher was already closed.
=item Log::Report::Dispatcher-E<gt>B<new>($type, $name, %options)
Create a dispatcher. The $type of back-end to start is required, and listed
in the L</DESCRIPTION> 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<Log::Report::dispatcher()|Log::Report/"Report Production and Configuration">) 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 <undef>
format_reason 'LOWERCASE'
locale <system locale>
mode 'NORMAL'
=over 2
=item accept => REASONS
See L<Log::Report::Util::expand_reasons()|Log::Report::Util/"Reasons"> 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<accept>'s default
is C<NOTICE->. In case of "VERBOSE" it will be C<INFO->, C<ASSERT>
results in C<ASSERT->, and "DEBUG" in C<ALL>.
=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<Log::Report::report(locale)|Log::Report/"Report Production and Configuration">.
=item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3
Possible values are C<NORMAL> (or C<0> or C<undef>), which will not show
C<INFO> or debug messages, C<VERBOSE> (C<1>; shows C<INFO> not debug),
C<ASSERT> (C<2>; only ignores C<TRACE> messages), or C<DEBUG> (C<3>)
which shows everything. See section L<Log::Report/Run modes>.
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-E<gt>B<isDisabled>()
=item $obj-E<gt>B<mode>()
Returns the mode in use for the dispatcher as number. See L<new(mode)|Log::Report::Dispatcher/"Constructors">
and L<Log::Report/Run modes>.
=item $obj-E<gt>B<name>()
Returns the unique name of this dispatcher.
=item $obj-E<gt>B<needs>( [$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-E<gt>B<type>()
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-E<gt>B<addSkipStack>(@CODE)
=item Log::Report::Dispatcher-E<gt>B<addSkipStack>(@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<Warning:> 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-E<gt>B<collectLocation>()
=item Log::Report::Dispatcher-E<gt>B<collectLocation>()
Collect the information to be displayed as line where the error occurred.
=item $obj-E<gt>B<collectStack>( [$maxdepth] )
=item Log::Report::Dispatcher-E<gt>B<collectStack>( [$maxdepth] )
Returns an ARRAY of ARRAYs with text, filename, line-number.
=item $obj-E<gt>B<log>(HASH-$of-%options, $reason, $message, $domain)
This method is called by L<Log::Report::report()|Log::Report/"Report Production and Configuration"> and should not be called
directly. Internally, it will call L<translate()|Log::Report::Dispatcher/"Logging">, which does most $of
the work.
=item $obj-E<gt>B<skipStack>()
[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-E<gt>B<stackTraceLine>(%options)
=item Log::Report::Dispatcher-E<gt>B<stackTraceLine>(%options)
-Option --Default
abstract 1
call <required>
filename <required>
linenr <required>
max_line undef
max_params 8
package <required>
params <required>
=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<max_line>
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-E<gt>B<translate>(HASH-$of-%options, $reason, $message)
See L</Processing the message>, 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<new()|Log::Report::Dispatcher/"Constructors"> or L<Log::Report::dispatcher()|Log::Report/"Report Production and Configuration">),
you must specify the TYPE of the dispatcher. This can either be a class
name, which extends a L<Log::Report::Dispatcher|Log::Report::Dispatcher>, or a pre-defined
abbreviation of a class name. Implemented are:
=over 4
=item L<Log::Report::Dispatcher::Perl|Log::Report::Dispatcher::Perl> (abbreviation 'PERL')
Use Perl's own C<print()>, C<warn()> and C<die()> to ventilate
reports. This is the default dispatcher.
=item L<Log::Report::Dispatcher::File|Log::Report::Dispatcher::File> (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<Log::Report::Dispatcher::Syslog|Log::Report::Dispatcher::Syslog> (abbreviation 'SYSLOG')
Send messages into the system's syslog infrastructure, using
Sys::Syslog.
=item L<Log::Report::Dispatcher::Callback|Log::Report::Dispatcher::Callback> (abbreviation 'CALLBACK')
Calls any CODE reference on receipt of each selected message, for
instance to send important message as email or SMS.
=item C<Log::Dispatch::*>
All of the Log::Dispatch::Output extensions can be used directly.
The L<Log::Report::Dispatcher::LogDispatch|Log::Report::Dispatcher::LogDispatch> will wrap around that
back-end.
=item C<Log::Log4perl>
Use the Log::Log4perl main object to write to dispatchers. This
infrastructure uses a configuration file.
=item L<Log::Report::Dispatcher::Try|Log::Report::Dispatcher::Try> (abbreviation 'TRY')
Used by function L<Log::Report::try()|Log::Report/"Report Production and Configuration">. It collects the exceptions
and can produce them on request.
=back
=head2 Processing the message
=head3 Addition information
The modules which use C<Log::Report> 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<Log::Report::Message|Log::Report::Message>, for
instance created with L<Log::Report::__()|Log::Report/"Messages (optionally translatable)">), 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<mode()|Log::Report::Dispatcher/"Accessors">, initiate it with L<new(mode)|Log::Report::Dispatcher/"Constructors">).
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<accept> 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<Log::Report::Dispatcher|Log::Report::Dispatcher>), the HASH-of-OPTIONS
passed as optional first argument to L<Log::Report::report()|Log::Report/"Report Production and Configuration">, the
REASON, and the MESSAGE. Returned is the new REASON and MESSAGE.
When the returned REASON is C<undef>, then the message will be ignored
for that dispatcher.
Be warned about processing the MESSAGE: it is a L<Log::Report::Message|Log::Report::Message>
object which may have a C<prepend> string and C<append> string or
object. When the call to L<Log::Report::report()|Log::Report/"Report Production and Configuration"> contained multiple
comma-separated components, these will already have been joined together
using concatenation (see L<Log::Report::Message::concat()|Log::Report::Message/"Processing">.
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.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,40 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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;

View File

@@ -0,0 +1,187 @@
=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<Log::Report::Dispatcher|Log::Report::Dispatcher>, 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-E<gt>B<close>()
Inherited, see L<Log::Report::Dispatcher/"Constructors">
=item Log::Report::Dispatcher::Callback-E<gt>B<new>($type, $name, %options)
-Option --Defined in --Default
accept Log::Report::Dispatcher depend on mode
callback <required>
charset Log::Report::Dispatcher <undef>
format_reason Log::Report::Dispatcher 'LOWERCASE'
locale Log::Report::Dispatcher <system locale>
mode Log::Report::Dispatcher 'NORMAL'
=over 2
=item accept => REASONS
=item callback => CODE
Your C<callback> is called with five parameters: this dispatcher object,
the options, a reason and a message. The C<options> are the first
parameter of L<Log::Report::report()|Log::Report/"Report Production and Configuration"> (read over there). The C<reason>
is a capitized string like C<ERROR>. Then, the C<message> (is a
L<Log::Report::Message|Log::Report::Message>). 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-E<gt>B<callback>()
Returns the code reference which will handle each logged message.
=item $obj-E<gt>B<isDisabled>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<mode>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<name>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<needs>( [$reason] )
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<type>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=back
=head2 Logging
Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">.
=over 4
=item $obj-E<gt>B<addSkipStack>(@CODE)
=item Log::Report::Dispatcher::Callback-E<gt>B<addSkipStack>(@CODE)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<collectLocation>()
=item Log::Report::Dispatcher::Callback-E<gt>B<collectLocation>()
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<collectStack>( [$maxdepth] )
=item Log::Report::Dispatcher::Callback-E<gt>B<collectStack>( [$maxdepth] )
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<log>(HASH-$of-%options, $reason, $message, $domain)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<skipStack>()
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<stackTraceLine>(%options)
=item Log::Report::Dispatcher::Callback-E<gt>B<stackTraceLine>(%options)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<translate>(HASH-$of-%options, $reason, $message)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=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.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,165 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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;

View File

@@ -0,0 +1,272 @@
=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-E<gt>B<close>()
Only when initiated with a FILENAME, the file will be closed. In any
other case, nothing will be done.
=item Log::Report::Dispatcher::File-E<gt>B<new>($type, $name, %options)
-Option --Defined in --Default
accept Log::Report::Dispatcher depend on mode
charset Log::Report::Dispatcher LOCALE
format <adds timestamp>
format_reason Log::Report::Dispatcher 'LOWERCASE'
locale Log::Report::Dispatcher <system locale>
mode Log::Report::Dispatcher 'NORMAL'
replace false
to <required>
=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<location> 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<print()> 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-E<gt>B<filename>()
Returns the name of the opened file, or C<undef> in case this dispatcher
was started from a file-handle or file-object.
=item $obj-E<gt>B<format>()
=item $obj-E<gt>B<isDisabled>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<mode>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<name>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<needs>( [$reason] )
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<output>($msg)
Returns the file-handle to write the log lines to. [1.10] This may
depend on the $msg (especially message context)
=item $obj-E<gt>B<type>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=back
=head2 File maintenance
=over 4
=item $obj-E<gt>B<rotate>($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-E<gt>B<addSkipStack>(@CODE)
=item Log::Report::Dispatcher::File-E<gt>B<addSkipStack>(@CODE)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<collectLocation>()
=item Log::Report::Dispatcher::File-E<gt>B<collectLocation>()
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<collectStack>( [$maxdepth] )
=item Log::Report::Dispatcher::File-E<gt>B<collectStack>( [$maxdepth] )
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<log>(HASH-$of-%options, $reason, $message, $domain)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<skipStack>()
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<stackTraceLine>(%options)
=item Log::Report::Dispatcher::File-E<gt>B<stackTraceLine>(%options)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<translate>(HASH-$of-%options, $reason, $message)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=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.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,111 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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;

View File

@@ -0,0 +1,243 @@
=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<Sys::Log4perl>
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<Log::Report|Log::Report> 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<new(to_level)|Log::Report::Dispatcher::Log4perl/"Constructors">.
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<Log::Report> 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-E<gt>B<close>()
Inherited, see L<Log::Report::Dispatcher/"Constructors">
=item Log::Report::Dispatcher::Log4perl-E<gt>B<new>($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 <undef>
config <undef>
format_reason Log::Report::Dispatcher 'LOWERCASE'
locale Log::Report::Dispatcher <system locale>
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<reasonToLevel()|Log::Report::Dispatcher::Log4perl/"Logging">.
=back
=back
=head2 Accessors
Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">.
=over 4
=item $obj-E<gt>B<isDisabled>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<logger>( [$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-E<gt>B<mode>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<name>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<needs>( [$reason] )
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<type>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=back
=head2 Logging
Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">.
=over 4
=item $obj-E<gt>B<addSkipStack>(@CODE)
=item Log::Report::Dispatcher::Log4perl-E<gt>B<addSkipStack>(@CODE)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<collectLocation>()
=item Log::Report::Dispatcher::Log4perl-E<gt>B<collectLocation>()
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<collectStack>( [$maxdepth] )
=item Log::Report::Dispatcher::Log4perl-E<gt>B<collectStack>( [$maxdepth] )
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<log>(HASH-$of-%options, $reason, $message, $domain)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<reasonToLevel>($reason)
Returns a level which is understood by Log::Dispatch, based on
a translation table. This can be changed with L<new(to_level)|Log::Report::Dispatcher::Log4perl/"Constructors">.
example:
use Log::Log4perl qw/:levels/;
# by default, ALERTs are output as $FATAL
dispatcher Log::Log4perl => 'logger'
, to_level => [ ALERT => $ERROR, ]
, ...;
=item $obj-E<gt>B<skipStack>()
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<stackTraceLine>(%options)
=item Log::Report::Dispatcher::Log4perl-E<gt>B<stackTraceLine>(%options)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<translate>(HASH-$of-%options, $reason, $message)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=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.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,90 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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;

View File

@@ -0,0 +1,207 @@
=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<Log::Dispatch> 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<new(to_level)|Log::Report::Dispatcher::LogDispatch/"Constructors">. 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-E<gt>B<close>()
Inherited, see L<Log::Report::Dispatcher/"Constructors">
=item Log::Report::Dispatcher::LogDispatch-E<gt>B<new>($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 <undef>
format_reason Log::Report::Dispatcher 'LOWERCASE'
locale Log::Report::Dispatcher <system locale>
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<min_level>.
=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<reasonToLevel()|Log::Report::Dispatcher::LogDispatch/"Logging">.
=back
=back
=head2 Accessors
Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">.
=over 4
=item $obj-E<gt>B<backend>()
Returns the Log::Dispatch::Output object which is used for logging.
=item $obj-E<gt>B<isDisabled>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<mode>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<name>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<needs>( [$reason] )
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<type>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=back
=head2 Logging
Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">.
=over 4
=item $obj-E<gt>B<addSkipStack>(@CODE)
=item Log::Report::Dispatcher::LogDispatch-E<gt>B<addSkipStack>(@CODE)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<collectLocation>()
=item Log::Report::Dispatcher::LogDispatch-E<gt>B<collectLocation>()
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<collectStack>( [$maxdepth] )
=item Log::Report::Dispatcher::LogDispatch-E<gt>B<collectStack>( [$maxdepth] )
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<log>(HASH-$of-%options, $reason, $message, $domain)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<reasonToLevel>($reason)
Returns a level which is understood by Log::Dispatch, based on
a translation table. This can be changed with L<new(to_level)|Log::Report::Dispatcher::LogDispatch/"Constructors">.
=item $obj-E<gt>B<skipStack>()
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<stackTraceLine>(%options)
=item Log::Report::Dispatcher::LogDispatch-E<gt>B<stackTraceLine>(%options)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<translate>(HASH-$of-%options, $reason, $message)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=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.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,29 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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;

View File

@@ -0,0 +1,52 @@
=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<die()>, C<warn()>, and C<print()>. There can be only one such dispatcher
(per thread), because once C<die()> 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.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,128 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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;

View File

@@ -0,0 +1,236 @@
=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<new(to_prio)|Log::Report::Dispatcher::Syslog/"Constructors">. 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-E<gt>B<close>()
Inherited, see L<Log::Report::Dispatcher/"Constructors">
=item Log::Report::Dispatcher::Syslog-E<gt>B<new>($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 <unchanged>
format_reason Log::Report::Dispatcher 'IGNORE'
identity <basename $0>
include_domain <false>
locale Log::Report::Dispatcher <system locale>
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<user>, and C<local0> up to C<local7>.
=item flags => STRING
Any combination of flags as defined by Sys::Syslog, for instance
C<pid>, C<ndelay>, and C<nowait>.
=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<location> 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<openlog()> 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<reasonToPrio()|Log::Report::Dispatcher::Syslog/"Logging">.
=back
=back
=head2 Accessors
Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">.
=over 4
=item $obj-E<gt>B<format>( [CODE] )
Returns the CODE ref which formats the syslog line.
=item $obj-E<gt>B<isDisabled>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<mode>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<name>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<needs>( [$reason] )
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<type>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=back
=head2 Logging
Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">.
=over 4
=item $obj-E<gt>B<addSkipStack>(@CODE)
=item Log::Report::Dispatcher::Syslog-E<gt>B<addSkipStack>(@CODE)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<collectLocation>()
=item Log::Report::Dispatcher::Syslog-E<gt>B<collectLocation>()
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<collectStack>( [$maxdepth] )
=item Log::Report::Dispatcher::Syslog-E<gt>B<collectStack>( [$maxdepth] )
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<log>(HASH-$of-%options, $reason, $message, $domain)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<reasonToPrio>($reason)
Returns a level which is understood by syslog(3), based on a translation
table. This can be changed with L<new(to_prio)|Log::Report::Dispatcher::Syslog/"Constructors">.
=item $obj-E<gt>B<skipStack>()
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<stackTraceLine>(%options)
=item Log::Report::Dispatcher::Syslog-E<gt>B<stackTraceLine>(%options)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<translate>(HASH-$of-%options, $reason, $message)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=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.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,123 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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->{died} ||=
# exists $opts->{is_fatal} ? $opts->{is_fatal} : $e->isFatal;
$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 ();
# An (hidden) eval between LR::try()s may add more messages
my $ex = first { $_->isFatal } @{$self->{exceptions}}
or return ();
(!$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;

View File

@@ -0,0 +1,335 @@
=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<try> works like Perl's build-in C<eval()>, but implements
real exception handling which Perl core lacks.
The L<Log::Report::try()|Log::Report/"Report Production and Configuration"> function creates this C<::Try> dispatcher
object with name 'try'. After the C<try()> is over, you can find
the object in C<$@>. The C<$@> as C<::Try> object behaves exactly
as the C<$@> produced by C<eval>, but has many added features.
The C<try()> 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<new(accept)|Log::Report::Dispatcher/"Constructors">, but also
immediately passed to the active dispatchers (unless the reason is hidden,
see L<new(hide)|Log::Report::Dispatcher::Try/"Constructors">)
After the C<try()> has run, you can introspect the collected exceptions.
Typically, you use L<wasFatal()|Log::Report::Dispatcher::Try/"Status"> 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-E<gt>B<close>()
Inherited, see L<Log::Report::Dispatcher/"Constructors">
=item Log::Report::Dispatcher::Try-E<gt>B<new>($type, $name, %options)
-Option --Defined in --Default
accept Log::Report::Dispatcher depend on mode
charset Log::Report::Dispatcher <undef>
died undef
exceptions []
format_reason Log::Report::Dispatcher 'LOWERCASE'
hide 'NONE'
locale Log::Report::Dispatcher <system locale>
mode Log::Report::Dispatcher 'NORMAL'
on_die 'ERROR'
=over 2
=item accept => REASONS
=item charset => CHARSET
=item died => STRING
The exit string ($@) of the eval'ed block.
=item exceptions => ARRAY
ARRAY of L<Log::Report::Exception|Log::Report::Exception> objects.
=item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE
=item hide => REASONS|ARRAY|'ALL'|'NONE'
[1.09] see L<hide()|Log::Report::Dispatcher::Try/"Accessors">
=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<Log::Report::Exception|Log::Report::Exception> using
L<Log::Report::Die::die_decode()|Log::Report::Die/"FUNCTIONS">. 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-E<gt>B<die2reason>()
Returns the value of L<new(on_die)|Log::Report::Dispatcher::Try/"Constructors">.
=item $obj-E<gt>B<died>( [STRING] )
The message which was reported by C<eval>, which is used internally
to catch problems in the try block.
=item $obj-E<gt>B<exceptions>()
Returns all collected C<Log::Report::Exceptions>. The last of
them may be a fatal one. The other are non-fatal.
=item $obj-E<gt>B<hide>(@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<new(accept)|Log::Report::Dispatcher/"Constructors">), so may get passed-on later via L<reportAll()|Log::Report::Dispatcher::Try/"Logging"> if
you like.
Be warned: Using this method will reset the whole 'hide' configuration:
it's a I<set> not an I<add>.
example: change the setting of the running block
my $parent_try = dispatcher 'active-try';
$parent_try->hide('ALL');
=item $obj-E<gt>B<hides>($reason)
Check whether the try stops message which were produced for C<$reason>.
=item $obj-E<gt>B<isDisabled>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<mode>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<name>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<needs>( [$reason] )
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<type>()
Inherited, see L<Log::Report::Dispatcher/"Accessors">
=back
=head2 Logging
Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">.
=over 4
=item $obj-E<gt>B<addSkipStack>(@CODE)
=item Log::Report::Dispatcher::Try-E<gt>B<addSkipStack>(@CODE)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<collectLocation>()
=item Log::Report::Dispatcher::Try-E<gt>B<collectLocation>()
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<collectStack>( [$maxdepth] )
=item Log::Report::Dispatcher::Try-E<gt>B<collectStack>( [$maxdepth] )
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<log>($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<Log::Report::Message|Log::Report::Message>.
=item $obj-E<gt>B<reportAll>(%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<Log::Report::report()|Log::Report/"Report Production and Configuration">; see
L<Log::Report::Exception::throw()|Log::Report::Exception/"Processing"> which does the job.
=item $obj-E<gt>B<reportFatal>()
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<Log::Report::report()|Log::Report/"Report Production and Configuration">; see
L<Log::Report::Exception::throw()|Log::Report::Exception/"Processing"> which does the job.
=item $obj-E<gt>B<skipStack>()
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<stackTraceLine>(%options)
=item Log::Report::Dispatcher::Try-E<gt>B<stackTraceLine>(%options)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=item $obj-E<gt>B<translate>(HASH-$of-%options, $reason, $message)
Inherited, see L<Log::Report::Dispatcher/"Logging">
=back
=head2 Status
=over 4
=item $obj-E<gt>B<failed>()
Returns true if the block was left with an fatal message.
=item $obj-E<gt>B<showStatus>()
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<reportAll()|Log::Report::Dispatcher::Try/"Logging"> or L<reportFatal()|Log::Report::Dispatcher::Try/"Logging">.
=item $obj-E<gt>B<success>()
Returns true if the block exited normally.
=item $obj-E<gt>B<wasFatal>(%options)
Returns the L<Log::Report::Exception|Log::Report::Exception> 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<Log::Report::Message::inClass()|Log::Report::Message/"Processing">
=back
=back
=head1 DETAILS
Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">.
=head1 OVERLOADING
=over 4
=item overload: B<boolean>
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<if($@) {...error-handler...}>.
=item overload: B<stringify>
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.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,182 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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__

View File

@@ -0,0 +1,297 @@
=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<Log::Report> 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<Log::Report>, those packags sets are differentiated via the
text-domain value in the C<use> 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-E<gt>B<new>(%options)
Create a new Domain object.
-Option--Defined in --Default
name Log::Report::Minimal::Domain <required>
=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-E<gt>B<configure>(%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</Configuring> below.
-Option --Defined in --Default
config undef
context_rules undef
formatter PRINTI
native_language 'en_US'
translator created internally
where Log::Report::Minimal::Domain <required>
=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<context_rules>, which need to be shared between the
running application and F<xgettext-perl>. See L<readConfig()|Log::Report::Domain/"Attributes">
=item context_rules => HASH|OBJECT
When rules are provided, the translator will use the C<msgctxt> fields
as provided by PO-files (gettext). This parameter is used to initialize
a L<Log::Report::Translator::Context|Log::Report::Translator::Context> helper object.
=item formatter => CODE|HASH|'PRINTI'
Selects the formatter used for the errors messages. The default is C<PRINTI>,
which will use L<String::Print::printi()|String::Print/"FUNCTIONS">: 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<Log::Report::Translator|Log::Report::Translator>|HASH
Set the object which will do the translations for this domain.
=item where => ARRAY
=back
=item $obj-E<gt>B<contextRules>()
=item $obj-E<gt>B<defaultContext>()
Returns the current default translation context settings as HASH. You should
not modify the content of that HASH: change it by called L<setContext()|Log::Report::Domain/"Attributes"> or
L<updateContext()|Log::Report::Domain/"Attributes">.
=item $obj-E<gt>B<isConfigured>()
Inherited, see L<Log::Report::Minimal::Domain/"Attributes">
=item $obj-E<gt>B<name>()
Inherited, see L<Log::Report::Minimal::Domain/"Attributes">
=item $obj-E<gt>B<nativeLanguage>()
=item $obj-E<gt>B<readConfig>($filename)
=item Log::Report::Domain-E<gt>B<readConfig>($filename)
Helper method, which simply parses the content $filename into a HASH to be
used as parameters to L<configure()|Log::Report::Domain/"Attributes">. The filename must end on '.pl',
to indicate that it uses perl syntax (can be processed with Perl's C<do>
command) or end on '.json'. See also chapter L</Configuring> 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<Log::Report::Translator::Context|Log::Report::Translator::Context>.
=item $obj-E<gt>B<setContext>(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<defaultContext()|Log::Report::Domain/"Attributes">.
Contexts are totally ignored then there are no C<context_rules>. When
you do not wish to change settings, you may simply provide a HASH.
example:
use Log::Report 'my-domain', context_rules => {};
=item $obj-E<gt>B<translator>()
=item $obj-E<gt>B<updateContext>(STRING|HASH|ARRAY|PAIRS)
[1.10] Make changes and additions to the active context (see L<setContext()|Log::Report::Domain/"Attributes">).
=back
=head2 Action
Extends L<"Action" in Log::Report::Minimal::Domain|Log::Report::Minimal::Domain/"Action">.
=over 4
=item $obj-E<gt>B<interpolate>( $msgid, [$args] )
Inherited, see L<Log::Report::Minimal::Domain/"Action">
=item $obj-E<gt>B<translate>($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<Log::Report::Optional|Log::Report::Optional>, which is a dressed-down
version of L<Log::Report|Log::Report>.
=head3 configuring your own formatter
[0.91] The C<PRINTI> is a special constants for L<configure(formatter)|Log::Report::Domain/"Attributes">, and
will use L<String::Print|String::Print> function C<printi()>, 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<String::Print>,
you need to pass a CODE. Be aware that you may loose magic added by
L<Log::Report|Log::Report> and other layers, like L<Log::Report::Template|Log::Report::Template>:
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 enabled 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.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,101 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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() { is_fatal shift->{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;

View File

@@ -0,0 +1,165 @@
=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-E<gt>B<new>(%options)
-Option --Default
message <required>
reason <required>
report_opts {}
=over 2
=item message => Log::Report::Message
=item reason => REASON
=item report_opts => HASH
=back
=back
=head2 Accessors
=over 4
=item $obj-E<gt>B<isFatal>()
Returns whether this exception has a severity which makes it fatal
when thrown. See L<Log::Report::Util::is_fatal()|Log::Report::Util/"Reasons">.
example:
if($ex->isFatal) { $ex->throw(reason => 'ALERT') }
else { $ex->throw }
=item $obj-E<gt>B<message>( [$message] )
Change the $message of the exception, must be a L<Log::Report::Message|Log::Report::Message>
object.
When you use a C<Log::Report::Message> 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-E<gt>B<reason>( [$reason] )
=item $obj-E<gt>B<report_opts>()
=back
=head2 Processing
=over 4
=item $obj-E<gt>B<inClass>($class|Regexp)
Check whether any of the classes listed in the message match $class
(string) or the Regexp. This uses L<Log::Report::Message::inClass()|Log::Report::Message/"Processing">.
=item $obj-E<gt>B<print>( [$fh] )
The default filehandle is STDOUT.
example:
print $exception; # via overloading
$exception->print; # OO style
=item $obj-E<gt>B<throw>(%options)
Insert the message contained in the exception into the currently
defined dispatchers. The C<throw> name is commonly known
exception related terminology for C<report>.
The %options overrule the captured options to L<Log::Report::report()|Log::Report/"Report Production and Configuration">.
This can be used to overrule a destination. Also, the reason can
be changed.
example: overrule defaults to report
try { print {to => 'stderr'}, ERROR => 'oops!' };
$@->reportFatal(to => 'syslog');
$exception->throw(to => 'syslog');
$@->wasFatal->throw(reason => 'WARNING');
=item $obj-E<gt>B<toHTML>( [$locale] )
[1.11] as L<toString()|Log::Report::Exception/"Processing">, and escape HTML volatile characters.
=item $obj-E<gt>B<toString>( [$locale] )
Prints the reason and the message. Differently from L<throw()|Log::Report::Exception/"Processing">, 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<stringification>
Produces "reason: message".
=back
=head1 SEE ALSO
This module is part of Log-Report distribution version 1.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,200 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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() {shift->{_prepend}}
sub msgid() {shift->{_msgid}}
sub append() {shift->{_append}}
sub domain() {shift->{_domain}}
sub count() {shift->{_count}}
sub context() {shift->{_context}}
sub msgctxt() {shift->{_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 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} // '';
if(blessed $prepend) {
$prepend = $prepend->isa(__PACKAGE__) ? $prepend->toString($locale)
: "$prepend";
}
if(blessed $append) {
$append = $append->isa(__PACKAGE__) ? $append->toString($locale)
: "$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;
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;

View File

@@ -0,0 +1,566 @@
=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<Log::Report|Log::Report>, 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-E<gt>B<clone>(%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-E<gt>B<fromTemplateToolkit>($domain, $msgid, $params)
See L<Log::Report::Extract::Template|Log::Report::Extract::Template> on the details how to integrate
Log::Report translations with Template::Toolkit (version 1 and 2)
=item Log::Report::Message-E<gt>B<new>(%options)
B<End-users: do not use this method directly>, but use L<Log::Report::__()|Log::Report/"Messages (optionally translatable)">
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 <from "use Log::Report">
_expand false
_join $" $LIST_SEPARATOR
_lang <from locale>
_msgctxt undef
_msgid undef
_plural undef
_prepend undef
_to <undef>
=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<Log::Report::Dispatcher::Try::wasFatal(class)|Log::Report::Dispatcher::Try/"Status">, 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<classes()|Log::Report::Message/"Accessors">.
=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<Log::Report::Translator::Context|Log::Report::Translator::Context>
=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<to()|Log::Report::Message/"Accessors">
=back
=back
=head2 Accessors
=over 4
=item $obj-E<gt>B<append>()
Returns the string or L<Log::Report::Message|Log::Report::Message> object which is appended
after this one. Usually C<undef>.
=item $obj-E<gt>B<classes>()
Returns the LIST of classes which are defined for this message; message
group indicators, as often found in exception-based programming.
=item $obj-E<gt>B<context>()
Returns an HASH if there is a context defined for this message.
=item $obj-E<gt>B<count>()
Returns the count, which is used to select the translation
alternatives.
=item $obj-E<gt>B<domain>()
Returns the domain of the first translatable string in the structure.
=item $obj-E<gt>B<msgctxt>()
The message context for the translation table lookup.
=item $obj-E<gt>B<msgid>()
Returns the msgid which will later be translated.
=item $obj-E<gt>B<prepend>()
Returns the string which is prepended to this one. Usually C<undef>.
=item $obj-E<gt>B<to>( [$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-E<gt>B<valueOf>($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
, _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-E<gt>B<concat>( 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<Log::Report::Message>) needs to prepended, otherwise
it is appended.
example: of concatenation
print __"Hello" . ' ' . __"World!";
print __("Hello")->concat(' ')->concat(__"World!")->concat("\n");
=item $obj-E<gt>B<inClass>($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-E<gt>B<toHTML>( [$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<<content_for => 'HTML'>> in L<Log::Report::Domain::configure(formatter)|Log::Report::Domain/"Attributes">.
example:
print $msg->toHTML('NL');
=item $obj-E<gt>B<toString>( [$locale] )
Translate a message. If not specified, the default locale is used.
=item $obj-E<gt>B<untranslated>()
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<Log::Report|Log::Report> 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<scalar> 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<nr_files>
parameter can disappear.
=head3 Interpolation of VARIABLES
C<Log::Report> uses L<String::Print> 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<String::Print> in C<Log::Report::Message> 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<Log::Report::Message> 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<Log::Report::Message> 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<Log::Report::__()|Log::Report/"Messages (optionally translatable)"> and L<Log::Report::__x()|Log::Report/"Messages (optionally translatable)">
=item _plural, _count
The PLURAL MSGIDs, respectively the COUNT as used with
L<Log::Report::__n()|Log::Report/"Messages (optionally translatable)"> and L<Log::Report::__nx()|Log::Report/"Messages (optionally translatable)">
=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<inClass()|Log::Report::Message/"Processing">,
L<Log::Report::Exception::inClass()|Log::Report::Exception/"Processing">, or
L<Log::Report::Dispatcher::Try::wasFatal()|Log::Report::Dispatcher::Try/"Status">.
=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<Log::Report>, 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<for my $i> 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<as $function>
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<clone()>.
=item overload: B<concatenation>
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<stringification>
When the object is used in string context, it will get translated.
Implemented as L<toString()|Log::Report::Message/"Processing">.
=back
=head1 SEE ALSO
This module is part of Log-Report distribution version 1.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,227 @@
# Copyrights 2013-2021 by [Mark Overmeer <mark@overmeer.net>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution Log-Report-Optional. 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::Minimal;
use vars '$VERSION';
$VERSION = '1.07';
use base 'Exporter';
use warnings;
use strict;
use Log::Report::Util;
use List::Util qw/first/;
use Scalar::Util qw/blessed/;
use Log::Report::Minimal::Domain ();
### 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/;
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 trace(@); sub assert(@); sub info(@); sub notice(@); sub warning(@);
sub mistake(@); sub error(@); sub fault(@); sub alert(@); sub failure(@);
sub panic(@); sub report(@); sub textdomain($@);
sub __($); sub __x($@); sub __n($$$@); sub __nx($$$@); sub __xn($$$@);
sub N__($); sub N__n($$); sub N__w(@);
my ($mode, %need);
sub need($)
{ $mode = shift;
%need = map +($_ => 1), expand_reasons mode_accepts $mode;
}
need 'NORMAL';
my %textdomains;
textdomain 'default';
sub _interpolate(@)
{ my ($msgid, %args) = @_;
my $textdomain = $args{_domain};
unless($textdomain)
{ my ($pkg) = caller 1;
$textdomain = pkg2domain $pkg;
}
(textdomain $textdomain)->interpolate($msgid, \%args);
}
#
# Some initiations
#
sub textdomain($@)
{ if(@_==1 && blessed $_[0])
{ my $domain = shift;
return $textdomains{$domain->name} = $domain;
}
if(@_==2)
{ # used for 'maintenance' and testing
return delete $textdomains{$_[0]} if $_[1] eq 'DELETE';
return $textdomains{$_[0]} if $_[1] eq 'EXISTS';
}
my $name = shift;
my $domain = $textdomains{$name}
||= Log::Report::Minimal::Domain->new(name => $name);
@_ ? $domain->configure(@_, where => [caller]) : $domain;
}
# $^S = $EXCEPTIONS_BEING_CAUGHT; parse: undef, eval: 1, else 0
sub _report($$@)
{ my ($opts, $reason) = (shift, shift);
# return when no-one needs it: skip unused trace() fast!
my $stop = exists $opts->{is_fatal} ? $opts->{is_fatal} : is_fatal $reason;
$need{$reason} || $stop or return;
is_reason $reason
or error __x"token '{token}' not recognized as reason", token=>$reason;
$opts->{errno} ||= $!+0 || $? || 1
if use_errno($reason) && !defined $opts->{errno};
my $message = shift;
@_%2 and error __x"odd length parameter list with '{msg}'", msg => $message;
my $show = lc($reason).': '.$message;
if($stop)
{ # ^S = EXCEPTIONS_BEING_CAUGHT, within eval or try
$! = $opts->{errno} || 0;
die "$show\n"; # call the die handler
}
else
{ warn "$show\n"; # call the warn handler
}
1;
}
sub dispatcher($@) { panic "no dispatchers available in ".__PACKAGE__ }
sub try(&@)
{ my $code = shift;
@_ % 2 and report {}, PANIC =>
__x"odd length parameter list for try(): forgot the terminating ';'?";
#XXX MO: only needs the fatal subset, exclude the warns/prints
eval { $code->() };
}
sub report(@)
{ my %opt = @_ && ref $_[0] eq 'HASH' ? %{ (shift) } : ();
_report \%opt, @_;
}
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 __($) { shift }
sub __x($@)
{ @_%2 or error __x"even length parameter list for __x at {where}"
, where => join(' line ', (caller)[1,2]);
_interpolate @_, _expand => 1;
}
sub __n($$$@)
{ my ($single, $plural, $count) = (shift, shift, shift);
_interpolate +($count==1 ? $single : $plural)
, _count => $count, @_;
}
sub __nx($$$@)
{ my ($single, $plural, $count) = (shift, shift, shift);
_interpolate +($count==1 ? $single : $plural)
, _count => $count, _expand => 1, @_;
}
sub __xn($$$@) # repeated for prototype
{ my ($single, $plural, $count) = (shift, shift, shift);
_interpolate +($count==1 ? $single : $plural)
, _count => $count , _expand => 1, @_;
}
sub N__($) { $_[0] }
sub N__n($$) {@_}
sub N__w(@) {split " ", $_[0]}
#------------------
sub import(@)
{ my $class = shift;
my $to_level = @_ && $_[0] =~ m/^\+\d+$/ ? shift : 0;
my $textdomain = @_%2 ? shift : 'default';
my %opts = @_;
my $syntax = delete $opts{syntax} || 'SHORT';
my ($pkg, $fn, $linenr) = caller $to_level;
pkg2domain $pkg, $textdomain, $fn, $linenr;
my $domain = textdomain $textdomain;
need delete $opts{mode}
if defined $opts{mode};
my @export;
if(my $in = $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}'"
, flag => $syntax;
}
}
$class->export_to_level(1+$to_level, undef, @export);
$domain->configure(%opts, where => [$pkg, $fn, $linenr ])
if %opts;
}
1;

View File

@@ -0,0 +1,135 @@
=encoding utf8
=head1 NAME
Log::Report::Minimal - simulate Log::Report functions simple
=head1 INHERITANCE
Log::Report::Minimal
is a Exporter
=head1 SYNOPSIS
# See Log::Report, most functions get "hollow" behavior
use Log::Report::Optional mode => 'DEBUG';
=head1 DESCRIPTION
This module implements the functions provided by Log::Report, but then
as simple as possible: no support for translations, no dispatchers, no
smart exceptions. The package uses C<Log::Report> in an C<::Optional>
way, the main script determines whether it wants the C<::Minimal> or
full-blown feature set.
=head1 FUNCTIONS
=over 4
=item B<textdomain>( <[$name],$config>|<$name, 'DELETE'|'EXISTS'>|$domain )
=back
=head2 Report Production and Configuration
=over 4
=item B<dispatcher>( <$type, $name, %options>|<$command, @names> )
Not supported.
=item B<report>( [$options], $reason, $message|<STRING,$params> )
Be warned that %options is a HASH here.
-Option --Default
errno $! or 1
is_fatal <depends on reason>
=over 2
=item errno => INTEGER
=item is_fatal => BOOLEAN
=back
=item B<try>(CODE, %options)
=back
=head2 Abbreviations for report()
=over 4
=item B<alert>($message)
=item B<assert>($message)
=item B<error>($message)
=item B<failure>($message)
=item B<fault>($message)
=item B<info>($message)
=item B<mistake>($message)
=item B<notice>($message)
=item B<panic>($message)
=item B<trace>($message)
=item B<warning>($message)
=back
=head2 Language Translations
No translations, no L<Log::Report::Message> objects returned.
=over 4
=item B<N__>($msgid)
=item B<N__n>($single_msgid, $plural_msgid)
=item B<N__w>(STRING)
=item B<__>($msgid)
=item B<__n>($msgid, $plural_msgid, $count, PAIRS)
=item B<__nx>($msgid, $plural_msgid, $count, PAIRS)
=item B<__x>($msgid, PAIRS)
=item B<__xn>($single_msgid, $plural_msgid, $count, PAIRS)
=back
=head2 Configuration
=over 4
=item $obj-E<gt>B<import>( [$domain], %options )
See Log::Report subroutine import.
=back
=head1 SEE ALSO
This module is part of Log-Report-Optional distribution version 1.07,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2013-2021 by [Mark Overmeer <mark@overmeer.net>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,74 @@
# Copyrights 2013-2021 by [Mark Overmeer <mark@overmeer.net>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution Log-Report-Optional. 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::Minimal::Domain;
use vars '$VERSION';
$VERSION = '1.07';
use warnings;
use strict;
use String::Print 'oo';
sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) }
sub init($)
{ my ($self, $args) = @_;
$self->{LRMD_name} = $args->{name} or Log::Report::panic();
$self;
}
#----------------
sub name() {shift->{LRMD_name}}
sub isConfigured() {shift->{LRMD_where}}
sub configure(%)
{ my ($self, %args) = @_;
my $here = $args{where} || [caller];
if(my $s = $self->{LRMD_where})
{ my $domain = $self->name;
die "only one package can contain configuration; for $domain already in $s->[0] in file $s->[1] line $s->[2]. Now also found at $here->[1] line $here->[2]\n";
}
my $where = $self->{LRMD_where} = $here;
# documented in the super-class, the more useful man-page
my $format = $args{formatter} || 'PRINTI';
$format = {} if $format eq 'PRINTI';
if(ref $format eq 'HASH')
{ my $class = delete $format->{class} || 'String::Print';
my $method = delete $format->{method} || 'sprinti';
my $sp = $class->new(%$format);
$self->{LRMD_format} = sub { $sp->$method(@_) };
}
elsif(ref $format eq 'CODE')
{ $self->{LRMD_format} = $format;
}
else
{ error __x"illegal formatter `{name}' at {fn} line {line}"
, name => $format, fn => $where->[1], line => $where->[2];
}
$self;
}
#-------------------
sub interpolate(@)
{ my ($self, $msgid, $args) = @_;
$args->{_expand} or return $msgid;
my $f = $self->{LRMD_format} || $self->configure->{LRMD_format};
$f->($msgid, $args);
}
1;

View File

@@ -0,0 +1,88 @@
=encoding utf8
=head1 NAME
Log::Report::Minimal::Domain - administer one text-domain
=head1 SYNOPSIS
use Log::Report::Minimal::Domain;
my $domain = Log::Report::Minimal::Domain->new(name => $name);
# normal usage
use Log::Report::Optional; # or Log::Report itself
my $domain = textdomain $name; # find config
textdomain $name, %configure; # set config, only once.
=head1 DESCRIPTION
Read L<Log::Report::Domain>.
=head1 METHODS
=head2 Constructors
=over 4
=item Log::Report::Minimal::Domain-E<gt>B<new>(%options)
-Option--Default
name <required>
=over 2
=item name => STRING
=back
=back
=head2 Attributes
=over 4
=item $obj-E<gt>B<configure>(%options)
-Option--Default
where <required>
=over 2
=item where => ARRAY
Specifies the location of the configuration. It is not allowed to
configure a domain on more than one location.
=back
=item $obj-E<gt>B<isConfigured>()
=item $obj-E<gt>B<name>()
=back
=head2 Action
=over 4
=item $obj-E<gt>B<interpolate>( $msgid, [$args] )
Interpolate the keys used in C<$msgid> from the values in C<$args>.
This is handled by the formatter, by default a L<String::Print|String::Print>
instance.
=back
=head1 SEE ALSO
This module is part of Log-Report-Optional distribution version 1.07,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2013-2021 by [Mark Overmeer <mark@overmeer.net>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,43 @@
# Copyrights 2013-2021 by [Mark Overmeer <mark@overmeer.net>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution Log-Report-Optional. 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::Optional;
use vars '$VERSION';
$VERSION = '1.07';
use base 'Exporter';
use warnings;
use strict;
my ($supported, @used_by);
BEGIN {
if($INC{'Log/Report.pm'})
{ $supported = 'Log::Report';
my $version = $Log::Report::VERSION;
die "Log::Report too old for ::Optional, need at least 1.00"
if $version && $version le '1.00';
}
else
{ require Log::Report::Minimal;
$supported = 'Log::Report::Minimal';
}
}
sub import(@)
{ my $class = shift;
push @used_by, (caller)[0];
$supported->import('+1', @_);
}
sub usedBy() { @used_by }
1;

View File

@@ -0,0 +1,62 @@
=encoding utf8
=head1 NAME
Log::Report::Optional - pick Log::Report or ::Minimal
=head1 INHERITANCE
Log::Report::Optional
is a Exporter
=head1 SYNOPSIS
# Use Log::Report when already loaded, otherwise Log::Report::Minimal
package My::Package;
use Log::Report::Optional 'my-domain';
=head1 DESCRIPTION
This module will allow libraries (helper modules) to have a dependency
to a small module instead of the full Log-Report distribution. The full
power of C<Log::Report> is only released when the main program uses that
module. In that case, the module using the 'Optional' will also use the
full Log::Report, otherwise the dressed-down L<Log::Report::Minimal|Log::Report::Minimal>
version.
For the full documentation:
=over 4
=item * see Log::Report when it is used by main
=item * see L<Log::Report::Minimal|Log::Report::Minimal> otherwise
=back
The latter provides the same functions from the former, but is the
simpelest possible way.
=head1 METHODS
=over 4
=item Log::Report::Optional-E<gt>B<usedBy>()
Returns the classes which loaded the optional module.
=back
=head1 SEE ALSO
This module is part of Log-Report-Optional distribution version 1.07,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2013-2021 by [Mark Overmeer <mark@overmeer.net>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,40 @@
# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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;
use vars '$VERSION';
$VERSION = '1.31';
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;

View File

@@ -0,0 +1,79 @@
=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<gettext>. The translator is based on some C<textdomain>
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-E<gt>B<new>(%options)
=back
=head2 Accessors
=head2 Translating
=over 4
=item $obj-E<gt>B<load>($domain, $locale)
Load the translation information in the text $domain for the indicated $locale.
Multiple calls to L<load()|Log::Report::Translator/"Translating"> should not cost significant performance: the
data must be cached.
=item $obj-E<gt>B<translate>( $message, [$language, $ctxt] )
Returns the translation of the $message, a C<Log::Report::Message> 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.31,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,223 @@
# Copyrights 2013-2021 by [Mark Overmeer <mark@overmeer.net>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution Log-Report-Optional. 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::Util;
use vars '$VERSION';
$VERSION = '1.07';
use base 'Exporter';
use warnings;
use strict;
use String::Print qw(printi);
our @EXPORT = qw/
@reasons is_reason is_fatal use_errno
mode_number expand_reasons mode_accepts
must_show_location must_show_stack
escape_chars unescape_chars to_html
parse_locale
pkg2domain
/;
# [0.994 parse_locale deprecated, but kept hidden]
our @EXPORT_OK = qw/%reason_code/;
#use Log::Report 'log-report';
sub N__w($) { split ' ', $_[0] }
# ordered!
our @reasons = N__w('TRACE ASSERT INFO NOTICE WARNING
MISTAKE ERROR FAULT ALERT FAILURE PANIC');
our %reason_code; { my $i=1; %reason_code = map +($_ => $i++), @reasons }
my %reason_set = (
ALL => \@reasons,
FATAL => [ qw/ERROR FAULT FAILURE PANIC/ ],
NONE => [ ],
PROGRAM => [ qw/TRACE ASSERT INFO NOTICE WARNING PANIC/ ],
SYSTEM => [ qw/FAULT ALERT FAILURE/ ],
USER => [ qw/MISTAKE ERROR/ ],
);
my %is_fatal = map +($_ => 1), @{$reason_set{FATAL}};
my %use_errno = map +($_ => 1), qw/FAULT ALERT FAILURE/;
my %modes = (NORMAL => 0, VERBOSE => 1, ASSERT => 2, DEBUG => 3
, 0 => 0, 1 => 1, 2 => 2, 3 => 3);
my @mode_accepts = ('NOTICE-', 'INFO-', 'ASSERT-', 'ALL');
# horrible mutual dependency with Log::Report(::Minimal)
sub error__x($%)
{ if(Log::Report::Minimal->can('error')) # loaded the ::Mimimal version
{ Log::Report::Minimal::error(Log::Report::Minimal::__x(@_)) }
else { Log::Report::error(Log::Report::__x(@_)) }
}
sub expand_reasons($)
{ my $reasons = shift or return ();
$reasons = [ split m/\,/, $reasons ] if ref $reasons ne 'ARRAY';
my %r;
foreach my $r (@$reasons)
{ if($r =~ m/^([a-z]*)\-([a-z]*)/i )
{ my $begin = $reason_code{$1 || 'TRACE'};
my $end = $reason_code{$2 || 'PANIC'};
$begin && $end
or error__x "unknown reason {which} in '{reasons}'"
, which => ($begin ? $2 : $1), reasons => $reasons;
error__x"reason '{begin}' more serious than '{end}' in '{reasons}"
, begin => $1, end => $2, reasons => $reasons
if $begin >= $end;
$r{$_}++ for $begin..$end;
}
elsif($reason_code{$r}) { $r{$reason_code{$r}}++ }
elsif(my $s = $reason_set{$r}) { $r{$reason_code{$_}}++ for @$s }
else
{ error__x"unknown reason {which} in '{reasons}'"
, which => $r, reasons => $reasons;
}
}
(undef, @reasons)[sort {$a <=> $b} keys %r];
}
sub is_reason($) { $reason_code{$_[0]} }
sub is_fatal($) { $is_fatal{$_[0]} }
sub use_errno($) { $use_errno{$_[0]} }
#--------------------------
sub mode_number($) { $modes{$_[0]} }
sub mode_accepts($) { $mode_accepts[$modes{$_[0]}] }
sub must_show_location($$)
{ my ($mode, $reason) = @_;
$reason eq 'ASSERT'
|| $reason eq 'PANIC'
|| ($mode==2 && $reason_code{$reason} >= $reason_code{WARNING})
|| ($mode==3 && $reason_code{$reason} >= $reason_code{MISTAKE});
}
sub must_show_stack($$)
{ my ($mode, $reason) = @_;
$reason eq 'PANIC'
|| ($mode==2 && $reason_code{$reason} >= $reason_code{ALERT})
|| ($mode==3 && $reason_code{$reason} >= $reason_code{ERROR});
}
#-------------------------
my %unescape =
( '\a' => "\a", '\b' => "\b", '\f' => "\f", '\n' => "\n"
, '\r' => "\r", '\t' => "\t", '\"' => '"', '\\\\' => '\\'
, '\e' => "\x1b", '\v' => "\x0b"
);
my %escape = reverse %unescape;
sub escape_chars($)
{ my $str = shift;
$str =~ s/([\x00-\x1F\x7F"\\])/$escape{$1} || '?'/ge;
$str;
}
sub unescape_chars($)
{ my $str = shift;
$str =~ s/(\\.)/$unescape{$1} || $1/ge;
$str;
}
my %tohtml = qw/ > gt < lt " quot & amp /;
sub to_html($)
{ my $s = shift;
$s =~ s/([<>"&])/\&${tohtml{$1}};/g;
$s;
}
sub parse_locale($)
{ my $locale = shift;
defined $locale && length $locale
or return;
if($locale !~
m/^ ([a-z_]+)
(?: \. ([\w-]+) )? # codeset
(?: \@ (\S+) )? # modifier
$/ix)
{ # Windows Finnish_Finland.1252?
$locale =~ s/.*\.//;
return wantarray ? ($locale) : { language => $locale };
}
my ($lang, $codeset, $modifier) = ($1, $2, $3);
my @subtags = split /[_-]/, $lang;
my $primary = lc shift @subtags;
my $language
= $primary eq 'c' ? 'C'
: $primary eq 'posix' ? 'POSIX'
: $primary =~ m/^[a-z]{2,3}$/ ? $primary # ISO639-1 and -2
: $primary eq 'i' && @subtags ? lc(shift @subtags) # IANA
: $primary eq 'x' && @subtags ? lc(shift @subtags) # Private
: error__x"unknown locale language in locale `{locale}'"
, locale => $locale;
my $script;
$script = ucfirst lc shift @subtags
if @subtags > 1 && length $subtags[0] > 3;
my $territory = @subtags ? uc(shift @subtags) : undef;
return ($language, $territory, $codeset, $modifier)
if wantarray;
+{ language => $language
, script => $script
, territory => $territory
, codeset => $codeset
, modifier => $modifier
, variant => join('-', @subtags)
};
}
my %pkg2domain;
sub pkg2domain($;$$$)
{ my $pkg = shift;
my $d = $pkg2domain{$pkg};
@_ or return $d ? $d->[0] : 'default';
my ($domain, $fn, $line) = @_;
if($d)
{ # registration already exists
return $domain if $d->[0] eq $domain;
printi "conflict: package {pkg} in {domain1} in {file1} line {line1}, but in {domain2} in {file2} line {line2}"
, pkg => $pkg
, domain1 => $domain, file1 => $fn, line1 => $line
, domain2 => $d->[0], file2 => $d->[1], line2 => $d->[2];
}
# new registration
$pkg2domain{$pkg} = [$domain, $fn, $line];
$domain;
}
1;

View File

@@ -0,0 +1,149 @@
=encoding utf8
=head1 NAME
Log::Report::Util - helpful routines to Log::Report
=head1 INHERITANCE
Log::Report::Util
is a Exporter
=head1 SYNOPSIS
my ($language, $territory, $charset, $modifier)
= parse_locale 'nl_BE.utf-8@home';
my @take = expand_reasons 'INFO-ERROR,PANIC';
=head1 DESCRIPTION
This module collects a few functions and definitions which are shared
between different components in the Log::Report infrastructure.
They should not be needed for end-user applications, although this
man-page may contain some useful background information.
=head1 FUNCTIONS
=head2 Reasons
=over 4
=item B<expand_reasons>($reasons)
Returns a sub-set of all existing message reason labels, based on the
content $reasons string. The following rules apply:
REASONS = BLOCK [ ',' BLOCKS ] | ARRAY-of-REASON
BLOCK = '-' TO | FROM '-' TO | ONE | SOURCE
FROM,TO,ONE = 'TRACE' | 'ASSERT' | ,,, | 'PANIC'
SOURCE = 'USER' | 'PROGRAM' | 'SYSTEM' | 'FATAL' | 'ALL' | 'NONE'
The SOURCE specification group all reasons which are usually related to
the problem: report about problems caused by the user, reported by
the program, or with system interaction.
example: of expended REASONS
WARNING-FAULT # == WARNING,MISTAKE,ERROR,FAULT
WARNING,INFO # == WARNING,INFO
-INFO # == TRACE-INFO
ALERT- # == ALERT,FAILURE,PANIC
USER # == MISTAKE,ERROR
ALL # == TRACE-PANIC
FATAL # == ERROR,FAULT,FAILURE,PANIC [1.07]
NONE # ==
=item B<is_fatal>($reason)
Returns true if the $reason is severe enough to cause an exception
(or program termination).
=item B<is_reason>($name)
Returns true if the STRING is one of the predefined REASONS.
=item B<use_errno>($reason)
=back
=head2 Modes
Run-modes are explained in Log::Report::Dispatcher.
=over 4
=item B<mode_accepts>($mode)
Returns something acceptable by L<expand_reasons()|Log::Report::Util/"Reasons">
=item B<mode_number>($name|$mode)
Returns the $mode as number.
=item B<must_show_location>($mode, $reason)
=item B<must_show_stack>($mode, $reason)
=back
=head2 Other
=over 4
=item B<escape_chars>(STRING)
Replace all escape characters into their readable counterpart. For
instance, a new-line is replaced by backslash-n.
=item B<parse_locale>(STRING)
Decompose a locale string.
For simplicity of the caller's code, the capatization of the returned
fields is standardized to the preferred, although the match is case-
insensitive as required by the RFC. The territory in returned in capitals
(ISO3166), the language is lower-case (ISO639), the script as upper-case
first, the character-set as lower-case, and the modifier and variant unchanged.
In LIST context, four elements are returned: language, territory,
character-set (codeset), and modifier. Those four are important for the
usual unix translationg infrastructure. Only the "country" is obligatory,
the others can be C<undef>. It may also return C<C> and C<POSIX>.
In SCALAR context, a HASH is returned which can contain more information:
language, script, territory, variant, codeset, and modifiers. The
variant (RFC3066 is probably never used)
=item B<pkg2domain>( $package, [$domain, $filename, $line] )
With $domain, $filename and $line, this registers a location where the
textdomain is specified. Each $package can only belong to one $domain.
Without these parameters, the registered domain for the $package is
returned.
=item B<to_html>($string)
[1.02] Escape HTML volatile characters.
=item B<unescape_chars>(STRING)
Replace all backslash-something escapes by their escape character.
For instance, backslash-t is replaced by a tab character.
=back
=head1 SEE ALSO
This module is part of Log-Report-Optional distribution version 1.07,
built on January 15, 2021. Website: F<http://perl.overmeer.net/CPAN/>
=head1 LICENSE
Copyrights 2013-2021 by [Mark Overmeer <mark@overmeer.net>]. 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<http://dev.perl.org/licenses/>

View File

@@ -0,0 +1,136 @@
#. 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 ""

View File

@@ -0,0 +1,569 @@
#. 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: 2013-08-22 16:17+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/Util.pm:14
#, fuzzy
msgid "ALERT"
msgstr ""
#: lib/Log/Report/Util.pm:14
#, fuzzy
msgid "ASSERT"
msgstr ""
#: lib/Log/Report/Util.pm:14
#, fuzzy
msgid "ERROR"
msgstr ""
#: lib/Log/Report/Util.pm:14
#, fuzzy
msgid "FAILURE"
msgstr ""
#: lib/Log/Report/Util.pm:14
#, fuzzy
msgid "FAULT"
msgstr ""
#: lib/Log/Report/Util.pm:14
#, fuzzy
msgid "INFO"
msgstr ""
#: lib/Log/Report/Dispatcher/LogDispatch.pm:105
#, fuzzy
msgid "Log::Dispatch level '{level}' not understood"
msgid_plural "level"
msgstr[0] ""
msgstr[1] ""
#: lib/Log/Report/Dispatcher/Log4perl.pm:100
#, fuzzy
msgid "Log::Log4perl back-end {name} requires a 'config' parameter"
msgstr ""
#: lib/Log/Report/Dispatcher/Log4perl.pm:111
#, fuzzy
msgid "Log::Log4perl level '{level}' must be in 0-5"
msgstr ""
#: lib/Log/Report/Util.pm:14
#, fuzzy
msgid "MISTAKE"
msgstr ""
#: lib/Log/Report/Util.pm:14
#, fuzzy
msgid "NOTICE"
msgstr ""
#: lib/Log/Report/Dispatcher/Log4perl.pm:27
#: lib/Log/Report/Dispatcher/LogDispatch.pm:27
#: lib/Log/Report/Dispatcher/Syslog.pm:28
#, fuzzy
msgid "Not all reasons have a default translation"
msgstr ""
#: lib/Log/Report/Util.pm:14
#, fuzzy
msgid "PANIC"
msgstr ""
#: lib/Log/Report/Extract/PerlPPI.pm:66
#, fuzzy
msgid "PPI only supports iso-8859-1 (latin-1) on the moment"
msgstr ""
#: lib/Log/Report/Dispatcher.pm:152
#, fuzzy
msgid "Perl does not support charset {cs}"
msgstr ""
#: lib/Log/Report/Util.pm:14
#, fuzzy
msgid "TRACE"
msgstr ""
#: lib/Log/Report/Util.pm:14
#, fuzzy
msgid "WARNING"
msgstr ""
#: lib/Log/Report.pm:256
#, fuzzy
msgid "a message object is reported with more parameters"
msgstr ""
#: lib/Log/Report/Dispatcher.pm:299 lib/Log/Report/Dispatcher.pm:309
#, fuzzy
msgid "at {filename} line {line}"
msgstr ""
#: lib/Log/Report/Extract.pm:50
#, fuzzy
msgid "cannot create lexicon directory {dir}"
msgstr ""
#: bin/xgettext-perl:57
#, fuzzy
msgid "cannot create output directory {dir}"
msgstr ""
#: lib/Log/Report/Dispatcher/Log4perl.pm:121
#, fuzzy
msgid "cannot find logger '{name}' in configuration {config}"
msgstr ""
#: bin/xgettext-perl:65
#, fuzzy
msgid "cannot read filename list from {fn}"
msgstr ""
#: lib/Log/Report/Extract/PerlPPI.pm:69
#, fuzzy
msgid "cannot read from file {filename}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:70 lib/Log/Report/Lexicon/POT.pm:149
#: lib/Log/Report/Lexicon/POTcompact.pm:60
#, fuzzy
msgid "cannot read in {cs} from file {fn}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:77
#, fuzzy
msgid "cannot read magic from {fn}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:129
#, fuzzy
msgid "cannot read msgids from {fn}, need {size} at {loc}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:101
#, fuzzy
msgid "cannot read originals from {fn}, need {size} at {loc}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:87
#, fuzzy
msgid "cannot read superblock from {fn}"
msgstr ""
#: lib/Log/Report/Extract/Template.pm:98
#, fuzzy
msgid "cannot read template from {fn}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:208
#, fuzzy
msgid "cannot read transl late from {fn}, need {size} at {loc}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:112
#: lib/Log/Report/Lexicon/MOTcompact.pm:140
#, fuzzy
msgid "cannot read translations from {fn}, need {size} at {loc}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:123
#, fuzzy
msgid "cannot seek to {loc} in {fn} for msgid strings"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:97
#, fuzzy
msgid "cannot seek to {loc} in {fn} for originals"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:134
#, fuzzy
msgid "cannot seek to {loc} in {fn} for transl strings"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:108
#, fuzzy
msgid "cannot seek to {loc} in {fn} for translations"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:203
#, fuzzy
msgid "cannot seek to {loc} late in {fn} for transl strings"
msgstr ""
#: lib/Log/Report/Dispatcher/File.pm:96
#, fuzzy
msgid "cannot write log into {file} with {binmode}"
msgstr ""
#: lib/Log/Report/Lexicon/POT.pm:203
#, fuzzy
msgid "cannot write to file {fn} in {layers}"
msgstr ""
#: lib/Log/Report/Lexicon/POT.pm:106 lib/Log/Report/Lexicon/POT.pm:146
#, fuzzy
msgid "charset parameter is required for {fn}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:57
#: lib/Log/Report/Lexicon/POTcompact.pm:57
#, fuzzy
msgid "charset parameter required for {fn}"
msgstr ""
#: lib/Log/Report/Dispatcher/Callback.pm:62
#, fuzzy
msgid "dispatcher {name} needs a 'callback'"
msgstr ""
#: lib/Log/Report/Dispatcher/File.pm:85
#, fuzzy
msgid "dispatcher {name} needs parameter 'to'"
msgstr ""
#: bin/xgettext-perl:62
#, fuzzy
msgid "do not combine command-line filenames with --files-from"
msgstr ""
#: lib/Log/Report/Extract/PerlPPI.pm:170
#, fuzzy
msgid "do not interpolate in msgid (found '{var}' in line {line})"
msgstr ""
#: lib/Log/Report/Lexicon/PO.pm:374
#, fuzzy
msgid "do not understand command '{cmd}' at {where}"
msgstr ""
#: lib/Log/Report/Lexicon/PO.pm:391
#, fuzzy
msgid ""
"do not understand line at {where}:\n"
" {line}"
msgstr ""
#: lib/Log/Report.pm:656
#, fuzzy
msgid "even length parameter list for __x at {where}"
msgstr ""
#: bin/xgettext-perl:54
#, fuzzy
msgid "explicit output directory (-p) required"
msgstr ""
#: lib/Log/Report/Extract.pm:47
#, fuzzy
msgid "extractions require an explicit lexicon directory"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:162 lib/Log/Report/Lexicon/POT.pm:169
#: lib/Log/Report/Lexicon/POTcompact.pm:100
#, fuzzy
msgid "failed reading from file {fn}"
msgstr ""
#: lib/Log/Report/Extract.pm:199
#, fuzzy
msgid "found one pot file for domain {domain}"
msgid_plural "found {_count} pot files for domain {domain}"
msgstr[0] ""
msgstr[1] ""
#: lib/Log/Report/Dispatcher.pm:146
#, fuzzy
msgid "illegal format_reason '{format}' for dispatcher"
msgstr ""
#: lib/Log/Report/Lexicon/Table.pm:98
#, fuzzy
msgid "invalid plural-form algorithm '{alg}'"
msgstr ""
#: lib/Log/Report/Exception.pm:102
#, fuzzy
msgid "message() of exception expects Log::Report::Message"
msgstr ""
#: lib/Log/Report/Extract/Template.pm:93
#, fuzzy
msgid "need pattern to scan for, either via new() or process()"
msgstr ""
#: lib/Log/Report/Extract/PerlPPI.pm:188
#, fuzzy
msgid "new-line is added automatically (found in line {line})"
msgstr ""
#: lib/Log/Report/Extract/PerlPPI.pm:73
#, fuzzy
msgid "no Perl in file {filename}"
msgstr ""
#: lib/Log/Report/Lexicon/POT.pm:194
#, fuzzy
msgid "no filename or file-handle specified for PO"
msgstr ""
#: lib/Log/Report/Lexicon/POT.pm:317
#, fuzzy
msgid "no header defined in POT for file {fn}"
msgstr ""
#: lib/Log/Report/Lexicon/PO.pm:397
#, fuzzy
msgid "no msgid in block {where}"
msgstr ""
#: lib/Log/Report/Lexicon/PO.pm:476
#, fuzzy
msgid "no plurals for '{msgid}'"
msgstr ""
#: lib/Log/Report/Extract/PerlPPI.pm:121
#, fuzzy
msgid "no text-domain for translatable at {fn} line {line}"
msgstr ""
#: lib/Log/Report.pm:506
#, fuzzy
msgid "odd length parameter list for try(): forgot the terminating ';'?"
msgstr ""
#: lib/Log/Report.pm:264
#, fuzzy
msgid "odd length parameter list with '{msg}'"
msgstr ""
#: lib/Log/Report.pm:421
#, fuzzy
msgid "only one dispatcher name accepted in SCALAR context"
msgstr ""
#: lib/Log/Report.pm:954
#, fuzzy
msgid "only one package can contain configuration; for {domain} already in {pkg} in file {fn} line {line}"
msgstr ""
#: lib/Log/Report/Extract/PerlPPI.pm:77 lib/Log/Report/Extract/Template.pm:90
#, fuzzy
msgid "processing file {fn} in {charset}"
msgstr ""
#: bin/xgettext-perl:51
#, fuzzy
msgid "programming language {lang} not supported"
msgstr ""
#: lib/Log/Report/Lexicon/PO.pm:386
#, fuzzy
msgid "quoted line is not a continuation at {where}"
msgstr ""
#: lib/Log/Report/Translator/POT.pm:90
#, fuzzy
msgid "read table {filename} as {class} for {domain} in {locale}"
msgstr ""
#: lib/Log/Report/Util.pm:136
#, fuzzy
msgid "reason '{begin}' more serious than '{end}' in '{reasons}"
msgstr ""
#: bin/xgettext-perl:83
#, fuzzy
msgid "specify a text-domain (-d) for the templates"
msgstr ""
#: lib/Log/Report/Extract.pm:208
#, fuzzy
msgid "starting new textdomain {domain}, template in {filename}"
msgstr ""
#: lib/Log/Report/Lexicon/POTcompact.pm:154
#, fuzzy
msgid "string '{text}' not between quotes at {location}"
msgstr ""
#: lib/Log/Report/Extract/PerlPPI.pm:178
#, fuzzy
msgid "string is incorrect at line {line}: {error}"
msgstr ""
#: lib/Log/Report/Dispatcher.pm:211
#, fuzzy
msgid "switching to run mode {mode}, accept {accept}"
msgstr ""
#: lib/Log/Report.pm:882
#, fuzzy
msgid "syntax flag must be either SHORT or REPORT, not `{syntax}'"
msgstr ""
#: lib/Log/Report/Dispatcher/Syslog.pm:122
#, fuzzy
msgid "syslog level '{level}' not understood"
msgstr ""
#: lib/Log/Report/Extract/Template.pm:145
#, fuzzy
msgid "template syntax error, no END in {fn} line {line}"
msgstr ""
#: lib/Log/Report.pm:922
#, fuzzy
msgid "textdomain for translator not defined"
msgstr ""
#: lib/Log/Report/Lexicon/POT.pm:111
#, fuzzy
msgid "textdomain parameter is required"
msgstr ""
#: lib/Log/Report.pm:406
#, fuzzy
msgid "the 'filter' sub-command needs a CODE reference"
msgstr ""
#: lib/Log/Report.pm:393
#, fuzzy
msgid "the 'list' sub-command doesn't expect additional parameters"
msgstr ""
#: lib/Log/Report.pm:399
#, fuzzy
msgid "the 'needs' sub-command parameter '{reason}' is not a reason"
msgstr ""
#: lib/Log/Report/Lexicon/POT.pm:296
#, fuzzy
msgid "the only acceptable parameter is 'ACTIVE', not '{p}'"
msgstr ""
#: lib/Log/Report/Lexicon/Table.pm:93
#, fuzzy
msgid "there is no Plural-Forms field in the header"
msgstr ""
#: lib/Log/Report.pm:233
#, fuzzy
msgid "token '{token}' not recognized as reason"
msgstr ""
#: lib/Log/Report/Lexicon/PO.pm:465
#, fuzzy
msgid "too many plurals for '{msgid}'"
msgstr ""
#: lib/Log/Report/Lexicon/POT.pm:279
#, fuzzy
msgid "translation already exists for '{msgid}'"
msgstr ""
#: lib/Log/Report.pm:929
#, fuzzy
msgid "translator must be a Log::Report::Translator object"
msgstr ""
#: lib/Log/Report/Dispatcher/Try.pm:220
#, fuzzy
msgid "try-block stopped with {reason}: {text}"
msgstr ""
#: lib/Log/Report/Lexicon/PO.pm:348
#, fuzzy
msgid "unknown comment type '{cmd}' at {where}"
msgstr ""
#: lib/Log/Report/Lexicon/PO.pm:316
#, fuzzy
msgid "unknown flag {flag} ignored"
msgstr ""
#: lib/Log/Report/Util.pm:84
#, fuzzy
msgid "unknown locale language in locale `{locale}'"
msgstr ""
#: lib/Log/Report/Extract/Template.pm:114
#, fuzzy
msgid "unknown pattern {pattern}"
msgstr ""
#: lib/Log/Report/Util.pm:133 lib/Log/Report/Util.pm:148
#, fuzzy
msgid "unknown reason {which} in '{reasons}'"
msgstr ""
#: lib/Log/Report/Translator/POT.pm:87
#, fuzzy
msgid "unknown translation table extension '{ext}' in {filename}"
msgstr ""
#: lib/Log/Report/Lexicon/POT.pm:107
#, fuzzy
msgid "unnamed file"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:82
#, fuzzy
msgid "unsupported file type (magic number is {magic%x})"
msgstr ""
#: lib/Log/Report.pm:959
#, fuzzy
msgid "value for {name} specified twice"
msgstr ""
#: lib/Log/Report/Lexicon/POT.pm:219
#, fuzzy
msgid "write errors for file {fn}"
msgstr ""
#: lib/Log/Report/Extract.pm:146
#, fuzzy
msgid "{domain}: one file with {ids} msgids"
msgid_plural "{domain}: {_count} files with each {ids} msgids"
msgstr[0] ""
msgstr[1] ""
#: lib/Log/Report/Extract.pm:139
#, fuzzy
msgid "{domain}: one file with {ids} msgids, {f} fuzzy and {i} inactive translations"
msgid_plural "{domain}: {_count} files each {ids} msgids, {f} fuzzy and {i} inactive translations in total"
msgstr[0] ""
msgstr[1] ""
#: lib/Log/Report/Extract.pm:129
#, fuzzy
msgid "{domain}: {fuzzy%3d} fuzzy, {inact%3d} inactive in {filename}"
msgstr ""
#: lib/Log/Report/Dispatcher.pm:285
#, fuzzy
msgid "{message}; {error}"
msgstr ""
#: lib/Log/Report/Dispatcher.pm:284
#, fuzzy
msgid "{reason}: {message}"
msgstr ""
#: lib/Log/Report/Dispatcher.pm:283
#, fuzzy
msgid "{reason}: {message}; {error}"
msgstr ""

View File

@@ -0,0 +1,489 @@
#. 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: 2013-08-22 16:17+0200\n"
"Last-Translator: Mark Overmeer <mark@overmeer.net>\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/Util.pm:14
msgid "ALERT"
msgstr "ALARM"
#: lib/Log/Report/Util.pm:14
msgid "ASSERT"
msgstr "CONDITIE"
#: lib/Log/Report/Util.pm:14
msgid "ERROR"
msgstr "ERROR"
#: lib/Log/Report/Util.pm:14
msgid "FAILURE"
msgstr "STORING"
#: lib/Log/Report/Util.pm:14
msgid "FAULT"
msgstr "PROBLEEM"
#: lib/Log/Report/Util.pm:14
msgid "INFO"
msgstr "INFO"
#: lib/Log/Report/Dispatcher/LogDispatch.pm:105
msgid "Log::Dispatch level '{level}' not understood"
msgstr "Log::Dispatch level '{level}' niet herkend"
#: lib/Log/Report/Dispatcher/Log4perl.pm:100
msgid "Log::Log4perl back-end {name} requires a 'config' parameter"
msgstr "Log::Log4perl back-end {name} verwacht een 'config' argument"
#: lib/Log/Report/Dispatcher/Log4perl.pm:111
msgid "Log::Log4perl level '{level}' must be in 0-5"
msgstr "Log::Log4perl level '{level}' is getal van 0 tot 5"
#: lib/Log/Report/Util.pm:14
msgid "MISTAKE"
msgstr "FOUT"
#: lib/Log/Report/Util.pm:14
msgid "NOTICE"
msgstr "OPGELET"
#: lib/Log/Report/Dispatcher/Log4perl.pm:27
#: lib/Log/Report/Dispatcher/LogDispatch.pm:27
#: lib/Log/Report/Dispatcher/Syslog.pm:28
msgid "Not all reasons have a default translation"
msgstr "Niet alle redenen hebben een default vertaling"
#: lib/Log/Report/Util.pm:14
msgid "PANIC"
msgstr "PANIEK"
#: lib/Log/Report/Extract/PerlPPI.pm:66
msgid "PPI only supports iso-8859-1 (latin-1) on the moment"
msgstr "PPI ondersteunt momenteel alleen iso-8859-1 (latin-1)"
#: lib/Log/Report/Dispatcher.pm:152
msgid "Perl does not support charset {cs}"
msgstr "Perl heeft geen support voor tekenset {cs}"
#: lib/Log/Report/Util.pm:14
msgid "TRACE"
msgstr "TRACE"
#: lib/Log/Report/Util.pm:14
msgid "WARNING"
msgstr "WAARSCHUWING"
#: lib/Log/Report.pm:256
msgid "a message object is reported with more parameters"
msgstr "een message object vergezeld van meer parameters"
#: lib/Log/Report/Dispatcher.pm:299 lib/Log/Report/Dispatcher.pm:309
msgid "at {filename} line {line}"
msgstr "in {filename} regel {line}"
#: lib/Log/Report/Extract.pm:50
msgid "cannot create lexicon directory {dir}"
msgstr "kan lexicon map {dir} niet aanmaken"
#: bin/xgettext-perl:57
msgid "cannot create output directory {dir}"
msgstr "uitvoer map {dir} kan niet worden aangemaakt"
#: lib/Log/Report/Dispatcher/Log4perl.pm:121
msgid "cannot find logger '{name}' in configuration {config}"
msgstr "kan logger '{name}' in configuratie {config} niet vinden"
#: bin/xgettext-perl:65
msgid "cannot read filename list from {fn}"
msgstr "lijst met filenamen {fn} kan niet worden gelezen"
#: lib/Log/Report/Extract/PerlPPI.pm:69
msgid "cannot read from file {filename}"
msgstr "kan bestand {filename} niet lezen"
#: lib/Log/Report/Lexicon/MOTcompact.pm:70 lib/Log/Report/Lexicon/POT.pm:149
#: lib/Log/Report/Lexicon/POTcompact.pm:60
msgid "cannot read in {cs} from file {fn}"
msgstr "kan bestand {fn} niet lezen in {cs}"
#: lib/Log/Report/Lexicon/MOTcompact.pm:77
#, fuzzy
msgid "cannot read magic from {fn}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:129
#, fuzzy
msgid "cannot read msgids from {fn}, need {size} at {loc}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:101
#, fuzzy
msgid "cannot read originals from {fn}, need {size} at {loc}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:87
#, fuzzy
msgid "cannot read superblock from {fn}"
msgstr ""
#: lib/Log/Report/Extract/Template.pm:98
msgid "cannot read template from {fn}"
msgstr "template {fn} kan niet worden gelezen"
#: lib/Log/Report/Lexicon/MOTcompact.pm:208
#, fuzzy
msgid "cannot read transl late from {fn}, need {size} at {loc}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:112
#: lib/Log/Report/Lexicon/MOTcompact.pm:140
#, fuzzy
msgid "cannot read translations from {fn}, need {size} at {loc}"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:123
#, fuzzy
msgid "cannot seek to {loc} in {fn} for msgid strings"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:97
#, fuzzy
msgid "cannot seek to {loc} in {fn} for originals"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:134
#, fuzzy
msgid "cannot seek to {loc} in {fn} for transl strings"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:108
#, fuzzy
msgid "cannot seek to {loc} in {fn} for translations"
msgstr ""
#: lib/Log/Report/Lexicon/MOTcompact.pm:203
#, fuzzy
msgid "cannot seek to {loc} late in {fn} for transl strings"
msgstr ""
#: lib/Log/Report/Dispatcher/File.pm:96
msgid "cannot write log into {file} with {binmode}"
msgstr "kan log niet naar bestand {file} schrijven in {binmode}"
#: lib/Log/Report/Lexicon/POT.pm:203
msgid "cannot write to file {fn} in {layers}"
msgstr "kan bestand {fn} niet schrijven in {layers}"
#: lib/Log/Report/Lexicon/POT.pm:106 lib/Log/Report/Lexicon/POT.pm:146
msgid "charset parameter is required for {fn}"
msgstr "charset argument is verplicht voor {fn}"
#: lib/Log/Report/Lexicon/MOTcompact.pm:57
#: lib/Log/Report/Lexicon/POTcompact.pm:57
msgid "charset parameter required for {fn}"
msgstr ""
#: lib/Log/Report/Dispatcher/Callback.pm:62
msgid "dispatcher {name} needs a 'callback'"
msgstr "dispatcher {name} verlangt een 'callback'"
#: lib/Log/Report/Dispatcher/File.pm:85
msgid "dispatcher {name} needs parameter 'to'"
msgstr "dispatcher {name} verlangt argument 'to'"
#: bin/xgettext-perl:62
msgid "do not combine command-line filenames with --files-from"
msgstr "combineer filenamen op de commando-regel niet met --files-from"
#: lib/Log/Report/Extract/PerlPPI.pm:170
msgid "do not interpolate in msgid (found '{var}' in line {line})"
msgstr "gebruik geen variabelen in een msgid (vond '{var}' op regel {line'})"
#: lib/Log/Report/Lexicon/PO.pm:374
msgid "do not understand command '{cmd}' at {where}"
msgstr "commando '{cmd}' op plaats {where} niet begrepen"
#: lib/Log/Report/Lexicon/PO.pm:391
msgid ""
"do not understand line at {where}:\n"
" {line}"
msgstr ""
"de regel op {where} wordt niet begrepen:\n"
" {line}"
#: lib/Log/Report.pm:656
msgid "even length parameter list for __x at {where}"
msgstr "een even-lengte lijst van parameters bij __x bij {where}"
#: bin/xgettext-perl:54
msgid "explicit output directory (-p) required"
msgstr "expliciete uitvoer map (met -p) verplicht"
#: lib/Log/Report/Extract.pm:47
msgid "extractions require an explicit lexicon directory"
msgstr "een expliciete lexicon directory is nodig voor de uittreksels"
#: lib/Log/Report/Lexicon/MOTcompact.pm:162 lib/Log/Report/Lexicon/POT.pm:169
#: lib/Log/Report/Lexicon/POTcompact.pm:100
msgid "failed reading from file {fn}"
msgstr "lezen uit bestand {fn} mislukt"
#: lib/Log/Report/Extract.pm:199
msgid "found one pot file for domain {domain}"
msgid_plural "found {_count} pot files for domain {domain}"
msgstr[0] "één pot bestand voor domein {domain} gevonden"
msgstr[1] "{_count} pot bestanden voor domain {domain} gevonden"
#: lib/Log/Report/Dispatcher.pm:146
msgid "illegal format_reason '{format}' for dispatcher"
msgstr "onbekende format_reason '{format}' voor dispatcher"
#: lib/Log/Report/Lexicon/Table.pm:98
msgid "invalid plural-form algorithm '{alg}'"
msgstr "incorrect meervoudsvorm algoritme '{alg}'"
#: lib/Log/Report/Exception.pm:102
msgid "message() of exception expects Log::Report::Message"
msgstr "message() van een exception verwacht een Log::Report::Message"
#: lib/Log/Report/Extract/Template.pm:93
msgid "need pattern to scan for, either via new() or process()"
msgstr "een scan pattern is nodig, via new() of process()"
#: lib/Log/Report/Extract/PerlPPI.pm:188
msgid "new-line is added automatically (found in line {line})"
msgstr "een regel-overgang wordt automatisch toegevoegd (gevonden op regel {line})"
#: lib/Log/Report/Extract/PerlPPI.pm:73
#, fuzzy
msgid "no Perl in file {filename}"
msgstr ""
#: lib/Log/Report/Lexicon/POT.pm:194
msgid "no filename or file-handle specified for PO"
msgstr "geen bestandsnaam of -handle meegegeven voor PO"
#: lib/Log/Report/Lexicon/POT.pm:317
msgid "no header defined in POT for file {fn}"
msgstr "geen kop opgegeven in POT in bestand {fn}"
#: lib/Log/Report/Lexicon/PO.pm:397
msgid "no msgid in block {where}"
msgstr "geen msgid in blok {where}"
#: lib/Log/Report/Lexicon/PO.pm:476
msgid "no plurals for '{msgid}'"
msgstr "geen meervoudsvormen voor '{msgid}'"
#: lib/Log/Report/Extract/PerlPPI.pm:121
msgid "no text-domain for translatable at {fn} line {line}"
msgstr "geen text-domain voor vertaalbare string in {fn} regel {line}"
#: lib/Log/Report.pm:506
msgid "odd length parameter list for try(): forgot the terminating ';'?"
msgstr "oneven lengte van parameterlijst voor try(): afsluitende ';' vergeten?"
#: lib/Log/Report.pm:264
msgid "odd length parameter list with '{msg}'"
msgstr "parameter-lijst van oneven lengte bij '{msg}'"
#: lib/Log/Report.pm:421
msgid "only one dispatcher name accepted in SCALAR context"
msgstr "dispatcher gebruik in SCALAR context accepteert slechts één naam"
#: lib/Log/Report.pm:954
msgid "only one package can contain configuration; for {domain} already in {pkg} in file {fn} line {line}"
msgstr "slechts één package mag configuratie informatie bevatten; voor {domain} is dit al gevonden in {pkg}, bestand {fn} regel {line}"
#: lib/Log/Report/Extract/PerlPPI.pm:77 lib/Log/Report/Extract/Template.pm:90
msgid "processing file {fn} in {charset}"
msgstr "verwerk bestand {fn} in {charset}"
#: bin/xgettext-perl:51
msgid "programming language {lang} not supported"
msgstr "programmeertaal {lang} wordt niet ondersteund"
#: lib/Log/Report/Lexicon/PO.pm:386
msgid "quoted line is not a continuation at {where}"
msgstr "regel met quotes is geen voortzetting in {where}"
#~ msgid "read pot-file {filename} for {domain} in {locale}"
#~ msgstr "lees pot bestand {filename} voor {domain} in {locale}"
#: lib/Log/Report/Translator/POT.pm:90
#, fuzzy
msgid "read table {filename} as {class} for {domain} in {locale}"
msgstr ""
#: lib/Log/Report/Util.pm:136
msgid "reason '{begin}' more serious than '{end}' in '{reasons}"
msgstr "reden '{begin}' is serieuzer dan '{end}' in '{reasons}'"
#~ msgid "scan pattern `{pattern}' not recognized"
#~ msgstr "scan patroon `{pattern}' wordt niet herkend"
#: bin/xgettext-perl:83
#, fuzzy
msgid "specify a text-domain (-d) for the templates"
msgstr ""
#: lib/Log/Report/Extract.pm:208
msgid "starting new textdomain {domain}, template in {filename}"
msgstr "begin van nieuw textdomain {domain}, sjabloon in {filename}"
#: lib/Log/Report/Lexicon/POTcompact.pm:154
msgid "string '{text}' not between quotes at {location}"
msgstr "tekst '{text}' niet tussen quotes in {location}"
#: lib/Log/Report/Extract/PerlPPI.pm:178
msgid "string is incorrect at line {line}: {error}"
msgstr "foutieve string in regel {regel}: {error}"
#: lib/Log/Report/Dispatcher.pm:211
msgid "switching to run mode {mode}, accept {accept}"
msgstr "verwerkingsmode {mode}, accepteert {accept}"
#: lib/Log/Report.pm:882
msgid "syntax flag must be either SHORT or REPORT, not `{syntax}'"
msgstr "syntax parameter moet zijn SHORT of REPORT, niet `{syntax}'"
#: lib/Log/Report/Dispatcher/Syslog.pm:122
msgid "syslog level '{level}' not understood"
msgstr "syslog level '{level}' niet herkend"
#: lib/Log/Report/Extract/Template.pm:145
#, fuzzy
msgid "template syntax error, no END in {fn} line {line}"
msgstr ""
#: lib/Log/Report.pm:922
msgid "textdomain for translator not defined"
msgstr "tekstdomein voor vertaler niet gedefinieerd"
#: lib/Log/Report/Lexicon/POT.pm:111
msgid "textdomain parameter is required"
msgstr "tekstdomain argument is verplicht"
#: lib/Log/Report.pm:406
msgid "the 'filter' sub-command needs a CODE reference"
msgstr "het 'filter' sub-commando verwacht een CODE referentie"
#: lib/Log/Report.pm:393
msgid "the 'list' sub-command doesn't expect additional parameters"
msgstr "het 'list' sub-commando verwacht geen aanvullende argumenten"
#: lib/Log/Report.pm:399
msgid "the 'needs' sub-command parameter '{reason}' is not a reason"
msgstr "het 'needs' sub-commando argument '{reason}' is geen reden"
#: lib/Log/Report/Lexicon/POT.pm:296
msgid "the only acceptable parameter is 'ACTIVE', not '{p}'"
msgstr "het enige geaccepteerde argument is 'ACTIVE', niet '{p}'"
#: lib/Log/Report/Lexicon/Table.pm:93
#, fuzzy
msgid "there is no Plural-Forms field in the header"
msgstr ""
#: lib/Log/Report.pm:233
msgid "token '{token}' not recognized as reason"
msgstr "token '{token}' niet herkend als reden"
#: lib/Log/Report/Lexicon/PO.pm:465
msgid "too many plurals for '{msgid}'"
msgstr "te veel meervouden voor '{msgid}'"
#: lib/Log/Report/Lexicon/POT.pm:279
msgid "translation already exists for '{msgid}'"
msgstr "er bestaat al een vertaling voor '{msgid}'"
#: lib/Log/Report.pm:929
msgid "translator must be a Log::Report::Translator object"
msgstr "vertaler moet een Log::Report::Translator object zijn"
#: lib/Log/Report/Dispatcher/Try.pm:220
msgid "try-block stopped with {reason}: {text}"
msgstr "try-blok gestopt met {reason}: {text}"
#: lib/Log/Report/Lexicon/PO.pm:348
msgid "unknown comment type '{cmd}' at {where}"
msgstr "onbekend commentaar type '{cmd}' in {where}"
#: lib/Log/Report/Lexicon/PO.pm:316
msgid "unknown flag {flag} ignored"
msgstr "onbekende vlag {flag} wordt genegeerd"
#: lib/Log/Report/Util.pm:84
msgid "unknown locale language in locale `{locale}'"
msgstr "onbekende locale taal in locale `{locale}'"
#: lib/Log/Report/Extract/Template.pm:114
#, fuzzy
msgid "unknown pattern {pattern}"
msgstr ""
#: lib/Log/Report/Util.pm:133 lib/Log/Report/Util.pm:148
msgid "unknown reason {which} in '{reasons}'"
msgstr "onbekende reden {which} is '{reasons}'"
#~ msgid "unknown run mode '{mode}'"
#~ msgstr "onbekende verwerkingsmode '{mode}'"
#: lib/Log/Report/Translator/POT.pm:87
#, fuzzy
msgid "unknown translation table extension '{ext}' in {filename}"
msgstr ""
#: lib/Log/Report/Lexicon/POT.pm:107
msgid "unnamed file"
msgstr "naamloze file"
#: lib/Log/Report/Lexicon/MOTcompact.pm:82
#, fuzzy
msgid "unsupported file type (magic number is {magic%x})"
msgstr ""
#: lib/Log/Report.pm:959
msgid "value for {name} specified twice"
msgstr "twee keer een waarde voor {name}"
#: lib/Log/Report/Lexicon/POT.pm:219
msgid "write errors for file {fn}"
msgstr "schrijfproblemen bij bestand {fn}"
#: lib/Log/Report/Extract.pm:146
msgid "{domain}: one file with {ids} msgids"
msgid_plural "{domain}: {_count} files with each {ids} msgids"
msgstr[0] "{domain}: één bestand met {ids} mgsids"
msgstr[1] "{domain}: {_count} bestanden met elk {ids} msgids"
#: lib/Log/Report/Extract.pm:139
msgid "{domain}: one file with {ids} msgids, {f} fuzzy and {i} inactive translations"
msgid_plural "{domain}: {_count} files each {ids} msgids, {f} fuzzy and {i} inactive translations in total"
msgstr[0] "{domain}: één bestand met {ids} mgsids, {f} fuzzy en {i} op non-actief"
msgstr[1] "{domain}: {_count} bestanden met elk {ids} msgids, {f} fuzzy en {i} op non-actief in het totaal"
#: lib/Log/Report/Extract.pm:129
msgid "{domain}: {fuzzy%3d} fuzzy, {inact%3d} inactive in {filename}"
msgstr "{domain}: {fuzzy%3d} fuzzy, {inact%3d} op non-actief in {filename}"
#: lib/Log/Report/Dispatcher.pm:285
msgid "{message}; {error}"
msgstr "{message}; {error}"
#: lib/Log/Report/Dispatcher.pm:284
msgid "{reason}: {message}"
msgstr "{reason}: {message}"
#: lib/Log/Report/Dispatcher.pm:283
msgid "{reason}: {message}; {error}"
msgstr "{reason}: {message}; {error}"