@@ -1,13 +1,114 @@
==== version history of Log::Report
+Unless noted otherwise, these changes where initiated and applied by
+Mark Overmeer.
+
TODO:
. connect to Message::Passing framework
- . extract a Log::Report::Optional distribution
+
+version 1.02: Mon Mar 10 16:03:13 CET 2014
+
+ Fixes:
+ - add overload fallback to ::Exception and ::Dispatcher
+ rt.cpan.org#92970 [Lukas Mai]
+ - ::Domain::new(translator) with HASH did not initialize
+ - warn better with ::Optional modules are used before Log::Report
+ is used.
+
+ Improvements:
+ - changed documentation style
+ - ::Lexicon::Index dir-scan immediately, hopefully before fork()
+
+version 1.01: Mon Jan 6 23:21:37 CET 2014
+
+ Fixes:
+ - LC_MESSAGE missing on Windows [Michael Long]
+
+version 1.00: Sun Jan 5 17:23:44 CET 2014
+
+ Split into four components, adding
+ - String::Print for formatting, permits positionals now
+ - Log::Report::Optional as base, super lightweight
+ - Log::Report::Lexicon when you need translations
+
+ Changes:
+ - configuration from ::translator() into ::Domain::configure()
+ - domains are package bound, not line based.
+ - removed isValidReason() and isFatal(), there are function in ::Util
+ - dispatchers(list) inside try() also lists outside dispatchers
+ - ::Dispatcher::Log4perl::new(accept) defaults to 'ALL', because the
+ log4perl configuration will select what to log.
+ - exceptions which get re-thrown with an other reason get rewritten.
+ - alert and failure messages will always show their location
+ - "switching to mode" message from level info to trace
+
+ Fixes:
+ - do not complain when N__w ends on \n
+ - incorrect initialization of log4perl dispatcher
+ - try inside BEGIN did not catch but died.
+ rt.cpan.org#91671 [Kenney Westerhof]
+
+ Improvements:
+ - ::Dispatcher::File uses locking to permit parallel writes
+ - ::Dispatcher::File::new(format)
+ - ::Dispatcher::File::rotate()
+ - ::Dispatcher::Log4perl more docs
+ - explain why Log::Log4perl::caller_depth concept is broken
+ - ::Dispatcher::Log4perl support for categories
+ - ::Dispatcher::Syslog::new(include_domain)
+ - ::Dispatcher::Syslog::new(charset)
+ - ::Dispatcher::*::log() knows about textdomain of msg
+ - ::Message::new(_lang) overrides language to be used in translation
+ - add MojoX::Log::Report
+ - new ::Domain, move all domain specific config from ::import() into
+ that module (and/or ::Minimal::Domain)
+ - ::textdomain()
+ - ::Message overload fallback
+ - remove "syntax => 'SHORT'" from examples: is the default
+ - export level on Log::Report::import()
+
+version 0.999:
+ Not (yet) released
+
+version 0.998: Tue Oct 22 09:55:06 CEST 2013
+ Fixes:
+ - xgettext-perl: actually use the provided template pattern
+ - xgettext-perl: only take template from .tt and .tt2 files
+ - xgettext-perl: accept '-' (STDIN) for --from
+
+ Improvements:
+ - more documentation about the PPI extraction process, and how
+ to use ::Message::new(_domain)
+ - Log::Report import option 'import'
+
+version 0.997: Fri Sep 27 17:37:11 CEST 2013
+ Fixes:
+ - error about double definedness of settings, dependent on the
+ order of inclusion of modules.
+ - setlocale does not return the old locale, but the new.
+
+ Improvements:
+ - xgettext-perl: do not PPI files unless they are Perl
+ - xgettext-perl: do warn when ' (single quotes) are used, needs
+ " (double quote) with __x
+ - __x() now can have a _domain parameter
+
+version 0.996: Wed Sep 4 17:23:11 CEST 2013
+ Fixes:
+ - you could not share one ::Translator::POT over two domains.
+ discovered by [Richard Still]
+ - third attempt to fix errors in t/53log4perl.t on Windows
+ [cpantesters]
+ - remove double reporting of errors which exceptions are caught
+ with eval(). But better use try().
+
+version 0.995: Thu Aug 29 09:19:13 CEST 2013
+ Fixes:
+ - twice path '\' in t/53log4perl.t in Windows [cpantesters]
version 0.994: Thu Aug 22 16:12:08 CEST 2013
Fixes:
- - path '\' in two tests in t/53log4perl.t [cpantesters]
- link to paper [Richard Still]
- chicken-egg problem with error on illegal mode setting.
@@ -2,7 +2,6 @@ ChangeLog
MANIFEST
Makefile.PL
README
-bin/xgettext-perl
lib/Log/Report.pm
lib/Log/Report.pod
lib/Log/Report/Die.pm
@@ -23,60 +22,31 @@ lib/Log/Report/Dispatcher/Syslog.pm
lib/Log/Report/Dispatcher/Syslog.pod
lib/Log/Report/Dispatcher/Try.pm
lib/Log/Report/Dispatcher/Try.pod
+lib/Log/Report/Domain.pm
+lib/Log/Report/Domain.pod
lib/Log/Report/Exception.pm
lib/Log/Report/Exception.pod
-lib/Log/Report/Extract.pm
-lib/Log/Report/Extract.pod
-lib/Log/Report/Extract/PerlPPI.pm
-lib/Log/Report/Extract/PerlPPI.pod
-lib/Log/Report/Extract/Template.pm
-lib/Log/Report/Extract/Template.pod
-lib/Log/Report/Lexicon/Index.pm
-lib/Log/Report/Lexicon/Index.pod
-lib/Log/Report/Lexicon/MOTcompact.pm
-lib/Log/Report/Lexicon/MOTcompact.pod
-lib/Log/Report/Lexicon/PO.pm
-lib/Log/Report/Lexicon/PO.pod
-lib/Log/Report/Lexicon/POT.pm
-lib/Log/Report/Lexicon/POT.pod
-lib/Log/Report/Lexicon/POTcompact.pm
-lib/Log/Report/Lexicon/POTcompact.pod
-lib/Log/Report/Lexicon/Table.pm
-lib/Log/Report/Lexicon/Table.pod
lib/Log/Report/Message.pm
lib/Log/Report/Message.pod
lib/Log/Report/Translator.pm
lib/Log/Report/Translator.pod
-lib/Log/Report/Translator/Gettext.pm
-lib/Log/Report/Translator/Gettext.pod
-lib/Log/Report/Translator/POT.pm
-lib/Log/Report/Translator/POT.pod
-lib/Log/Report/Util.pm
-lib/Log/Report/Util.pod
-lib/Log/Report/Win32Locale.pm
-lib/Log/Report/Win32Locale.pod
lib/Log/Report/messages/log-report.utf-8.po
lib/Log/Report/messages/log-report/nl_NL.po
+lib/MojoX/Log/Report.pm
+lib/MojoX/Log/Report.pod
t/00use.t
-t/04locale.t
-t/05util.t
+t/09message.t
t/10interp.t
t/11concat.t
-t/20pot_read.t
-t/21pot_modif.t
-t/22compact.t
t/31stack.t
-t/40ppi.t
t/41die.t
-t/42templ.t
t/50file.t
t/51syslog.t
t/52logdisp.t
t/53log4perl.t
t/54try.t
+t/60mojo.t
t/DieTests.pm
-t/hello-world-slovak.po
-xt/30index.t
xt/99pod.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
@@ -34,12 +34,14 @@
"requires" : {
"Devel::GlobalDestruction" : "0.09",
"Encode" : "2.00",
+ "Log::Report::Optional" : "1.01",
"Scalar::Util" : "0",
+ "String::Print" : "0.13",
"Sys::Syslog" : "0.27",
"Test::More" : "0.86"
}
}
},
"release_status" : "stable",
- "version" : "0.994"
+ "version" : "1.02"
}
@@ -20,7 +20,9 @@ no_index:
requires:
Devel::GlobalDestruction: 0.09
Encode: 2.00
+ Log::Report::Optional: 1.01
Scalar::Util: 0
+ String::Print: 0.13
Sys::Syslog: 0.27
Test::More: 0.86
-version: 0.994
+version: 1.02
@@ -2,24 +2,40 @@ use ExtUtils::MakeMaker;
use 5.008;
-my $version = '0.994';
+my $version = '1.02';
my %prereq =
- ( Test::More => 0.86
- , Sys::Syslog => '0.27'
- , Encode => '2.00'
- , Scalar::Util => 0
- , Devel::GlobalDestruction => 0.09
+ ( Test::More => '0.86'
+ , Sys::Syslog => '0.27'
+ , Encode => '2.00'
+ , Scalar::Util => 0
+ , Devel::GlobalDestruction => '0.09'
+ , Log::Report::Optional => '1.01'
+ , String::Print => '0.13'
);
-$prereq{ 'Win32::TieRegistry' } = 0.24
- if $^O eq 'MSWin32';
+# Upgrade L::R::Lexicon if installed
+eval "require Log::Report::Extract";
+#warn $@;
+unless($@)
+{ my $v = $Log::Report::Extract::VERSION || '1.00';
+ if($v < 1.00) { warn <<'__CHANGES_100'; sleep 10 }
+***************************************************************
+WARNING: with Log::Report 1.00, the distribution got spit into
+ four separate components. If you use *translations*, then
+ you have to upgrade Log::Report::Lexicon as well. You may
+ need to add dependencies to that module as well.
+***************************************************************
+__CHANGES_100
+}
+
+#use Data::Dumper;
+#warn Dumper \%prereq;
WriteMakefile
( NAME => 'Log::Report'
, VERSION => $version
, PREREQ_PM => \%prereq
- , EXE_FILES => [ 'bin/xgettext-perl' ]
, AUTHOR => 'Mark Overmeer'
, ABSTRACT => 'report a problem, pluggable handlers and language support'
@@ -38,7 +54,7 @@ SKIP_LINKS = XML::LibXML
FIRST_YEAR = 2007
EMAIL = perl@overmeer.net
WEBSITE = http://perl.overmeer.net/log-report/
-EXTENDS =
+EXTENDS = ../LogOpt:../Print:../LogLex
# for OODoc's oodist, HTML
HTML_OUTPUT = ../public_html/log-report/html
@@ -1,110 +0,0 @@
-#!/usr/bin/env perl
-# implements xgettext for Log::Report only, using Log::Report::Extract::PPI
-# Options like GNU's xgettext
-
-use warnings;
-use strict;
-
-use Log::Report 'log-report', syntax => 'SHORT';
-use Getopt::Long qw/:config no_ignore_case bundling/;
-use File::Find qw/find/;
-
-my $lang = 'perl';
-my $version = 0;
-my $help = 0;
-my ($from, $output);
-my ($char_in, $char_out, $domain, $mode, $template);
-
-GetOptions
- 'files-from|f=s' => \$from
- , 'output-dir|p=s' => \$output
- , 'domain|d=s' => \$domain
- , 'language|L=s' => \$lang
- , 'from-code=s' => \$char_in
- , 'to-code=s' => \$char_out # missing in xgettext?
- , 'version|V' => \$version
- , 'help|h' => \$help
- , 'template|t=s' => \$template # pattern in ::Template
- , 'verbose=i' => \$mode
- , 'v+' => \$mode
- , 'mode=s' => \$mode
-or exit(1);
-
-if($version)
-{ print "Log::Report $Log::Report::VERSION\n";
- exit 0;
-}
-
-if($help)
-{ print <<__HELP;
-Log::Report's version of xgettext, has a subset of options
-of GNU's version, and no own manual-page yet.
-__HELP
- exit 0;
-}
-
-# all output to stderr
-dispatcher FILE => stderr => to => \*STDERR, mode => $mode;
-dispatcher close => 'default';
-
-$template || $lang eq 'perl'
- or mistake __x"programming language {lang} not supported", lang => $lang;
-
-defined $output
- or mistake __"explicit output directory (-p) required";
-
--d $output or mkdir $output
- or fault __x"cannot create output directory {dir}", dir => $output;
-
-my @filenames;
-if(defined $from)
-{ !@ARGV
- or error __x"do not combine command-line filenames with --files-from";
-
- open FILENAMES, '<:raw', $from
- or fault __x"cannot read filename list from {fn}", fn => $from;
-
- @filenames = <FILENAMES>;
- close FILENAMES;
- chomp(@filenames);
-}
-elsif(@ARGV)
-{ find sub{push @filenames, $File::Find::name if -f}, @ARGV;
-}
-
-my $extr;
-
-if($template)
-{ # process from template
- eval "require Log::Report::Extract::Template";
- panic $@ if $@;
-
- $domain
- or error __x"specify a text-domain (-d) for the templates";
-
- $extr = Log::Report::Extract::Template->new
- ( lexicon => $output
- , charset => $char_out
- , domain => $domain
- , pattern => 'TT2-loc'
- );
-
- $extr->process($_, charset => $char_in)
- for @filenames;
-}
-else
-{ # process the pm files
- eval "require Log::Report::Extract::PerlPPI";
- panic $@ if $@;
-
- $extr = Log::Report::Extract::PerlPPI->new
- ( lexicon => $output
- , charset => $char_out
- );
-
- $extr->process($_, charset => $char_in)
- for @filenames;
-}
-
-$extr->showStats;
-$extr->write;
@@ -1,4 +1,4 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
@@ -6,14 +6,12 @@ use warnings;
use strict;
package Log::Report::Die;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
use base 'Exporter';
our @EXPORT = qw/die_decode/;
-use Log::Report 'log-report';
use POSIX qw/locale_h/;
@@ -52,12 +52,12 @@ following table is used:
=head1 SEE ALSO
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
=head1 LICENSE
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -1,4 +1,4 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
@@ -6,8 +6,7 @@ use warnings;
use strict;
package Log::Report::Dispatcher::Callback;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
use base 'Log::Report::Dispatcher';
@@ -28,7 +27,7 @@ sub init($)
sub callback() {shift->{callback}}
-sub log($$$)
+sub log($$$$)
{ my $self = shift;
$self->{callback}->($self, @_);
}
@@ -29,23 +29,23 @@ 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.
-See L<documentation in the base class|Log::Report::Dispatcher/"DESCRIPTION">.
+Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">.
=head1 METHODS
-See L<documentation in the base class|Log::Report::Dispatcher/"METHODS">.
+Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">.
=head2 Constructors
-See L<documentation in the base class|Log::Report::Dispatcher/"Constructors">.
+Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">.
=over 4
=item $obj-E<gt>B<close>()
-See L<Log::Report::Dispatcher/"Constructors">
+Inherited, see L<Log::Report::Dispatcher/"Constructors">
-=item Log::Report::Dispatcher::Callback-E<gt>B<new>(TYPE, NAME, OPTIONS)
+=item Log::Report::Dispatcher::Callback-E<gt>B<new>($type, $name, %options)
-Option --Defined in --Default
accept Log::Report::Dispatcher depend on mode
@@ -61,11 +61,11 @@ See L<Log::Report::Dispatcher/"Constructors">
=item callback => CODE
-Your C<callback> is called with four parameters: this dispatcher object,
+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>. Finally, the C<message> is a
-L<Log::Report::Message|Log::Report::Message>.
+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
@@ -81,7 +81,7 @@ L<Log::Report::Message|Log::Report::Message>.
=head2 Accessors
-See L<documentation in the base class|Log::Report::Dispatcher/"Accessors">.
+Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">.
=over 4
@@ -91,29 +91,29 @@ Returns the code reference which will handle each logged message.
=item $obj-E<gt>B<isDisabled>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<mode>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<name>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
-=item $obj-E<gt>B<needs>()
+=item $obj-E<gt>B<needs>( [$reason] )
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<type>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=back
=head2 Logging
-See L<documentation in the base class|Log::Report::Dispatcher/"Logging">.
+Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">.
=over 4
@@ -121,42 +121,42 @@ See L<documentation in the base class|Log::Report::Dispatcher/"Logging">.
=item Log::Report::Dispatcher::Callback-E<gt>B<collectLocation>()
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<collectStack>([MAXDEPTH])
+=item $obj-E<gt>B<collectStack>( [$maxdepth] )
-=item Log::Report::Dispatcher::Callback-E<gt>B<collectStack>([MAXDEPTH])
+=item Log::Report::Dispatcher::Callback-E<gt>B<collectStack>( [$maxdepth] )
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<log>(HASH-of-OPTIONS, REASON, MESSAGE)
+=item $obj-E<gt>B<log>(HASH-$of-%options, $reason, $message, $domain)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<stackTraceLine>(OPTIONS)
+=item $obj-E<gt>B<stackTraceLine>(%options)
-=item Log::Report::Dispatcher::Callback-E<gt>B<stackTraceLine>(OPTIONS)
+=item Log::Report::Dispatcher::Callback-E<gt>B<stackTraceLine>(%options)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<translate>(HASH-of-OPTIONS, REASON, MESSAGE)
+=item $obj-E<gt>B<translate>(HASH-$of-%options, $reason, $message)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
=back
=head1 DETAILS
-See L<documentation in the base class|Log::Report::Dispatcher/"DETAILS">.
+Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">.
=head1 SEE ALSO
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
=head1 LICENSE
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -1,4 +1,4 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
@@ -6,14 +6,16 @@ use warnings;
use strict;
package Log::Report::Dispatcher::File;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
use base 'Log::Report::Dispatcher';
-use Log::Report 'log-report', syntax => 'SHORT';
-use IO::File ();
-use Encode qw/find_encoding/;
+use Log::Report 'log-report';
+use IO::File ();
+use POSIX qw/strftime/;
+
+use Encode qw/find_encoding/;
+use Fcntl qw/:flock/;
sub init($)
@@ -40,31 +42,69 @@ sub init($)
my $binmode = $args->{replace} ? '>' : '>>';
my $f = $self->{output} = IO::File->new($to, $binmode)
- or fault __x"cannot write log into {file} with {binmode}"
- , binmode => $binmode, file => $to;
+ or fault __x"cannot write log into {file} with mode {binmode}"
+ , binmode => $binmode, file => $to;
$f->autoflush;
trace "opened dispatcher $name to $to with $binmode";
}
+ my $format = $args->{format} || sub { '['.localtime()."] $_[0]" };
+ $self->{format}
+ = ref $format eq 'CODE' ? $format
+ : $format eq 'LONG'
+ ? sub { my $msg = shift;
+ my $domain = shift || '-';
+ my $stamp = strftime "%FT%T", gmtime;
+ "[$stamp $$] $domain $msg"
+ }
+ : error __x"unknown format parameter `{what}'"
+ , what => ref $format || $format;
+
$self;
}
+sub filename() {shift->{filename}}
+sub format() {shift->{format}}
+sub output() {shift->{output}}
+
+
sub close()
{ my $self = shift;
$self->SUPER::close or return;
- $self->{output}->close if $self->{filename};
+ $self->output->close if $self->filename;
$self;
}
-sub filename() {shift->{filename}}
+sub rotate($)
+{ my ($self, $new) = @_;
+ my $log = $self->filename
+ or error __x"cannot rotate log file which was opened as file-handle";
-sub log($$$)
-{ my $self = shift;
- $self->{output}->print($self->SUPER::translate(@_));
+ trace "rotating $log to $new";
+
+ rename $log, $new
+ or fault __x"unable to rotate logfile {oldfn} to {newfn}"
+ , oldfn => $log, newfn => $new;
+
+ $self->output->close; # close after move not possible on Windows?
+ my $f = $self->{output} = 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 $text = $self->format->($self->translate($opts, $reason, $msg), $domain);
+ my $out = $self->output;
+ flock $out, LOCK_EX;
+ $out->print($text);
+ flock $out, LOCK_UN;
}
1;
@@ -43,28 +43,27 @@ Log::Report::Dispatcher::File - send messages to a file or file-handle
This basic file logger accepts an file-handle or filename as destination.
-See L<documentation in the base class|Log::Report::Dispatcher/"DESCRIPTION">.
+[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
-See L<documentation in the base class|Log::Report::Dispatcher/"METHODS">.
+Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">.
=head2 Constructors
-See L<documentation in the base class|Log::Report::Dispatcher/"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)
+=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'
@@ -77,6 +76,22 @@ other case, nothing will be done.
=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). The "LONG" format is equivalent to:
+
+ my $t = strftime "%FT%T", gmtime;
+ "[$t $$] $_[1] $_[0]"
+
=item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE
=item locale => LOCALE
@@ -108,7 +123,7 @@ of a FILENAME.
=head2 Accessors
-See L<documentation in the base class|Log::Report::Dispatcher/"Accessors">.
+Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">.
=over 4
@@ -117,31 +132,50 @@ See L<documentation in the base class|Log::Report::Dispatcher/"Accessors">.
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>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<mode>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<name>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
+
+=item $obj-E<gt>B<needs>( [$reason] )
-=item $obj-E<gt>B<needs>()
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
-See L<Log::Report::Dispatcher/"Accessors">
+=item $obj-E<gt>B<output>()
=item $obj-E<gt>B<type>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
+
+=back
+
+=head2 File maintenance
+
+=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 $obj-E<gt>B<rotate>($filename)
+
+[1.00] Move the current file to $filename, and start a new file.
=back
=head2 Logging
-See L<documentation in the base class|Log::Report::Dispatcher/"Logging">.
+Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">.
=over 4
@@ -149,42 +183,42 @@ See L<documentation in the base class|Log::Report::Dispatcher/"Logging">.
=item Log::Report::Dispatcher::File-E<gt>B<collectLocation>()
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<collectStack>([MAXDEPTH])
+=item $obj-E<gt>B<collectStack>( [$maxdepth] )
-=item Log::Report::Dispatcher::File-E<gt>B<collectStack>([MAXDEPTH])
+=item Log::Report::Dispatcher::File-E<gt>B<collectStack>( [$maxdepth] )
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<log>(HASH-of-OPTIONS, REASON, MESSAGE)
+=item $obj-E<gt>B<log>(HASH-$of-%options, $reason, $message, $domain)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<stackTraceLine>(OPTIONS)
+=item $obj-E<gt>B<stackTraceLine>(%options)
-=item Log::Report::Dispatcher::File-E<gt>B<stackTraceLine>(OPTIONS)
+=item Log::Report::Dispatcher::File-E<gt>B<stackTraceLine>(%options)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<translate>(HASH-of-OPTIONS, REASON, MESSAGE)
+=item $obj-E<gt>B<translate>(HASH-$of-%options, $reason, $message)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
=back
=head1 DETAILS
-See L<documentation in the base class|Log::Report::Dispatcher/"DETAILS">.
+Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">.
=head1 SEE ALSO
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
=head1 LICENSE
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -1,4 +1,4 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
@@ -6,15 +6,14 @@ use warnings;
use strict;
package Log::Report::Dispatcher::Log4perl;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
use base 'Log::Report::Dispatcher';
-use Log::Report 'log-report', syntax => 'SHORT';
-use Log::Report::Util qw/@reasons expand_reasons/;
+use Log::Report 'log-report';
-use Log::Log4perl qw/:levels/;
+use Log::Report::Util qw/@reasons expand_reasons/;
+use Log::Log4perl qw/:levels/;
my %default_reasonToLevel =
( TRACE => $DEBUG
@@ -30,20 +29,21 @@ my %default_reasonToLevel =
, PANIC => $FATAL
);
-@reasons != keys %default_reasonToLevel
- and panic __"Not all reasons have a default translation";
+@reasons==keys %default_reasonToLevel
+ or panic __"Not all reasons have a default translation";
sub init($)
{ my ($self, $args) = @_;
+ $args->{accept} ||= 'ALL';
$self->SUPER::init($args);
my $name = $self->name;
my $config = delete $args->{config}
- or error __x"Log::Log4perl back-end {name} requires a 'config' parameter"
+ or error __x"Log4perl back-end {name} requires a 'config' parameter"
, name => $name;
- $self->{level} = { %default_reasonToLevel };
+ $self->{LRDL_levels} = { %default_reasonToLevel };
if(my $to_level = delete $args->{to_level})
{ my @to = @$to_level;
while(@to)
@@ -51,46 +51,51 @@ sub init($)
my @reasons = expand_reasons $reasons;
$level =~ m/^[0-5]$/
- or error __x "Log::Log4perl level '{level}' must be in 0-5"
+ or error __x "Log4perl level '{level}' must be in 0-5"
, level => $level;
- $self->{level}{$_} = $level for @reasons;
+ $self->{LRDL_levels}{$_} = $level for @reasons;
}
}
- Log::Log4perl->init($config);
-
- $self->{appender} = Log::Log4perl->get_logger($name, %$args)
- or error __x"cannot find logger '{name}' in configuration {config}"
- , name => $name, config => $config;
+ Log::Log4perl->init($config)
+ or return;
$self;
}
-sub close()
-{ my $self = shift;
- $self->SUPER::close or return;
- delete $self->{backend};
- $self;
-}
+#sub close()
+#{ my $self = shift;
+# $self->SUPER::close or return;
+# $self;
+#}
-sub appender() {shift->{appender}}
+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 = shift;
- my $text = $self->SUPER::translate(@_) or return;
- my $level = $self->reasonToLevel($_[1]);
+{ 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;
+ local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 3;
- $self->appender->log($level, $text);
+ $text =~ s/\s+$//s; # log4perl adds own \n
+ $self->logger($domain)->log($level, $text);
$self;
}
-sub reasonToLevel($) { $_[0]->{level}{$_[1]} }
+sub reasonToLevel($) { $_[0]->{LRDL_levels}{$_[1]} }
1;
@@ -11,9 +11,11 @@ Log::Report::Dispatcher::Log4perl - send messages to Log::Log4perl back-end
=head1 SYNOPSIS
- dispatcher Log::Log4perl => 'logger', accept => 'NOTICE-'
- , config => "$ENV{HOME}/.log.conf"
- , to_level => [ 'ALERT-' => $ERROR ];
+ # 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';
@@ -23,61 +25,76 @@ Log::Report::Dispatcher::Log4perl - send messages to Log::Log4perl back-end
my $outfile = '/tmp/a.log';
my $config = <<__CONFIG;
log4perl.category.$name = INFO, Logfile
- log4perl.appender.Logfile = Log::Log4perl::Appender::File
- log4perl.appender.Logfile.filename = $outfn
- log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout
- log4perl.appender.Logfile.layout.ConversionPattern = %d %F{1} %L> %m
+ 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 'Log::Log4perl' => $name, config => \$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).
-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::Log4perl/"Constructors">. See example in SYNOPSIS.
-
- TRACE => $DEBUG ERROR => $ERROR
- ASSERT => $DEBUG FAULT => $ERROR
- INFO => $INFO ALERT => $FATAL
- NOTICE => $INFO FAILURE => $FATAL
- WARNING => $WARN PANIC => $FATAL
+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
-See L<documentation in the base class|Log::Report::Dispatcher/"DESCRIPTION">.
-
+=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
-See L<documentation in the base class|Log::Report::Dispatcher/"METHODS">.
+Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">.
=head2 Constructors
-See L<documentation in the base class|Log::Report::Dispatcher/"Constructors">.
+Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">.
=over 4
=item $obj-E<gt>B<close>()
-See L<Log::Report::Dispatcher/"Constructors">
+Inherited, see L<Log::Report::Dispatcher/"Constructors">
-=item Log::Report::Dispatcher::Log4perl-E<gt>B<new>(TYPE, NAME, OPTIONS)
+=item Log::Report::Dispatcher::Log4perl-E<gt>B<new>($type, $name, %options)
-The Log::Log4perl infrastructure has all information in a configuration
-file. In that file, you should find a category with the NAME.
+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 depend on mode
+ accept Log::Report::Dispatcher 'ALL'
charset Log::Report::Dispatcher <undef>
config <required>
format_reason Log::Report::Dispatcher 'LOWERCASE'
@@ -112,39 +129,42 @@ See L<reasonToLevel()|Log::Report::Dispatcher::Log4perl/"Logging">.
=head2 Accessors
-See L<documentation in the base class|Log::Report::Dispatcher/"Accessors">.
+Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">.
=over 4
-=item $obj-E<gt>B<appender>()
+=item $obj-E<gt>B<isDisabled>()
-Returns the Log::Log4perl::Logger object which is used for logging.
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
-=item $obj-E<gt>B<isDisabled>()
+=item $obj-E<gt>B<logger>( [$domain] )
-See L<Log::Report::Dispatcher/"Accessors">
+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>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<name>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
-=item $obj-E<gt>B<needs>()
+=item $obj-E<gt>B<needs>( [$reason] )
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<type>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=back
=head2 Logging
-See L<documentation in the base class|Log::Report::Dispatcher/"Logging">.
+Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">.
=over 4
@@ -152,47 +172,56 @@ See L<documentation in the base class|Log::Report::Dispatcher/"Logging">.
=item Log::Report::Dispatcher::Log4perl-E<gt>B<collectLocation>()
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<collectStack>([MAXDEPTH])
+=item $obj-E<gt>B<collectStack>( [$maxdepth] )
-=item Log::Report::Dispatcher::Log4perl-E<gt>B<collectStack>([MAXDEPTH])
+=item Log::Report::Dispatcher::Log4perl-E<gt>B<collectStack>( [$maxdepth] )
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<log>(HASH-of-OPTIONS, REASON, MESSAGE)
+=item $obj-E<gt>B<log>(HASH-$of-%options, $reason, $message, $domain)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<reasonToLevel>(REASON)
+=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">.
-=item $obj-E<gt>B<stackTraceLine>(OPTIONS)
+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<stackTraceLine>(%options)
-=item Log::Report::Dispatcher::Log4perl-E<gt>B<stackTraceLine>(OPTIONS)
+=item Log::Report::Dispatcher::Log4perl-E<gt>B<stackTraceLine>(%options)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<translate>(HASH-of-OPTIONS, REASON, MESSAGE)
+=item $obj-E<gt>B<translate>(HASH-$of-%options, $reason, $message)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
=back
=head1 DETAILS
-See L<documentation in the base class|Log::Report::Dispatcher/"DETAILS">.
+Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">.
=head1 SEE ALSO
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
=head1 LICENSE
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -1,4 +1,4 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
@@ -6,8 +6,7 @@ use warnings;
use strict;
package Log::Report::Dispatcher::LogDispatch;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
use base 'Log::Report::Dispatcher';
@@ -71,9 +70,9 @@ sub close()
sub backend() {shift->{backend}}
-sub log($$$$)
+sub log($$$$$)
{ my $self = shift;
- my $text = $self->SUPER::translate(@_) or return;
+ my $text = $self->translate(@_) or return;
my $level = $self->reasonToLevel($_[1]);
$self->backend->log(level => $level, message => $text);
@@ -35,23 +35,23 @@ 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.
-See L<documentation in the base class|Log::Report::Dispatcher/"DESCRIPTION">.
+Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">.
=head1 METHODS
-See L<documentation in the base class|Log::Report::Dispatcher/"METHODS">.
+Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">.
=head2 Constructors
-See L<documentation in the base class|Log::Report::Dispatcher/"Constructors">.
+Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">.
=over 4
=item $obj-E<gt>B<close>()
-See L<Log::Report::Dispatcher/"Constructors">
+Inherited, see L<Log::Report::Dispatcher/"Constructors">
-=item Log::Report::Dispatcher::LogDispatch-E<gt>B<new>(TYPE, NAME, OPTIONS)
+=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
@@ -109,7 +109,7 @@ See L<reasonToLevel()|Log::Report::Dispatcher::LogDispatch/"Logging">.
=head2 Accessors
-See L<documentation in the base class|Log::Report::Dispatcher/"Accessors">.
+Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">.
=over 4
@@ -119,29 +119,29 @@ Returns the Log::Dispatch::Output object which is used for logging.
=item $obj-E<gt>B<isDisabled>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<mode>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<name>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
-=item $obj-E<gt>B<needs>()
+=item $obj-E<gt>B<needs>( [$reason] )
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<type>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=back
=head2 Logging
-See L<documentation in the base class|Log::Report::Dispatcher/"Logging">.
+Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">.
=over 4
@@ -149,47 +149,47 @@ See L<documentation in the base class|Log::Report::Dispatcher/"Logging">.
=item Log::Report::Dispatcher::LogDispatch-E<gt>B<collectLocation>()
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<collectStack>([MAXDEPTH])
+=item $obj-E<gt>B<collectStack>( [$maxdepth] )
-=item Log::Report::Dispatcher::LogDispatch-E<gt>B<collectStack>([MAXDEPTH])
+=item Log::Report::Dispatcher::LogDispatch-E<gt>B<collectStack>( [$maxdepth] )
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<log>(HASH-of-OPTIONS, REASON, MESSAGE)
+=item $obj-E<gt>B<log>(HASH-$of-%options, $reason, $message, $domain)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<reasonToLevel>(REASON)
+=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<stackTraceLine>(OPTIONS)
+=item $obj-E<gt>B<stackTraceLine>(%options)
-=item Log::Report::Dispatcher::LogDispatch-E<gt>B<stackTraceLine>(OPTIONS)
+=item Log::Report::Dispatcher::LogDispatch-E<gt>B<stackTraceLine>(%options)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<translate>(HASH-of-OPTIONS, REASON, MESSAGE)
+=item $obj-E<gt>B<translate>(HASH-$of-%options, $reason, $message)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
=back
=head1 DETAILS
-See L<documentation in the base class|Log::Report::Dispatcher/"DETAILS">.
+Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">.
=head1 SEE ALSO
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
=head1 LICENSE
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -1,4 +1,4 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
@@ -6,20 +6,19 @@ use warnings;
use strict;
package Log::Report::Dispatcher::Perl;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
use base 'Log::Report::Dispatcher';
-use Log::Report 'log-report', syntax => 'SHORT';
+use Log::Report 'log-report';
use IO::File;
my $singleton = 0; # can be only one (per thread)
-sub log($$$)
-{ my ($self, $opts, $reason, $message) = @_;
- my $text = $self->SUPER::translate($opts, $reason, $message);
+sub log($$$$)
+{ my ($self, $opts, $reason, $message, $domain) = @_;
+ my $text = $self->translate($opts, $reason, $message);
if($opts->{is_fatal})
{ $! = $opts->{errno};
@@ -27,24 +27,24 @@ 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.
-See L<documentation in the base class|Log::Report::Dispatcher/"DESCRIPTION">.
+Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">.
=head1 METHODS
-See L<documentation in the base class|Log::Report::Dispatcher/"METHODS">.
+Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">.
=head1 DETAILS
-See L<documentation in the base class|Log::Report::Dispatcher/"DETAILS">.
+Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">.
=head1 SEE ALSO
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
=head1 LICENSE
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -1,4 +1,4 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
@@ -6,14 +6,15 @@ use warnings;
use strict;
package Log::Report::Dispatcher::Syslog;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
use base 'Log::Report::Dispatcher';
-use Sys::Syslog qw/:standard :extended :macros/;
-use Log::Report 'log-report', syntax => 'SHORT';
+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/;
@@ -31,8 +32,8 @@ my %default_reasonToPrio =
, PANIC => LOG_CRIT
);
-@reasons != keys %default_reasonToPrio
- and panic __"Not all reasons have a default translation";
+@reasons==keys %default_reasonToPrio
+ or panic __"not all reasons have a default translation";
sub init($)
@@ -49,7 +50,10 @@ sub init($)
my $fac = delete $args->{facility} || 'user';
openlog $ident, $flags, $fac; # doesn't produce error.
- $self->{prio} = { %default_reasonToPrio };
+ $self->{LRDS_incl_dom} = delete $args->{include_domain};
+ $self->{LRDS_charset} = delete $args->{charset} || "utf-8";
+
+ $self->{prio} = +{ %default_reasonToPrio };
if(my $to_prio = delete $args->{to_prio})
{ my @to = @$to_prio;
while(@to)
@@ -74,15 +78,23 @@ sub close()
}
-sub log($$$$)
-{ my $self = shift;
- my $text = $self->SUPER::translate(@_) or return;
+sub log($$$$$)
+{ my ($self, $opts, $reason, $msg, $domain) = @_;
+ my $text = encode $self->{LRDS_charset}
+ , $self->translate($opts, $reason, $msg) or return;
- my $prio = $self->reasonToPrio($_[1]);
+ my $prio = $self->reasonToPrio($reason);
# handle each line in message separately
- syslog $prio, "%s", $_
- for split /\n/, $text;
+ $text =~ s/\s+$//s;
+ my @text = split /\n/, $text;
+
+ if($self->{LRDS_incl_dom} && $domain)
+ { $domain =~ s/\%//g; # security
+ syslog $prio, "$domain %s", shift @text
+ }
+
+ syslog $prio, "%s", $_ for @text;
}
@@ -44,39 +44,40 @@ using L<new(to_prio)|Log::Report::Dispatcher::Syslog/"Constructors">. See examp
WARNING => LOG_WARNING PANIC => LOG_CRIT
MISTAKE => LOG_WARNING
-See L<documentation in the base class|Log::Report::Dispatcher/"DESCRIPTION">.
+Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">.
=head1 METHODS
-See L<documentation in the base class|Log::Report::Dispatcher/"METHODS">.
+Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">.
=head2 Constructors
-See L<documentation in the base class|Log::Report::Dispatcher/"Constructors">.
+Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">.
=over 4
=item $obj-E<gt>B<close>()
-See L<Log::Report::Dispatcher/"Constructors">
+Inherited, see L<Log::Report::Dispatcher/"Constructors">
-=item Log::Report::Dispatcher::Syslog-E<gt>B<new>(TYPE, NAME, OPTIONS)
+=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 Log::Report::Dispatcher <undef>
- facility 'user'
- flags 'pid,nowait'
- format_reason Log::Report::Dispatcher 'IGNORE'
- identity <basename $0>
- locale Log::Report::Dispatcher <system locale>
- logsocket undef
- mode Log::Report::Dispatcher 'NORMAL'
- to_prio []
+ -Option --Defined in --Default
+ accept Log::Report::Dispatcher depend on mode
+ charset 'utf8'
+ facility 'user'
+ flags 'pid,nowait'
+ 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
@@ -84,10 +85,13 @@ of the message.
=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 'user' and 'local0' upto 'local7'.
+only defines C<user>, and C<local0> upto C<local7>.
=item flags => STRING
@@ -98,12 +102,16 @@ C<pid>, C<ndelay>, and C<nowait>.
=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'
If specified, the log socket type will be initialized to this before
-openlog is called. If not specified, the system default is used.
+C<openlog()> is called. If not specified, the system default is used.
=item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3
@@ -117,35 +125,35 @@ See L<reasonToPrio()|Log::Report::Dispatcher::Syslog/"Logging">.
=head2 Accessors
-See L<documentation in the base class|Log::Report::Dispatcher/"Accessors">.
+Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">.
=over 4
=item $obj-E<gt>B<isDisabled>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<mode>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<name>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
-=item $obj-E<gt>B<needs>()
+=item $obj-E<gt>B<needs>( [$reason] )
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<type>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=back
=head2 Logging
-See L<documentation in the base class|Log::Report::Dispatcher/"Logging">.
+Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">.
=over 4
@@ -153,47 +161,47 @@ See L<documentation in the base class|Log::Report::Dispatcher/"Logging">.
=item Log::Report::Dispatcher::Syslog-E<gt>B<collectLocation>()
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<collectStack>([MAXDEPTH])
+=item $obj-E<gt>B<collectStack>( [$maxdepth] )
-=item Log::Report::Dispatcher::Syslog-E<gt>B<collectStack>([MAXDEPTH])
+=item Log::Report::Dispatcher::Syslog-E<gt>B<collectStack>( [$maxdepth] )
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<log>(HASH-of-OPTIONS, REASON, MESSAGE)
+=item $obj-E<gt>B<log>(HASH-$of-%options, $reason, $message, $domain)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<reasonToPrio>(REASON)
+=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<stackTraceLine>(OPTIONS)
+=item $obj-E<gt>B<stackTraceLine>(%options)
-=item Log::Report::Dispatcher::Syslog-E<gt>B<stackTraceLine>(OPTIONS)
+=item Log::Report::Dispatcher::Syslog-E<gt>B<stackTraceLine>(%options)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<translate>(HASH-of-OPTIONS, REASON, MESSAGE)
+=item $obj-E<gt>B<translate>(HASH-$of-%options, $reason, $message)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
=back
=head1 DETAILS
-See L<documentation in the base class|Log::Report::Dispatcher/"DETAILS">.
+Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">.
=head1 SEE ALSO
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
=head1 LICENSE
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -1,4 +1,4 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
@@ -6,8 +6,7 @@ use warnings;
use strict;
package Log::Report::Dispatcher::Try;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
use base 'Log::Report::Dispatcher';
@@ -16,15 +15,16 @@ use Log::Report::Exception;
use overload
- bool => 'failed'
- , '""' => 'showStatus';
+ 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->{died} = delete $args->{died};
$self;
}
@@ -45,20 +45,23 @@ sub died(;$)
sub exceptions() { @{shift->{exceptions}} }
-sub log($$$)
-{ my ($self, $opts, $reason, $message) = @_;
+sub log($$$$)
+{ my ($self, $opts, $reason, $message, $domain) = @_;
# If "try" does not want a stack, because of its mode,
# then don't produce one later! (too late)
$opts->{stack} ||= [];
$opts->{location} ||= '';
- push @{$self->{exceptions}}
- , Log::Report::Exception->new
- ( reason => $reason
- , report_opts => $opts
- , message => $message
- );
+ my $e = Log::Report::Exception->new
+ ( reason => $reason
+ , report_opts => $opts
+ , message => $message
+ );
+
+ my $is_fatal = exists $opts->{is_fatal} ? $opts->{is_fatal} : $e->isFatal;
+
+ push @{$self->{exceptions}}, $e;
# later changed into nice message
$self->{died} ||= $opts->{is_fatal};
@@ -66,11 +69,10 @@ sub log($$$)
}
+sub reportFatal(@) { $_->throw(@_) for shift->wasFatal }
sub reportAll(@) { $_->throw(@_) for shift->exceptions }
-sub reportFatal(@) { $_->throw(@_) for shift->wasFatal }
-
#-----------------
@@ -57,15 +57,15 @@ These reports are collected as L<Log::Report::Exception|Log::Report::Exception>
They can be ignored, or thrown to a higher level try... causing
an exit of the program if there is none.
-See L<documentation in the base class|Log::Report::Dispatcher/"DESCRIPTION">.
+Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">.
=head1 METHODS
-See L<documentation in the base class|Log::Report::Dispatcher/"METHODS">.
+Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">.
=head2 Constructors
-See L<documentation in the base class|Log::Report::Dispatcher/"Constructors">.
+Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">.
=over 4
@@ -74,7 +74,7 @@ See L<documentation in the base class|Log::Report::Dispatcher/"Constructors">.
Only when initiated with a FILENAME, the file will be closed. In any
other case, nothing will be done.
-=item Log::Report::Dispatcher::Try-E<gt>B<new>(TYPE, NAME, OPTIONS)
+=item Log::Report::Dispatcher::Try-E<gt>B<new>($type, $name, %options)
-Option --Defined in --Default
accept Log::Report::Dispatcher depend on mode
@@ -95,7 +95,9 @@ other case, nothing will be done.
The exit string ($@) of the eval'ed block.
-=item exceptions => ARRAY-of-EXCEPTIONS
+=item exceptions => ARRAY
+
+ARRAY of L<Log::Report::Exception|Log::Report::Exception> objects.
=item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE
@@ -109,11 +111,11 @@ The exit string ($@) of the eval'ed block.
=head2 Accessors
-See L<documentation in the base class|Log::Report::Dispatcher/"Accessors">.
+Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">.
=over 4
-=item $obj-E<gt>B<died>([STRING])
+=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.
@@ -125,29 +127,29 @@ them may be a fatal one. The other are non-fatal.
=item $obj-E<gt>B<isDisabled>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<mode>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<name>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
-=item $obj-E<gt>B<needs>()
+=item $obj-E<gt>B<needs>( [$reason] )
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=item $obj-E<gt>B<type>()
-See L<Log::Report::Dispatcher/"Accessors">
+Inherited, see L<Log::Report::Dispatcher/"Accessors">
=back
=head2 Logging
-See L<documentation in the base class|Log::Report::Dispatcher/"Logging">.
+Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">.
=over 4
@@ -155,46 +157,46 @@ See L<documentation in the base class|Log::Report::Dispatcher/"Logging">.
=item Log::Report::Dispatcher::Try-E<gt>B<collectLocation>()
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<collectStack>([MAXDEPTH])
+=item $obj-E<gt>B<collectStack>( [$maxdepth] )
-=item Log::Report::Dispatcher::Try-E<gt>B<collectStack>([MAXDEPTH])
+=item Log::Report::Dispatcher::Try-E<gt>B<collectStack>( [$maxdepth] )
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<log>(OPTS, REASON, MESSAGE)
+=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>.
+The $message is either a STRING or a L<Log::Report::Message|Log::Report::Message>.
-=item $obj-E<gt>B<reportAll>(OPTIONS)
+=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
+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
+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<stackTraceLine>(OPTIONS)
+=item $obj-E<gt>B<stackTraceLine>(%options)
-=item Log::Report::Dispatcher::Try-E<gt>B<stackTraceLine>(OPTIONS)
+=item Log::Report::Dispatcher::Try-E<gt>B<stackTraceLine>(%options)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
-=item $obj-E<gt>B<translate>(HASH-of-OPTIONS, REASON, MESSAGE)
+=item $obj-E<gt>B<translate>(HASH-$of-%options, $reason, $message)
-See L<Log::Report::Dispatcher/"Logging">
+Inherited, see L<Log::Report::Dispatcher/"Logging">
=back
@@ -219,7 +221,7 @@ using L<reportAll()|Log::Report::Dispatcher::Try/"Logging"> or L<reportFatal()|L
Returns true if the block exited normally.
-=item $obj-E<gt>B<wasFatal>(OPTIONS)
+=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).
@@ -241,19 +243,19 @@ See L<Log::Report::Message::inClass()|Log::Report::Message/"Processing">
=head1 DETAILS
-See L<documentation in the base class|Log::Report::Dispatcher/"DETAILS">.
+Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">.
=head1 OVERLOADING
=over 4
-=item overload: B<boolean>()
+=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>()
+=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
@@ -263,12 +265,12 @@ or nothing.
=head1 SEE ALSO
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
=head1 LICENSE
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -1,4 +1,4 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
@@ -6,16 +6,15 @@ use warnings;
use strict;
package Log::Report::Dispatcher;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
-use Log::Report 'log-report', syntax => 'SHORT';
+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/;
+use List::Util qw/sum first/;
use Encode qw/find_encoding FB_DEFAULT/;
use Devel::GlobalDestruction qw/in_global_destruction/;
@@ -28,18 +27,19 @@ if($@)
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/;
+ qw/File Perl Syslog Try Callback Log4perl/;
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->isa('Log::Log4perl') ? __PACKAGE__.'::Log4perl'
: $type;
eval "require $backend";
@@ -116,7 +116,7 @@ sub _set_mode($)
$self->{needs} = [ expand_reasons $default_accept[$mode] ];
- info __x"switching to run mode {mode}, accept {accept}"
+ trace __x"switching to run mode {mode}, accept {accept}"
, mode => $mode, accept => $default_accept[$mode];
$mode;
@@ -131,15 +131,25 @@ sub _disabled($)
sub isDisabled() {shift->{disabled}}
-sub needs() { $_[0]->{disabled} ? () : @{$_[0]->{needs}} }
-sub log($$$)
+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";
}
-my %always_loc = map +($_ => 1), qw/ASSERT PANIC/;
sub translate($$$)
{ my ($self, $opts, $reason, $msg) = @_;
@@ -160,12 +170,11 @@ sub translate($$$)
my $locale
= defined $msg->msgid
? ($opts->{locale} || $self->{locale}) # translate whole
- : Log::Report->_setting($msg->domain, 'native_language');
+ : (textdomain $msg->domain)->nativeLanguage;
- # not all implementations of setlocale() return the old value
- my $oldloc = setlocale(&LC_ALL);
- #setlocale(&LC_ALL, $locale || 'en_US');
- setlocale(&LC_ALL, $locale) if $locale;
+ 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;
@@ -176,11 +185,11 @@ sub translate($$$)
: $e ? N__"{message}; {error}"
: undef;
- my $text = defined $format
- ? __x($format, message => $msg->toString, reason => $r, error => $e
- )->toString
- : $msg->toString;
- $text .= "\n";
+ my $text
+ = ( defined $format
+ ? __x($format, message => $msg->toString , reason => $r, error => $e)
+ : $msg
+ )->toString . "\n";
if($show_loc)
{ if(my $loc = $opts->{location} || $self->collectLocation)
@@ -204,7 +213,7 @@ sub translate($$$)
}
setlocale(&LC_ALL, $oldloc)
- if defined $oldloc;
+ if $locale && $locale ne $oldloc;
$self->{charset_enc}->($text);
}
@@ -219,7 +228,7 @@ sub collectStack($)
defined $sub or $nest = 1; # not found
# skip syntax==SHORT routine entries
- $nest++ if defined $sub && $sub =~ m/^Log\:\:Report\:\:/;
+# $nest++ if defined $sub && $sub =~ m/^Log\:\:Report\:\:/;
# special trick by Perl for Carp::Heavy: adds @DB::args
{ package DB; # non-blank before package to avoid problem with OODoc
@@ -51,19 +51,19 @@ 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)
+=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
+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
+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.
+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
@@ -76,13 +76,13 @@ are understood, other ignore unknown OPTIONS.
=item accept => REASONS
-See L<Log::Report::Util::expand_reasons()|Log::Report::Util/"FUNCTIONS"> for possible values. If
+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 C<NORMAL> (the default) then C<accept>'s default
-is C<NOTICE->. In case of C<VERBOSE> it will be C<INFO->, C<ASSERT>
-results in C<ASSERT->, and C<DEBUG> in C<ALL>.
+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
@@ -131,14 +131,17 @@ and L<Log::Report/Run modes>.
Returns the unique name of this dispatcher.
-=item $obj-E<gt>B<needs>()
+=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
+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
@@ -154,21 +157,21 @@ object, but not in case of wrappers like for Log::Dispatch.
Collect the information to be displayed as line where the error occurred.
Probably, this needs improvement, where carp and die show different lines.
-=item $obj-E<gt>B<collectStack>([MAXDEPTH])
+=item $obj-E<gt>B<collectStack>( [$maxdepth] )
-=item Log::Report::Dispatcher-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)
+=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
+directly. Internally, it will call L<translate()|Log::Report::Dispatcher/"Logging">, which does most $of
the work.
-=item $obj-E<gt>B<stackTraceLine>(OPTIONS)
+=item $obj-E<gt>B<stackTraceLine>(%options)
-=item Log::Report::Dispatcher-E<gt>B<stackTraceLine>(OPTIONS)
+=item Log::Report::Dispatcher-E<gt>B<stackTraceLine>(%options)
-Option --Default
abstract 1
@@ -205,7 +208,7 @@ margin.
=back
-=item $obj-E<gt>B<translate>(HASH-of-OPTIONS, REASON, MESSAGE)
+=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
@@ -303,8 +306,8 @@ Exactly what will be added depends on the actual mode of the dispatcher
warning program T.. S S SL SL
error user TE. S S SL SC
fault system TE! S S SL SC
- alert system T.! S S SC SC
- failure system TE! S S SC 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
@@ -343,12 +346,12 @@ using concatenation (see L<Log::Report::Message::concat()|Log::Report::Message/"
=head1 SEE ALSO
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
=head1 LICENSE
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -0,0 +1,140 @@
+# Copyrights 2007-2014 by [Mark Overmeer].
+# For other contributors see ChangeLog.
+# See the manual pages for details on the licensing terms.
+# Pod stripped from pm file by OODoc 2.01.
+use warnings;
+use strict;
+
+package Log::Report::Domain;
+our $VERSION = '1.02';
+
+use base 'Log::Report::Minimal::Domain';
+
+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 handled by the base-class, but documented here.
+ $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 setContext(@)
+{ my $self = shift;
+ my $cr = $self->contextRules # ignore context if no rules given
+ or return;
+
+ $self->{LRD_ctxt_def} = $cr->needDecode(setContext => shift);
+}
+
+
+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 ($msgid, $msgctxt);
+ if(my $rules = $self->contextRules)
+ { ($msgid, $msgctxt)
+ = $rules->ctxtFor($msg, $lang, $self->defaultContext);
+ }
+ else
+ { $msgid = $msg->msgid;
+ 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. We do need to get rit of {<}
+ local $msg->{_msgid} = $msgid;
+
+ my $tr = $self->translator || $self->configure->translator;
+ $tr->translate($msg, $lang, $msgctxt) || $msgid;
+}
+
+1;
+
+__END__
@@ -0,0 +1,259 @@
+=encoding utf8
+
+=head1 NAME
+
+Log::Report::Domain - administer one text-domain
+
+=head1 INHERITANCE
+
+ Log::Report::Domain
+ is a Log::Report::Minimal::Domain
+
+=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|'PRINTI'|'PRINTP'
+
+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. C<PRINTP> uses positional parameters,
+just like C<printf>, implemented by L<String::Print::printp()|String::Print/"FUNCTIONS">.
+
+=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">.
+
+=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>.
+
+=item $obj-E<gt>B<translator>()
+
+=back
+
+=head2 Action
+
+Extends L<"Action" in Log::Report::Minimal::Domain|Log::Report::Minimal::Domain/"Action">.
+
+=over 4
+
+=item Log::Report::Domain-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
+
+ 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 formatter
+
+The C<PRINTI> and C<PRINTP> are special constants for L<configure(formatter)|Log::Report::Domain/"Attributes">,
+and will use L<String::Print|String::Print> functions C<printi()> respectively C<printp()>
+in their default modus. When you want your own formatter, or configuration
+of C<String::Print>, you need to pass a code reference.
+
+ my $sp = String::Print->new
+ ( modifiers => ...
+ , serializers => ...
+ );
+
+ textdomain 'some-domain'
+ , formatter => sub { $sp->printi(@_) };
+
+=head1 SEE ALSO
+
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
+
+=head1 LICENSE
+
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
@@ -1,4 +1,4 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
@@ -6,15 +6,17 @@ use warnings;
use strict;
package Log::Report::Exception;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
-use Log::Report 'log-report';
-use POSIX qw/locale_h/;
+use Log::Report 'log-report';
+use Log::Report::Util qw/is_fatal/;
+use POSIX qw/locale_h/;
-use overload '""' => 'toString';
+use overload
+ '""' => 'toString'
+ , fallback => 1;
sub new($@)
@@ -33,7 +35,7 @@ sub reason(;$)
}
-sub isFatal() { Log::Report->isFatal(shift->{reason}) }
+sub isFatal() { is_fatal shift->{reason} }
sub message(;$)
@@ -55,7 +57,8 @@ sub throw(@)
my $reason;
if($reason = delete $opts->{reason})
- { $opts->{is_fatal} = Log::Report->isFatal($reason)
+ { $self->{reason} = $reason;
+ $opts->{is_fatal} = is_fatal $reason
unless exists $opts->{is_fatal};
}
else
@@ -32,7 +32,7 @@ an (untranslated) report.
=over 4
-=item Log::Report::Exception-E<gt>B<new>(OPTIONS)
+=item Log::Report::Exception-E<gt>B<new>(%options)
-Option --Default
message <required>
@@ -58,16 +58,16 @@ an (untranslated) report.
=item $obj-E<gt>B<isFatal>()
Returns whether this exception has a severity which makes it fatal
-when thrown. See L<Log::Report::isFatal()|Log::Report/"Reasons">.
+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])
+=item $obj-E<gt>B<message>( [$message] )
-Change the MESSAGE of the exception, must be a L<Log::Report::Message|Log::Report::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
@@ -80,7 +80,7 @@ example:
$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<reason>( [$reason] )
=item $obj-E<gt>B<report_opts>()
@@ -90,12 +90,12 @@ example:
=over 4
-=item $obj-E<gt>B<inClass>(CLASS|REGEX)
+=item $obj-E<gt>B<inClass>($class|Regexp)
-Check whether any of the classes listed in the message match CLASS
-(string) or the REGEX. This uses L<Log::Report::Message::inClass()|Log::Report::Message/"Processing">.
+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>([FILEHANDLE])
+=item $obj-E<gt>B<print>( [$fh] )
The default filehandle is STDOUT.
@@ -104,13 +104,13 @@ example:
print $exception; # via overloading
$exception->print; # OO style
-=item $obj-E<gt>B<throw>(OPTIONS)
+=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">.
+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.
@@ -140,7 +140,7 @@ example: printing exceptions
=over 4
-=item overload: B<stringification>()
+=item overload: B<stringification>
Produces "reason: message".
@@ -148,12 +148,12 @@ Produces "reason: message".
=head1 SEE ALSO
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
=head1 LICENSE
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -1,171 +0,0 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
-# For other contributors see ChangeLog.
-# See the manual pages for details on the licensing terms.
-# Pod stripped from pm file by OODoc 2.01.
-
-use warnings;
-use strict;
-
-package Log::Report::Extract::PerlPPI;
-use vars '$VERSION';
-$VERSION = '0.994';
-
-use base 'Log::Report::Extract';
-
-use Log::Report 'log-report';
-use PPI;
-
-# See Log::Report translation markup functions
-my %msgids =
- # MSGIDs COUNT OPTS VARS SPLIT
- ( __ => [1, 0, 0, 0, 0]
- , __x => [1, 0, 1, 1, 0]
- , __xn => [2, 1, 1, 1, 0]
- , __n => [2, 1, 1, 0, 0]
- , N__ => [1, 0, 1, 1, 0] # may be used with opts/vars
- , N__n => [2, 0, 1, 1, 0] # idem
- , N__w => [1, 0, 0, 0, 1]
- );
-
-
-sub process($@)
-{ my ($self, $fn, %opts) = @_;
-
- my $charset = $opts{charset} || 'iso-8859-1';
-
- $charset eq 'iso-8859-1'
- or error __x"PPI only supports iso-8859-1 (latin-1) on the moment";
-
- my $doc = PPI::Document->new($fn, readonly => 1)
- or fault __x"cannot read from file {filename}", filename => $fn;
-
- my @childs = $doc->schildren;
- if(@childs==1 && ref $childs[0] eq 'PPI::Statement')
- { info __x"no Perl in file {filename}", filename => $fn;
- return 0;
- }
-
- info __x"processing file {fn} in {charset}", fn=> $fn, charset => $charset;
- my ($pkg, $include, $domain, $msgs_found) = ('main', 0, undef, 0);
-
- NODE:
- foreach my $node ($doc->schildren)
- { if($node->isa('PPI::Statement::Package'))
- { $pkg = $node->namespace;
-
- # special hack needed for module Log::Report itself
- if($pkg eq 'Log::Report')
- { ($include, $domain) = (1, 'log-report');
- $self->_reset($domain, $fn);
- }
- else { ($include, $domain) = (0, undef) }
- next NODE;
- }
-
- if($node->isa('PPI::Statement::Include'))
- { $node->type eq 'use' && $node->module eq 'Log::Report'
- or next NODE;
-
- $include++;
- my $dom = ($node->schildren)[2];
- $domain
- = $dom->isa('PPI::Token::Quote') ? $dom->string
- : $dom->isa('PPI::Token::QuoteLike::Words') ? ($dom->literal)[0]
- : undef;
-
- $self->_reset($domain, $fn);
- }
-
- $node->find_any
- ( sub { # look for the special translation markers
- $_[1]->isa('PPI::Token::Word') or return 0;
-
- my $node = $_[1];
- my $def = $msgids{$node->content} # get __() description
- or return 0;
-
- my @msgids = $self->_get($node, @$def)
- or return 0;
-
- my $line = $node->location->[0];
- unless($domain)
- { mistake __x
- "no text-domain for translatable at {fn} line {line}"
- , fn => $fn, line => $line;
- return 0;
- }
-
- if($def->[4]) # must split? Bulk conversion strings
- { my @words = map {split} @msgids;
- $self->store($domain, $fn, $line, $_) for @words;
- $msgs_found += @words;
- }
- else
- { $self->store($domain, $fn, $line, @msgids);
- $msgs_found += 1;
- }
-
- 0; # don't collect
- }
- );
- }
-
- $msgs_found;
-}
-
-sub _get($@)
-{ my ($self, $node, $msgids, $count, $opts, $vars, $split) = @_;
- my $list_only = ($msgids > 1) || $count || $opts || $vars;
- my $expand = $opts || $vars;
-
- my @msgids;
- my $first = $node->snext_sibling;
- $first = $first->schild(0)
- if $first->isa('PPI::Structure::List');
-
- $first = $first->schild(0)
- if $first->isa('PPI::Statement::Expression');
-
- while(defined $first && $msgids > @msgids)
- { my $msgid;
- my $next = $first->snext_sibling;
- my $sep = $next && $next->isa('PPI::Token::Operator') ? $next : '';
- my $line = $first->location->[0];
-
- if($first->isa('PPI::Token::Quote'))
- { last if $sep !~ m/^ (?: | \=\> | [,;:] ) $/x;
- $msgid = $first->string;
-
- if( $first->isa("PPI::Token::Quote::Double")
- || $first->isa("PPI::Token::Quote::Interpolate"))
- { mistake __x
- "do not interpolate in msgid (found '{var}' in line {line})"
- , var => $1, line => $line
- if $first->string =~ m/(?<!\\)(\$\w+)/;
-
- # content string is uninterpreted, warnings to screen
- $msgid = eval "qq{$msgid}";
-
- error __x "string is incorrect at line {line}: {error}"
- , line => $line, error => $@ if $@;
- }
- }
- elsif($first->isa('PPI::Token::Word'))
- { last if $sep ne '=>';
- $msgid = $first->content;
- }
- else {last}
-
- mistake __x "new-line is added automatically (found in line {line})"
- , line => $line if $msgid =~ s/(?<!\\)\n$//;
-
- push @msgids, $msgid;
- last if $msgids==@msgids || !$sep;
-
- $first = $sep->snext_sibling;
- }
-
- @msgids;
-}
-
-1;
@@ -1,120 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-Log::Report::Extract::PerlPPI - Collect translatable strings from Perl using PPI
-
-=head1 INHERITANCE
-
- Log::Report::Extract::PerlPPI
- is a Log::Report::Extract
-
-=head1 SYNOPSIS
-
- my $ppi = Log::Report::Extract::PerlPPI->new
- ( lexicon => '/usr/share/locale'
- );
- $ppi->process('lib/My/Pkg.pm'); # many times
- $ppi->showStats;
- $ppi->write;
-
- # See script xgettext-perl
-
-=head1 DESCRIPTION
-
-This module helps maintaining the POT files, updating the list of
-message-ids which are kept in them. After initiation, the L<process()|Log::Report::Extract::PerlPPI/"Processors">
-method needs to be called with all files which changed since last processing
-and the existing PO files will get updated accordingly. If no translations
-exist yet, one C<textdomain/xx.po> file will be created.
-
-See L<documentation in the base class|Log::Report::Extract/"DESCRIPTION">.
-
-=head1 METHODS
-
-See L<documentation in the base class|Log::Report::Extract/"METHODS">.
-
-=head2 Constructors
-
-See L<documentation in the base class|Log::Report::Extract/"Constructors">.
-
-=over 4
-
-=item Log::Report::Extract::PerlPPI-E<gt>B<new>(OPTIONS)
-
-See L<Log::Report::Extract/"Constructors">
-
-=back
-
-=head2 Accessors
-
-See L<documentation in the base class|Log::Report::Extract/"Accessors">.
-
-=over 4
-
-=item $obj-E<gt>B<charset>()
-
-See L<Log::Report::Extract/"Accessors">
-
-=item $obj-E<gt>B<domains>()
-
-See L<Log::Report::Extract/"Accessors">
-
-=item $obj-E<gt>B<index>()
-
-See L<Log::Report::Extract/"Accessors">
-
-=item $obj-E<gt>B<pots>(DOMAIN)
-
-See L<Log::Report::Extract/"Accessors">
-
-=back
-
-=head2 Processors
-
-See L<documentation in the base class|Log::Report::Extract/"Processors">.
-
-=over 4
-
-=item $obj-E<gt>B<process>(FILENAME, OPTIONS)
-
-Update the domains mentioned in the FILENAME. All textdomains defined
-in the file will get updated automatically, but not written before
-all files where processed.
-
- -Option --Default
- charset 'iso-8859-1'
-
-=over 2
-
-=item charset => STRING
-
-=back
-
-=item $obj-E<gt>B<showStats>([DOMAINs])
-
-See L<Log::Report::Extract/"Processors">
-
-=item $obj-E<gt>B<store>(DOMAIN, FILENAME, LINENR, MSG, [MSG_PLURAL])
-
-See L<Log::Report::Extract/"Processors">
-
-=item $obj-E<gt>B<write>([DOMAIN])
-
-See L<Log::Report::Extract/"Processors">
-
-=back
-
-=head1 SEE ALSO
-
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
-
-=head1 LICENSE
-
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
@@ -1,136 +0,0 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
-# For other contributors see ChangeLog.
-# See the manual pages for details on the licensing terms.
-# Pod stripped from pm file by OODoc 2.01.
-
-use warnings;
-use strict;
-
-package Log::Report::Extract::Template;
-use vars '$VERSION';
-$VERSION = '0.994';
-
-use base 'Log::Report::Extract';
-
-use Log::Report 'log-report';
-
-
-sub init($)
-{ my ($self, $args) = @_;
- $self->SUPER::init($args);
- $self->{LRET_domain} = $args->{domain}
- or error "template extract requires explicit domain";
-
- $self->{LRET_pattern} = $args->{pattern};
- $self;
-}
-
-
-sub domain() {shift->{LRET_domain}}
-sub pattern() {shift->{LRET_pattern}}
-
-
-sub process($@)
-{ my ($self, $fn, %opts) = @_;
-
- my $charset = $opts{charset} || 'utf-8';
- info __x"processing file {fn} in {charset}", fn=> $fn, charset => $charset;
-
- my $pattern = $opts{pattern} || $self->pattern
- or error __"need pattern to scan for, either via new() or process()";
-
- # Slurp the whole file
- local *IN;
- open IN, "<:encoding($charset)", $fn
- or fault __x"cannot read template from {fn}", fn => $fn;
-
- undef $/;
- my $text = <IN>;
- close IN;
-
- my $domain = $self->domain;
- $self->_reset($domain, $fn);
-
- if(ref $pattern eq 'CODE')
- { return $pattern->($fn, \$text);
- }
- elsif($pattern =~ m/^TT([12])-(\w+)$/)
- { return $self->scanTemplateToolkit($1, $2, $fn, \$text);
- }
- else
- { error __x"unknown pattern {pattern}", pattern => $pattern;
- }
- ();
-}
-
-sub scanTemplateToolkit($$$$)
-{ my ($self, $version, $function, $fn, $textref) = @_;
-
- # Split the whole file on the pattern in four fragments per match:
- # (text, leading, needed trailing, text, leading, ...)
- # f.i. ('', '[% loc("', 'some-msgid', '", params) %]', ' more text')
- my @frags
- = $version==1 ? split(/[\[%]%(.*?)%[%\]]/s, $$textref)
- : split(/\[%(.*?)%\]/s, $$textref);
-
- my $domain = $self->domain;
-
- my $linenr = 1;
- my $msgs_found = 0;
-
- # pre-compile the regexes, for performance
- my $pipe_func_block = qr/^\s*\|\s*$function\b/;
- my $msgid_pipe_func = qr/^\s*(["'])([^\r\n]+?)\1\s*\|\s*$function\b/;
- my $func_msgid_multi = qr/(\b$function\s*\(\s*)(["'])([^\r\n]+?)\2/s;
-
- while(@frags > 2)
- { my ($skip_text, $take) = (shift @frags, shift @frags);
- $linenr += $skip_text =~ tr/\n//;
- if($take =~ $pipe_func_block)
- { # [%|loc(...)%]$msgid[%END%]
- if(@frags < 2 || $frags[1] ne 'END')
- { error __x"template syntax error, no END in {fn} line {line}"
- , fn => $fn, line => $linenr;
- }
- my $msgid = $frags[0]; # next content
- my $plural = $msgid =~ s/\|(.*)// ? $1 : undef;
- $self->store($domain, $fn, $linenr, $msgid, $plural);
- $msgs_found++;
-
- $linenr += $take =~ tr/\n//;
- next;
- }
-
- if($take =~ $msgid_pipe_func)
- { # [%|loc(...)%]$msgid[%END%]
- my $msgid = $2;
- my $plural = $msgid =~ s/\|(.*)// ? $1 : undef;
- $self->store($domain, $fn, $linenr, $msgid, $plural);
- $msgs_found++;
-
- $linenr += $take =~ tr/\n//;
- next;
- }
-
- # loc($msgid, ...) form, can appear more than once
- my @markup = split $func_msgid_multi, $take;
- while(@markup > 4)
- { # quads with text, call, quote, msgid
- $linenr += ($markup[0] =~ tr/\n//)
- + ($markup[1] =~ tr/\n//);
- my $msgid = $markup[3];
- my $plural = $msgid =~ s/\|(.*)// ? $1 : undef;
- $self->store($domain, $fn, $linenr, $msgid, $plural);
- $msgs_found++;
- splice @markup, 0, 4;
- }
- $linenr += $markup[-1] =~ tr/\n//; # rest of container
- }
-# $linenr += $frags[-1] =~ tr/\n//; # final page fragment not needed
-
- $msgs_found;
-}
-
-#----------------------------------------------------
-
-1;
@@ -1,236 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-Log::Report::Extract::Template - collect translatable strings from template files
-
-=head1 INHERITANCE
-
- Log::Report::Extract::Template
- is a Log::Report::Extract
-
-=head1 SYNOPSIS
-
- my $extr = Log::Report::Extract::Template->new
- ( lexicon => '/usr/share/locale'
- , domain => 'my-web-site'
- , pattern => 'TT2-loc'
- );
- $extr->process('website/page.html'); # many times
- $extr->showStats;
- $extr->write;
-
- # See script xgettext-perl
-
-=head1 DESCRIPTION
-
-This module helps maintaining the POT files which list translatable
-strings from template files by updating the list of message-ids which
-are kept in them.
-
-After initiation, the L<process()|Log::Report::Extract::Template/"Processors"> method needs to be called for
-all files which changed since last processing, and the existing PO
-files will get updated accordingly.
-
-If no translations exist yet, one C<$textdomain.po> file will be
-created as point to start. Copy that file into C<$textdomain/$lang.po>
-
-See L<documentation in the base class|Log::Report::Extract/"DESCRIPTION">.
-
-=head1 METHODS
-
-See L<documentation in the base class|Log::Report::Extract/"METHODS">.
-
-=head2 Constructors
-
-See L<documentation in the base class|Log::Report::Extract/"Constructors">.
-
-=over 4
-
-=item Log::Report::Extract::Template-E<gt>B<new>(OPTIONS)
-
- -Option --Defined in --Default
- charset Log::Report::Extract 'utf-8'
- domain <required>
- lexicon Log::Report::Extract <required>
- pattern <undef>
-
-=over 2
-
-=item charset => STRING
-
-=item domain => DOMAIN
-
-There is no syntax for specifying domains in templates (yet), so you
-must be explicit about the collection we are making now.
-
-=item lexicon => DIRECTORY
-
-=item pattern => PREDEFINED|CODE
-
-See the DETAILS section below for a detailed explenation.
-
-=back
-
-=back
-
-=head2 Accessors
-
-See L<documentation in the base class|Log::Report::Extract/"Accessors">.
-
-=over 4
-
-=item $obj-E<gt>B<charset>()
-
-See L<Log::Report::Extract/"Accessors">
-
-=item $obj-E<gt>B<domain>()
-
-=item $obj-E<gt>B<domains>()
-
-See L<Log::Report::Extract/"Accessors">
-
-=item $obj-E<gt>B<index>()
-
-See L<Log::Report::Extract/"Accessors">
-
-=item $obj-E<gt>B<pattern>()
-
-=item $obj-E<gt>B<pots>(DOMAIN)
-
-See L<Log::Report::Extract/"Accessors">
-
-=back
-
-=head2 Processors
-
-See L<documentation in the base class|Log::Report::Extract/"Processors">.
-
-=over 4
-
-=item $obj-E<gt>B<process>(FILENAME, OPTIONS)
-
-Update the domains mentioned in the FILENAME. All textdomains defined
-in the file will get updated automatically, but not written before
-all files where processed.
-
- -Option --Default
- charset 'utf-8'
- pattern <from new(pattern)>
-
-=over 2
-
-=item charset => STRING
-
-The character encoding used in this template file.
-
-=item pattern => PREDEFINED|CODE
-
-Read the DETAILS section about this.
-
-=back
-
-=item $obj-E<gt>B<showStats>([DOMAINs])
-
-See L<Log::Report::Extract/"Processors">
-
-=item $obj-E<gt>B<store>(DOMAIN, FILENAME, LINENR, MSG, [MSG_PLURAL])
-
-See L<Log::Report::Extract/"Processors">
-
-=item $obj-E<gt>B<write>([DOMAIN])
-
-See L<Log::Report::Extract/"Processors">
-
-=back
-
-=head1 DETAILS
-
-=head2 Scan Patterns
-
-Various template systems use different conventions for denoting strings
-to be translated.
-
-=head3 Predefined for Template-Toolkit
-
-There is not a single convertion for translations in C<Template-Toolkit>
-(see Template), so you need to specify which version you use and
-which function you want to run.
-
-For instance
-
- pattern => 'TT2-loc'
-
-will scan for
-
- [% loc("msgid", key => value, ...) %]
- [% loc('msgid', key => value, ...) %]
- [% loc("msgid|plural", count, key => value, ...) %]
-
- [% INCLUDE
- title = loc('something')
- %]
-
- [% | loc(n => name) %]hi {n}[% END %]
- [% 'hi {n}' | loc(n => name) %]
-
-For TT1, the brackets can either be '[%...%]' or '%%...%%'. The function
-name is treated case-sensitive. Some people prefer 'l()'.
-
-The code needed
-
- ... during initiation of the webserver
- my $lexicons = 'some-directory-for-translation-tables';
- my $translator = Log::Report::Translator::POT->new(lexicons => $lexicons);
- Log::Report->translator($textdomain => $translator);
-
- ... your standard template driver
- sub handler {
- ...
- my $fill_in = { ...all kinds of values... };
- $fill_in->{loc} = \&translate; # <--- this is extra
-
- my $output = '';
- my $templater = Template->new(...);
- $templater->process($template_fn, $fill_in, \$output);
- print $output;
- }
-
- ... anywhere in the same file
- sub translate {
- my $textdomain = ...; # your choice when running xgettext-perl
- my $lang = ...; # how do you figure that out?
- my $msg = Log::Report::Message->fromTemplateToolkit($textdomain, @_);
- $msg->toString($lang);
- }
-
-To generate the pod tables, run in the shell something like
-
- xgettext-perl -p $lexicons --template TT2-loc \
- --domain $textdomain $templates_dir
-
-If you want to implement your own extractor --to avoid C<xgettext-perl>--
-you need to run something like this:
-
- my $extr = Log::Report::Extract::Template->new
- ( lexicon => $output
- , charset => 'utf-8'
- , domain => $domain
- , pattern => 'TT2-loc'
- );
- $extr->process($_) for @filenames;
- $extr->write;
-
-=head1 SEE ALSO
-
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
-
-=head1 LICENSE
-
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
@@ -1,183 +0,0 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
-# For other contributors see ChangeLog.
-# See the manual pages for details on the licensing terms.
-# Pod stripped from pm file by OODoc 2.01.
-
-use warnings;
-use strict;
-
-package Log::Report::Extract;
-use vars '$VERSION';
-$VERSION = '0.994';
-
-
-use Log::Report 'log-report';
-use Log::Report::Lexicon::Index ();
-use Log::Report::Lexicon::POT ();
-
-
-sub new(@)
-{ my $class = shift;
- (bless {}, $class)->init( {@_} );
-}
-
-sub init($)
-{ my ($self, $args) = @_;
- my $lexi = $args->{lexicon}
- or error __"extractions require an explicit lexicon directory";
-
- -d $lexi or mkdir $lexi
- or fault __x"cannot create lexicon directory {dir}", dir => $lexi;
-
- $self->{LRE_index} = Log::Report::Lexicon::Index->new($lexi);
- $self->{LRE_charset} = $args->{LRE_charset} || 'utf-8';
- $self->{LRE_domains} = {};
- $self;
-}
-
-
-sub index() {shift->{LRE_index}}
-sub charset() {shift->{LRE_charset}}
-sub domains() {sort keys %{shift->{LRE_domains}}}
-sub pots($)
-{ my ($self, $domain) = @_;
- my $r = $self->{LRE_domains}{$domain};
- $r ? @$r : ();
-}
-
-
-sub process($@)
-{ my ($self, $fn, %opts) = @_;
- panic "not implemented";
-}
-
-
-sub showStats(;$)
-{ dispatcher needs => 'INFO'
- or return;
-
- my $self = shift;
- my @domains = @_ ? @_ : $self->domains;
-
- foreach my $domain (@domains)
- { my $pots = $self->{LRE_domains}{$domain} or next;
- my ($msgids, $fuzzy, $inactive) = (0, 0, 0);
-
- foreach my $pot (@$pots)
- { my $stats = $pot->stats;
- next unless $stats->{fuzzy} || $stats->{inactive};
-
- $msgids = $stats->{msgids};
- next if $msgids == $stats->{fuzzy}; # ignore the template
-
- notice __x
- "{domain}: {fuzzy%3d} fuzzy, {inact%3d} inactive in {filename}"
- , domain => $domain, fuzzy => $stats->{fuzzy}
- , inact => $stats->{inactive}, filename => $pot->filename;
-
- $fuzzy += $stats->{fuzzy};
- $inactive += $stats->{inactive};
- }
-
- if($fuzzy || $inactive)
- { info __xn
-"{domain}: one file with {ids} msgids, {f} fuzzy and {i} inactive translations"
-, "{domain}: {_count} files each {ids} msgids, {f} fuzzy and {i} inactive translations in total"
- , scalar(@$pots), domain => $domain
- , f => $fuzzy, ids => $msgids, i => $inactive
- }
- else
- { info __xn
- "{domain}: one file with {ids} msgids"
- , "{domain}: {_count} files with each {ids} msgids"
- , scalar(@$pots), domain => $domain, ids => $msgids;
- }
- }
-}
-
-
-sub write(;$)
-{ my ($self, $domain) = @_;
- unless(defined $domain) # write all
- { $self->write($_) for $self->domains;
- return;
- }
-
- my $pots = delete $self->{LRE_domains}{$domain}
- or return; # nothing found
-
- for my $pot (@$pots)
- { $pot->updated;
- $pot->write;
- }
-
- $self;
-}
-
-sub DESTROY() {shift->write}
-
-sub _reset($$)
-{ my ($self, $domain, $fn) = @_;
-
- my $pots = $self->{LRE_domains}{$domain}
- ||= $self->_read_pots($domain);
-
- $_->removeReferencesTo($fn) for @$pots;
-}
-
-sub _read_pots($)
-{ my ($self, $domain) = @_;
-
- my $index = $self->index;
- my $charset = $self->charset;
-
- my @pots = map Log::Report::Lexicon::POT->read($_, charset=> $charset),
- $index->list($domain);
-
- trace __xn "found one pot file for domain {domain}"
- , "found {_count} pot files for domain {domain}"
- , @pots, domain => $domain;
-
- return \@pots
- if @pots;
-
- # new text-domain found, start template
- my $fn = $index->addFile("$domain.$charset.po");
- info __x"starting new textdomain {domain}, template in {filename}"
- , domain => $domain, filename => $fn;
-
- my $pot = Log::Report::Lexicon::POT->new
- ( textdomain => $domain
- , filename => $fn
- , charset => $charset
- , version => 0.01
- );
-
- [ $pot ];
-}
-
-
-sub store($$$$;$)
-{ my ($self, $domain, $fn, $linenr, $msgid, $plural) = @_;
-
- foreach my $pot ($self->pots($domain))
- { if(my $po = $pot->msgid($msgid))
- { $po->addReferences( ["$fn:$linenr"]);
- $po->plural($plural) if $plural;
- next;
- }
-
- my $format = $msgid =~ m/\{/ ? 'perl-brace' : 'perl';
- my $po = Log::Report::Lexicon::PO->new
- ( msgid => $msgid
- , msgid_plural => $plural
- , fuzzy => 1
- , format => $format
- , references => [ "$fn:$linenr" ]
- );
-
- $pot->add($po);
- }
-}
-
-1;
@@ -1,126 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-Log::Report::Extract - Collect translatable strings
-
-=head1 INHERITANCE
-
- Log::Report::Extract is extended by
- Log::Report::Extract::PerlPPI
- Log::Report::Extract::Template
-
-=head1 SYNOPSIS
-
- # See the extensions
-
-=head1 DESCRIPTION
-
-This module helps maintaining the POT files, updating the list of
-message-ids which are kept in them. After initiation, the L<process()|Log::Report::Extract/"Processors">
-method needs to be called with all files which changed since last
-processing and the existing PO files will get updated accordingly. If no
-translations exist yet, one C<textdomain/xx.po> file will be created.
-
-=head1 METHODS
-
-=head2 Constructors
-
-=over 4
-
-=item Log::Report::Extract-E<gt>B<new>(OPTIONS)
-
- -Option --Default
- charset 'utf-8'
- lexicon <required>
-
-=over 2
-
-=item charset => STRING
-
-The character-set used in the PO files.
-
-=item lexicon => DIRECTORY
-
-The place where the lexicon is kept. When no lexicon is defined yet,
-this will be the directory where an C<domain/xx.po> file will be created.
-
-=back
-
-=back
-
-=head2 Accessors
-
-=over 4
-
-=item $obj-E<gt>B<charset>()
-
-Returns the character-set used inside the POT files.
-
-=item $obj-E<gt>B<domains>()
-
-Returns a sorted list of all known domain names.
-
-=item $obj-E<gt>B<index>()
-
-Returns the L<Log::Report::Lexicon::Index|Log::Report::Lexicon::Index> object, which is listing
-the files in the lexicon directory tree.
-
-=item $obj-E<gt>B<pots>(DOMAIN)
-
-Returns the list of L<Log::Report::Lexicon::POT|Log::Report::Lexicon::POT> objects which contain
-the tables for DOMAIN.
-
-=back
-
-=head2 Processors
-
-=over 4
-
-=item $obj-E<gt>B<process>(FILENAME, OPTIONS)
-
-Update the domains mentioned in the FILENAME. All text-domains defined
-in the file will get updated automatically, but should not written before
-all files are processed.
-
-Returned is the number of messages found in this particular file.
-
-=item $obj-E<gt>B<showStats>([DOMAINs])
-
-Show a status about the DOMAIN (by default all domains). At least mode
-verbose is required to see this.
-
-The statistics are sent to (Log::Report) dispatchers which accept
-notice and info. This could be syslog. When you have no explicit
-dispatchers in your program, the level of detail get controled by
-the 'mode':
-
- use Log::Report mode => 'DEBUG'; # or 'VERBOSE'
-
-=item $obj-E<gt>B<store>(DOMAIN, FILENAME, LINENR, MSG, [MSG_PLURAL])
-
-Register the existence of a (MSG, MSG_PLURAL) in all POTs of
-the DOMAIN.
-
-=item $obj-E<gt>B<write>([DOMAIN])
-
-Update the information of the files related to DOMAIN, by default all
-processed DOMAINS.
-
-All information known about the written DOMAIN is removed from the cache.
-
-=back
-
-=head1 SEE ALSO
-
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
-
-=head1 LICENSE
-
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
@@ -1,148 +0,0 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
-# For other contributors see ChangeLog.
-# See the manual pages for details on the licensing terms.
-# Pod stripped from pm file by OODoc 2.01.
-
-package Log::Report::Lexicon::Index;
-use vars '$VERSION';
-$VERSION = '0.994';
-
-
-use warnings;
-use strict;
-
-use File::Find ();
-
-use Log::Report 'log-report', syntax => 'SHORT';
-use Log::Report::Util qw/parse_locale/;
-
-# The next two need extension when other lexicon formats are added
-sub _understand_file_format($) { $_[0] =~ qr/\.[mp]o$/i }
-
-sub _find($$)
-{ my ($index, $name) = (shift, lc shift);
- $index->{"$name.mo"} || $index->{"$name.po"}; # prefer mo
-}
-
-# On windows, other locale names are used. They will get translated
-# into the Linux (ISO) convensions.
-
-my $locale_unifier;
-if($^O eq 'MSWin32')
-{ require Log::Report::Win32Locale;
- Log::Report::Win32Locale->import;
- $locale_unifier = sub { iso_locale($_[0]) };
-}
-else
-{ # some UNIXes do not understand "POSIX"
- $locale_unifier = sub { uc $_[0] eq 'POSIX' ? 'c' : lc $_[0] };
-}
-
-
-sub new($;@)
-{ my ($class, $dir) = (shift, shift);
- bless {dir => $dir, @_}, $class; # dir before first argument.
-}
-
-
-sub directory() {shift->{dir}}
-
-
-sub index()
-{ my $self = shift;
- return $self->{index} if exists $self->{index};
-
- my $dir = $self->directory;
- my $strip_dir = qr!\Q$dir/!;
-
- $self->{index} = {};
- File::Find::find
- ( +{ wanted => sub
- { -f && !m[/\.] && _understand_file_format($_) or return 1;
- (my $key = $_) =~ s/$strip_dir//;
- $self->addFile($key, $_);
- 1;
- }
- , follow => 1
- , no_chdir => 1
- , follow_skip => 2
- } , $dir
- );
-
- $self->{index};
-}
-
-
-sub addFile($;$)
-{ my ($self, $base, $abs) = @_;
- $abs ||= File::Spec->catfile($self->directory, $base);
- $base =~ s!\\!/!g; # dos->unix
- $self->{index}{lc $base} = $abs;
-}
-
-
-sub find($$)
-{ my $self = shift;
- my $domain = lc shift;
- my $locale = $locale_unifier->(shift);
-
- my $index = $self->index;
- keys %$index or return undef;
-
- my ($lang, $terr, $cs, $modif) = parse_locale $locale;
- unless(defined $lang)
- { defined $locale or $locale = '<undef>';
- # avoid problem with recursion, not translatable!
- print STDERR "illegal locale $locale, when looking for $domain";
- return undef;
- }
-
- $terr = defined $terr ? '_'.$terr : '';
- $cs = defined $cs ? '.'.$cs : '';
- $modif = defined $modif ? '@'.$modif : '';
-
- (my $normcs = $cs) =~ s/[^a-z\d]//g;
- if(length $normcs)
- { $normcs = "iso$normcs" if $normcs !~ /\D/;
- $normcs = '.'.$normcs;
- }
-
- my $fn;
- for my $f ("/lc_messages/$domain", "/$domain")
- { $fn
- ||= _find($index, "$lang$terr$cs$modif$f")
- || _find($index, "$lang$terr$normcs$modif$f")
- || _find($index, "$lang$terr$modif$f")
- || _find($index, "$lang$modif$f")
- || _find($index, "$lang$f");
- }
-
- $fn
- || _find($index, "$domain/$lang$terr$cs$modif")
- || _find($index, "$domain/$lang$terr$normcs$modif")
- || _find($index, "$domain/$lang$terr$modif")
- || _find($index, "$domain/$lang$modif")
- || _find($index, "$domain/$lang");
-}
-
-
-sub list($;$)
-{ my $self = shift;
- my $domain = lc shift;
- my $filter = shift;
- my $index = $self->index;
- my @list = map $index->{$_}, grep m!\b\Q$domain\E\b!, keys %$index;
-
- defined $filter
- or return @list;
-
- $filter = qr/\.\Q$filter\E$/i
- if defined $filter && ref $filter ne 'Regexp';
-
- grep $_ =~ $filter, @list;
-}
-
-#-------------------------------------
-
-
-1;
@@ -1,200 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-Log::Report::Lexicon::Index - search through available translation files
-
-=head1 SYNOPSIS
-
- my $index = Log::Report::Lexicon::Index->new($directory);
- my $fn = $index->find('my-domain', 'nl_NL.utf-8');
-
-=head1 DESCRIPTION
-
-This module handles the lookup of translation files for a whole
-directory tree. It is lazy loading, which means that it will only
-build the search tree when addressed, not when the object is
-created.
-
-=head1 METHODS
-
-=head2 Constructors
-
-=over 4
-
-=item Log::Report::Lexicon::Index-E<gt>B<new>(DIRECTORY, OPTIONS)
-
-Create an index for a certain directory. If the directory does not
-exist or is empty, then the object will still be created.
-
-All files the DIRECTORY tree which are recognized as an translation table
-format which is understood will be listed. Momentarily, those are:
-
-=over
-
-=item . files with extension "po", see L<Log::Report::Lexicon::POTcompact|Log::Report::Lexicon::POTcompact>
-
-=item . [0.993] files with extension "mo", see L<Log::Report::Lexicon::MOTcompact|Log::Report::Lexicon::MOTcompact>
-
-=back
-
-[0.99] Files which are in directories which start with a dot (hidden
-directories) and files which start with a dot (hidden files) are skipped.
-
-=back
-
-=head2 Accessors
-
-=over 4
-
-=item $obj-E<gt>B<directory>()
-
-Returns the directory name.
-
-=back
-
-=head2 Search
-
-=over 4
-
-=item $obj-E<gt>B<addFile>(BASENAME, [ABSOLUTE])
-
-Add a certain file to the index. This method returns the ABSOLUTE
-path to that file, which must be used to access it. When not explicitly
-specified, the ABSOLUTE path will be calculated.
-
-=item $obj-E<gt>B<find>(TEXTDOMAIN, LOCALE)
-
-Lookup the best translation table, according to the rules described
-in chapter L</DETAILS>, below.
-
-Returned is a filename, or C<undef> if nothing is defined for the
-LOCALE (there is no default on this level).
-
-=item $obj-E<gt>B<index>()
-
-For internal use only.
-Force the creation of the index (if not already done). Returns a hash
-with key-value pairs, where the key is the lower-cased version of the
-filename, and the value the case-sensitive version of the filename.
-
-=item $obj-E<gt>B<list>(DOMAIN, [EXTENSION])
-
-Returned is a list of filenames which is used to update the list of
-MSGIDs when source files have changed. All translation files which
-belong to a certain DOMAIN are listed.
-
-The EXTENSION filter can be used to reduce the filenames further, for
-instance to select only C<po> or only C<mo> files, and ignore readme's.
-Use an string, without dot and interpreted case-insensitive, or a
-regular expression.
-
-example:
-
- my @l = $index->list('my-domain');
- my @l = $index->list('my-domain', 'po');
- my @l = $index->list('my-domain', qr/^readme/i);
-
-=back
-
-=head1 DETAILS
-
-It's always complicated to find the lexicon files, because the perl
-package can be installed on any weird operating system. Therefore,
-you may need to specify the lexicon directory or alternative directories
-explicitly. However, you may also choose to install the lexicon files
-in between the perl modules.
-
-=head2 merge lexicon files with perl modules
-
-By default, the filename which contains the package which contains the
-textdomain's translator configuration is taken (that can be only one)
-and changed into a directory name. The path is then extended with C<messages>
-to form the root of the lexicon: the top of the index. After this,
-the locale indication, the lc-category (usually LC_MESSAGES), and
-the C<textdomain> followed by C<.po> are added. This is exactly as
-C<gettext(1)> does, but then using the PO text file instead of the MO
-binary file.
-
-=head2 Locale search
-
-The exact gettext defined format of the locale is
- language[_territory[.codeset]][@modifier]
-The modifier will be used in above directory search, but only if provided
-explicitly.
-
-The manual C<info gettext> determines the rules. During the search,
-components of the locale get stripped, in the following order:
-
-=over 4
-
-=item 1. codeset
-
-=item 2. normalized codeset
-
-=item 3. territory
-
-=item 4. modifier
-
-=back
-
-The normalized codeset (character-set name) is derived by
-
-=over 4
-
-=item 1. Remove all characters beside numbers and letters.
-
-=item 2. Fold letters to lowercase.
-
-=item 3. If the same only contains digits prepend the string "iso".
-
-=back
-
-To speed-up the search for the right table, the full directory tree
-will be indexed only once when needed the first time. The content of
-all defined lexicon directories will get merged into one tree.
-
-=head2 Example
-
-My module is named C<Some::Module> and installed in some of perl's
-directories, say C<~perl5>. The module is defining textdomain
-C<my-domain>. The translation is made into C<nl-NL.utf-8> (locale for
-Dutch spoken in The Netherlands, utf-8 encoded text file).
-
-The translation table is taken from the first existing of these files:
- nl-NL.utf-8/LC_MESSAGES/my-domain.po
- nl-NL.utf-8/LC_MESSAGES/my-domain.po
- nl-NL.utf8/LC_MESSAGES/my-domain.po
- nl-NL/LC_MESSAGES/my-domain.po
- nl/LC_MESSAGES/my-domain.po
-
-Then, attempts are made which are not compatible with gettext. The
-advantage is that the directory structure is much simpler. The idea
-is that each domain has its own locale installation directory, instead
-of everything merged in one place, what gettext presumes.
-
-In order of attempts:
- nl-NL.utf-8/my-domain.po
- nl-NL.utf8/my-domain.po
- nl-NL/my-domain.po
- nl/my-domain.po
- my-domain/nl-NL.utf8.po
- my-domain/nl-NL.po
- my-domain/nl.po
-
-Filenames may get mutulated by the platform (which we will try to hide
-from you [please help improve this]), and are treated case-INsensitive!
-
-=head1 SEE ALSO
-
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
-
-=head1 LICENSE
-
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
@@ -1,179 +0,0 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
-# For other contributors see ChangeLog.
-# See the manual pages for details on the licensing terms.
-# Pod stripped from pm file by OODoc 2.01.
-package Log::Report::Lexicon::MOTcompact;
-use vars '$VERSION';
-$VERSION = '0.994';
-
-use base 'Log::Report::Lexicon::Table';
-
-use warnings;
-use strict;
-
-use Log::Report 'log-report';
-use Fcntl 'SEEK_SET';
-
-use constant MAGIC_NUMBER => 0x95_04_12_DE;
-
-
-sub read($@)
-{ my ($class, $fn, %args) = @_;
- my $take_all = exists $args{take_all} ? $args{take_all} : 1;
-
- my $charset = $args{charset}
- or error __x"charset parameter required for {fn}", fn => $fn;
-
- my (%index, %locs);
- my %self =
- +( index => \%index # fully prepared ::PO objects
- , locs => \%locs # know where to find it
- , filename => $fn
- , charset => $charset
- );
- my $self = bless \%self, $class;
-
- my $fh;
- open $fh, "<:raw", $fn
- or fault __x"cannot read in {cs} from file {fn}"
- , cs => $charset, fn => $fn;
-
- # The magic number will tell us the byte-order
- # See http://www.gnu.org/software/gettext/manual/html_node/MO-Files.html
- my ($magic, $superblock, $originals, $translations);
- CORE::read $fh, $magic, 4
- or fault __x"cannot read magic from {fn}", fn => $fn;
-
- my $byteorder
- = $magic eq pack('V', MAGIC_NUMBER) ? 'V'
- : $magic eq pack('N', MAGIC_NUMBER) ? 'N'
- : error __x"unsupported file type (magic number is {magic%x})"
- , magic => $magic;
-
- # The superblock contains pointers to strings
- CORE::read $fh, $superblock, 6*4 # 6 times a 32 bit int
- or fault __x"cannot read superblock from {fn}", fn => $fn;
-
- my ( $format_rev, $nr_strings, $offset_orig, $offset_trans
- , $size_hash, $offset_hash) = unpack $byteorder x 6, $superblock;
-
- # warn "($format_rev, $nr_strings, $offset_orig, $offset_trans
- # , $size_hash, $offset_hash)";
-
- # Read location of all originals
- seek $fh, $offset_orig, SEEK_SET
- or fault __x"cannot seek to {loc} in {fn} for originals"
- , loc => $offset_orig, fn => $fn;
-
- CORE::read $fh, $originals, $nr_strings*8 # each string 2*4 bytes
- or fault __x"cannot read originals from {fn}, need {size} at {loc}"
- , fn => $fn, loc => $offset_orig, size => $nr_strings*4;
-
- my @origs = unpack $byteorder.'*', $originals;
-
- # Read location of all translations
- seek $fh, $offset_trans, SEEK_SET
- or fault __x"cannot seek to {loc} in {fn} for translations"
- , loc => $offset_orig, fn => $fn;
-
- CORE::read $fh, $translations, $nr_strings*8 # each string 2*4 bytes
- or fault __x"cannot read translations from {fn}, need {size} at {loc}"
- , fn => $fn, loc => $offset_trans, size => $nr_strings*4;
-
- my @trans = unpack $byteorder.'*', $translations;
-
- # We need the originals as index to the translations (unless there
- # is a HASH build-in... which is not defined)
- # The strings are strictly ordered, the spec tells me.
- my ($orig_start, $orig_end) = ($origs[1], $origs[-1]+$origs[-2]);
-
- seek $fh, $orig_start, SEEK_SET
- or fault __x"cannot seek to {loc} in {fn} for msgid strings"
- , loc => $orig_start, fn => $fn;
-
- my ($orig_block, $trans_block);
- my $orig_block_size = $orig_end - $orig_start;
- CORE::read $fh, $orig_block, $orig_block_size
- or fault __x"cannot read msgids from {fn}, need {size} at {loc}"
- , fn => $fn, loc => $orig_start, size => $orig_block_size;
-
- my ($trans_start, $trans_end) = ($trans[1], $trans[-1]+$trans[-2]);
- seek $fh, $trans_start, SEEK_SET
- or fault __x"cannot seek to {loc} in {fn} for transl strings"
- , loc => $trans_start, fn => $fn;
-
- if($take_all)
- { my $trans_block_size = $trans_end - $trans_start;
- CORE::read $fh, $trans_block, $trans_block_size
- or fault __x"cannot read translations from {fn}, need {size} at {loc}"
- , fn => $fn, loc => $trans_start, size => $trans_block_size;
- }
-
- while(@origs)
- { my ($id_len, $id_loc) = (shift @origs, shift @origs);
- my $msgid = substr $orig_block, $id_loc-$orig_start, $id_len;
- my $context = $msgid =~ s/(.*)\x04// ? $1 : undef;
- my ($trans_len, $trans_loc) = (shift @trans, shift @trans);
- if($take_all)
- { my $msgstr = substr $trans_block,$trans_loc-$trans_start,$trans_len;
- my @msgstr = split /\0x00/, $msgstr;
- $index{$msgid} = @msgstr > 1 ? \@msgstr : $msgstr[0];
- }
- else
- { # this may save memory...
- $locs{$msgid} = [$trans_loc, $trans_len];
- }
- }
-
- if($take_all)
- { close $fh
- or failure __x"failed reading from file {fn}", fn => $fn;
- }
- else
- { $self->{fh} = $fh;
- }
-
- $self->setupPluralAlgorithm;
- $self;
-}
-
-
-sub index() {shift->{index}}
-sub filename() {shift->{filename}}
-
-
-sub msgid($)
-{ my $po = $_[0]->{index}{$_[1]};
- return $po if $po;
-
- my ($self, $msgid) = @_;
- my $l = delete $self->{locs}{$msgid} or return ();
-
- my $fh = $self->{fh};
- seek $fh, $l->[0], SEEK_SET
- or fault __x"cannot seek to {loc} late in {fn} for transl strings"
- , loc => $l->[0], fn => $self->filename;
-
- my $block;
- CORE::read $fh, $block, $l->[1]
- or fault __x"cannot read transl late from {fn}, need {size} at {loc}"
- , fn => $self->filename, loc => $l->[0], size => $l->[1];
-
- my @msgstr = split /\0x00/, $block;
- $self->{index}{$msgid} = @msgstr > 1 ? \@msgstr : $msgstr[0];
-}
-
-
-sub msgstr($;$)
-{ my $po = $_[0]->msgid($_[1])
- or return undef;
-
- ref $po # no plurals defined
- or return $po;
-
- # speed!!!
- $po->[$_[0]->{algo}->(defined $_[2] ? $_[2] : 1)]
- || $po->[$_[0]->{algo}->(1)];
-}
-
-1;
@@ -1,166 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-Log::Report::Lexicon::MOTcompact - use translations from an MO file
-
-=head1 INHERITANCE
-
- Log::Report::Lexicon::MOTcompact
- is a Log::Report::Lexicon::Table
-
-=head1 SYNOPSIS
-
- # using a MO table efficiently
- my $mot = Log::Report::Lexicon::MOTcompact
- ->read('mo/nl.mo', charset => 'utf-8')
- or die;
-
- my $header = $pot->msgid('');
- print $mot->msgstr($msgid, 3);
-
-=head1 DESCRIPTION
-
-This module is translating, based on MO files (binary versions of
-the PO files, the "Machine Object" format)
-
-Internally, this module tries to be as efficient as possible: high
-speed and low memory foot-print. You will not be able to sub-class
-this class cleanly.
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"DESCRIPTION">.
-
-=head1 METHODS
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"METHODS">.
-
-=head2 Constructors
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Constructors">.
-
-=over 4
-
-=item Log::Report::Lexicon::MOTcompact-E<gt>B<new>(OPTIONS)
-
-See L<Log::Report::Lexicon::Table/"Constructors">
-
-=item Log::Report::Lexicon::MOTcompact-E<gt>B<read>(FILENAME, OPTIONS)
-
-Read the MOT table information from FILENAME. The msgctxt (context)
-is ignored.
-
- -Option --Default
- charset <required>
- take_all <true>
-
-=over 2
-
-=item charset => STRING
-
-The character-set which is used for the file. You must specify
-this explicitly, while it cannot be trustfully detected automatically.
-
-=item take_all => BOOLEAN
-
-This will cause the whole translation table to be read at once. If
-false, a file-handle will be kept open and translations read on demand.
-That may (but very well may not) save a memory foot-print, especially
-when the strings are large.
-
-=back
-
-=back
-
-=head2 Attributes
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Attributes">.
-
-=over 4
-
-=item $obj-E<gt>B<filename>()
-
-Returns the name of the source file for this data.
-
-=item $obj-E<gt>B<index>()
-
-Returns a HASH of all defined PO objects, organized by msgid. Please try
-to avoid using this: use L<msgid()|Log::Report::Lexicon::MOTcompact/"Managing PO's"> for lookup.
-
-=back
-
-=head2 Managing PO's
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Managing PO's">.
-
-=head3 Translation
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Translation">.
-
-=over 4
-
-=item $obj-E<gt>B<msgid>(STRING)
-
-Lookup the translations with the STRING. Returns a SCALAR, when only
-one translation is known, and an ARRAY when we have plural forms.
-Returns C<undef> when the translation is not defined.
-
-=item $obj-E<gt>B<msgstr>(MSGID, [COUNT])
-
-Returns the translated string for MSGID. When not specified, COUNT is 1
-(the singular form).
-
-=back
-
-=head3 Administration
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Administration">.
-
-=over 4
-
-=item $obj-E<gt>B<add>(PO)
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=item $obj-E<gt>B<header>(FIELD)
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=item $obj-E<gt>B<nrPlurals>()
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=item $obj-E<gt>B<pluralIndex>(COUNT)
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=item $obj-E<gt>B<setupPluralAlgorithm>()
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=item $obj-E<gt>B<translations>([ACTIVE])
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=back
-
-=head1 DIAGNOSTICS
-
-=over 4
-
-=item Error: only acceptable parameter is 'ACTIVE'
-
-=back
-
-=head1 SEE ALSO
-
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
-
-=head1 LICENSE
-
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
@@ -1,354 +0,0 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
-# For other contributors see ChangeLog.
-# See the manual pages for details on the licensing terms.
-# Pod stripped from pm file by OODoc 2.01.
-package Log::Report::Lexicon::PO;
-use vars '$VERSION';
-$VERSION = '0.994';
-
-
-use warnings;
-use strict;
-
-use Log::Report 'log-report', syntax => 'SHORT';
-
-# steal from cheaper module, we have no ::Util for this (yet)
-use Log::Report::Lexicon::POTcompact ();
-*_escape = \&Log::Report::Lexicon::POTcompact::_escape;
-*_unescape = \&Log::Report::Lexicon::POTcompact::_unescape;
-
-
-sub new(@)
-{ my $class = shift;
- (bless {}, $class)->init( {@_} );
-}
-
-sub init($)
-{ my ($self, $args) = @_;
- defined($self->{msgid} = delete $args->{msgid})
- or error "no msgid defined for PO";
-
- $self->{msgctxt} = delete $args->{msgctxt};
- $self->{plural} = delete $args->{msgid_plural};
- $self->{msgstr} = delete $args->{msgstr};
-
- $self->addComment(delete $args->{comment});
- $self->addAutomatic(delete $args->{automatic});
- $self->fuzzy(delete $args->{fuzzy});
-
- $self->{refs} = {};
- $self->addReferences(delete $args->{references})
- if defined $args->{references};
-
- $self;
-}
-
-# only for internal usage
-sub _fast_new($) { bless $_[1], $_[0] }
-
-#--------------------
-
-sub msgid() {shift->{msgid}}
-sub msgctxt() {shift->{msgctxt}}
-
-
-sub plural(;$)
-{ my $self = shift;
- @_ or return $self->{plural};
-
- if(my $m = $self->{msgstr})
- { # prepare msgstr list for multiple translations.
- $self->{msgstr} = [ $m ] if defined $m && !ref $m;
- }
-
- $self->{plural} = shift;
-}
-
-
-sub msgstr($;$)
-{ my $self = shift;
- my $m = $self->{msgstr};
-
- unless($self->{plural})
- { $self->{msgstr} = $_[1] if @_==2;
- return $m;
- }
-
- my $index = shift || 0;
- @_ ? $m->[$index] = shift : $m->[$index];
-}
-
-
-sub comment(@)
-{ my $self = shift;
- @_ or return $self->{comment};
- $self->{comment} = '';
- $self->addComment(@_);
-}
-
-
-sub addComment(@)
-{ my $self = shift;
- my $comment = $self->{comment};
- foreach my $line (ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_)
- { defined $line or next;
- $line =~ s/[\r\n]+/\n/; # cleanup line-endings
- $comment .= $line;
- }
-
- # be sure there is a \n at the end
- $comment =~ s/\n?\z/\n/ if defined $comment;
- $self->{comment} = $comment;
-}
-
-
-sub automatic(@)
-{ my $self = shift;
- @_ or return $self->{automatic};
- $self->{automatic} = '';
- $self->addAutomatic(@_);
-}
-
-
-sub addAutomatic(@)
-{ my $self = shift;
- my $auto = $self->{automatic};
- foreach my $line (ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_)
- { defined $line or next;
- $line =~ s/[\r\n]+/\n/; # cleanup line-endings
- $auto .= $line;
- }
-
- $auto =~ s/\n?\z/\n/ if defined $auto; # be sure there is a \n at the end
- $self->{automatic} = $auto;
-}
-
-
-sub references(@)
-{ my $self = shift;
- if(@_)
- { $self->{refs} = {};
- $self->addReferences(@_);
- }
-
- keys %{$self->{refs}};
-}
-
-
-sub addReferences(@)
-{ my $self = shift;
- my $refs = $self->{refs} ||= {};
- @_ or return $refs;
-
- $refs->{$_}++
- for @_ > 1 ? @_ # list
- : ref $_[0] eq 'ARRAY' ? @{$_[0]} # array
- : split " ",$_[0]; # scalar
- $refs;
-}
-
-
-sub removeReferencesTo($)
-{ my $refs = $_[0]->{refs};
- my $match = qr/^\Q$_[1]\E\:\d+$/;
- $_ =~ $match && delete $refs->{$_}
- for keys %$refs;
-
- scalar keys %$refs;
-}
-
-
-sub isActive() { $_[0]->{msgid} eq '' || keys %{$_[0]->{refs}} }
-
-
-sub fuzzy(;$) {my $self = shift; @_ ? $self->{fuzzy} = shift : $self->{fuzzy}}
-
-
-sub format(@)
-{ my $format = shift->{format};
- return $format->{ (shift) }
- if @_==1 && !ref $_[0]; # language
-
- my @pairs = @_ > 1 ? @_ : ref $_[0] eq 'ARRAY' ? @{$_[0]} : %{$_[0]};
- while(@pairs)
- { my($k, $v) = (shift @pairs, shift @pairs);
- $format->{$k} = $v;
- }
- $format;
-}
-
-
-sub addFlags($)
-{ my $self = shift;
- local $_ = shift;
- my $where = shift;
-
- s/^\s+//;
- s/\s*$//;
- foreach my $flag (split /\s*\,\s*/)
- { if($flag eq 'fuzzy') { $self->fuzzy(1) }
- elsif($flag =~ m/^no-(.*)-format$/) { $self->format($1, 0) }
- elsif($flag =~ m/^(.*)-format$/) { $self->format($1, 1) }
- else
- { warning __x"unknown flag {flag} ignored", flag => $flag;
- }
- }
- $_;
-}
-
-sub fromText($$)
-{ my $class = shift;
- my @lines = split /[\r\n]+/, shift;
- my $where = shift || ' unkown location';
-
- my $self = bless {}, $class;
-
- # translations which are not used anymore are escaped with #~
- # however, we just say: no references found.
- s/^\#\~\s+// for @lines;
-
- my $last; # used for line continuations
- foreach (@lines)
- { s/\r?\n$//;
- if( s/^\#(.)\s?// )
- { if($1 =~ /\s/) { $self->addComment($_) }
- elsif($1 eq '.' ) { $self->addAutomatic($_) }
- elsif($1 eq ':' ) { $self->addReferences($_) }
- elsif($1 eq ',' ) { $self->addFlags($_) }
- else
- { warning __x"unknown comment type '{cmd}' at {where}"
- , cmd => "#$1", where => $where;
- }
- undef $last;
- }
- elsif( s/^\s*(\w+)\s+// )
- { my $cmd = $1;
- my $string = _unescape($_,$where);
-
- if($cmd eq 'msgid')
- { $self->{msgid} = $string;
- $last = \($self->{msgid});
- }
- elsif($cmd eq 'msgid_plural')
- { $self->{plural} = $string;
- $last = \($self->{plural});
- }
- elsif($cmd eq 'msgstr')
- { $self->{msgstr} = $string;
- $last = \($self->{msgstr});
- }
- elsif($cmd eq 'msgctxt')
- { $self->{msgctxt} = $string;
- $last = \($self->{msgctxt});
- }
- else
- { warning __x"do not understand command '{cmd}' at {where}"
- , cmd => $cmd, where => $where;
- undef $last;
- }
- }
- elsif( s/^\s*msgstr\[(\d+)\]\s*// )
- { my $nr = $1;
- $self->{msgstr}[$nr] = _unescape($_,$where);
- }
- elsif( m/^\s*\"/ )
- { if(defined $last) { $$last .= _unescape($_,$where) }
- else
- { warning __x"quoted line is not a continuation at {where}"
- , where => $where;
- }
- }
- else
- { warning __x"do not understand line at {where}:\n {line}"
- , where => $where, line => $_;
- }
- }
-
- defined $self->{msgid}
- or warning __x"no msgid in block {where}", where => $where;
-
- $self;
-}
-
-
-sub toString(@)
-{ my ($self, %args) = @_;
- my $nplurals = $args{nr_plurals};
- my @record;
-
- my $comment = $self->comment;
- if(defined $comment && length $comment)
- { $comment =~ s/^/# /gm;
- push @record, $comment;
- }
-
- my $auto = $self->automatic;
- if(defined $auto && length $auto)
- { $auto =~ s/^/#. /gm;
- push @record, $auto;
- }
-
- my @refs = sort $self->references;
- my $msgid = $self->{msgid} || '';
- my $active = $msgid eq '' || @refs ? '' : '#~ ';
-
- while(@refs)
- { my $line = '#:';
- $line .= ' '.shift @refs
- while @refs && length($line) + length($refs[0]) < 80;
- push @record, "$line\n";
- }
-
- my @flags = $self->{fuzzy} ? 'fuzzy' : ();
-
- push @flags, ($self->{format}{$_} ? '' : 'no-') . $_ . '-format'
- for sort keys %{$self->{format}};
-
- push @record, "#, ". join(", ", @flags) . "\n"
- if @flags;
-
- my $msgctxt = $self->{msgctxt};
- if(defined $msgctxt && length $msgctxt)
- { push @record, "${active}msgctxt "._escape($msgctxt, "\n$active")."\n";
- }
- push @record, "${active}msgid "._escape($msgid, "\n$active")."\n";
-
- my $msgstr = $self->{msgstr} || [];
- my @msgstr = ref $msgstr ? @$msgstr : $msgstr;
- my $plural = $self->{plural};
- if(defined $plural)
- { push @record
- , "${active}msgid_plural " . _escape($plural, "\n$active") . "\n";
-
- push @msgstr, ''
- while defined $nplurals && @msgstr < $nplurals;
-
- if(defined $nplurals && @msgstr > $nplurals)
- { warning __x"too many plurals for '{msgid}'", msgid => $msgid;
- $#msgstr = $nplurals -1;
- }
-
- $nplurals ||= 2;
- for(my $nr = 0; $nr < $nplurals; $nr++)
- { push @record, "${active}msgstr[$nr] "
- . _escape($msgstr[$nr], "\n$active") . "\n";
- }
- }
- else
- { warning __x"no plurals for '{msgid}'", msgid => $msgid
- if @msgstr > 1;
-
- push @record
- , "${active}msgstr " . _escape($msgstr[0], "\n$active") . "\n";
- }
-
- join '', @record;
-}
-
-
-sub unused()
-{ my $self = shift;
- ! $self->references && ! $self->msgstr(0);
-}
-
-1;
@@ -1,217 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-Log::Report::Lexicon::PO - one translation definition
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-This module is administering one translation object. Sets of PO
-records are kept in a POT file, implemented in L<Log::Report::Lexicon::POT|Log::Report::Lexicon::POT>.
-
-=head1 METHODS
-
-=head2 Constructors
-
-=over 4
-
-=item Log::Report::Lexicon::PO-E<gt>B<new>(OPTIONS)
-
- -Option --Default
- automatic ""
- comment []
- format []
- fuzzy false
- msgctxt undef
- msgid <required>
- msgid_plural undef
- msgstr "" or []
- references []
-
-=over 2
-
-=item automatic => PARAGRAPH
-
-Automatically added comments.
-See L<addAutomatic()|Log::Report::Lexicon::PO/"Attributes">.
-
-=item comment => PARAGRAPH
-
-Translator added comments.
-See L<addComment()|Log::Report::Lexicon::PO/"Attributes">.
-
-=item format => ARRAY-OF-PAIRS|HASH
-
-See L<format()|Log::Report::Lexicon::PO/"Attributes">.
-
-=item fuzzy => BOOLEAN
-
-The string is not yet translated, some smart guesses may have been made.
-See L<fuzzy()|Log::Report::Lexicon::PO/"Attributes">.
-
-=item msgctxt => STRING
-
-Context string: text around the msgid itself.
-
-=item msgid => STRING
-
-=item msgid_plural => STRING
-
-=item msgstr => STRING|ARRAY-OF-STRING
-
-The translations for the msgid. When msgid_plural is defined, then an
-ARRAY must be provided.
-
-=item references => STRING|ARRAY-OF-LOCATIONS
-
-The STRING is a blank separated list of LOCATIONS.
-LOCATIONs are of the form C<filename:linenumber>, for
-instance C<lib/Foo.pm:42>
-See L<addReferences()|Log::Report::Lexicon::PO/"Attributes">
-
-=back
-
-=back
-
-=head2 Attributes
-
-=over 4
-
-=item $obj-E<gt>B<addAutomatic>(LIST|ARRAY|STRING)
-
-Add multiple lines to the translator's comment block. Returns an
-empty string if there are no comments.
-
-=item $obj-E<gt>B<addComment>(LIST|ARRAY|STRING)
-
-Add multiple lines to the translator's comment block. Returns an
-empty string if there are no comments.
-
-=item $obj-E<gt>B<addFlags>(STRING)
-
-Parse a "flags" line.
-
-=item $obj-E<gt>B<addReferences>(STRING|LIST|ARRAY)
-
-The STRING is a blank separated list of LOCATIONS. The LIST and
-ARRAY contain separate LOCATIONs. A LOCATION is of the form
-C<filename:linenumber>. Returns the internal HASH with references.
-
-=item $obj-E<gt>B<automatic>([LIST|ARRAY|STRING])
-
-Returns a STRING which contains the cleaned paragraph of automatically
-added comments. If an argument is specified, it will replace the current
-comment.
-
-=item $obj-E<gt>B<comment>([LIST|ARRAY|STRING])
-
-Returns a STRING which contains the cleaned paragraph of translator's
-comment. If an argument is specified, it will replace the current
-comment.
-
-=item $obj-E<gt>B<format>(LANGUAGE|PAIRS|ARRAY-OF-PAIRS|HASH)
-
-When one LANGUAGE is specified, it looks whether a C<LANGUAGE-format> or
-C<no-LANGUAGE-format> is present in the line of FLAGS. This will return
-C<1> (true) in the first case, C<0> (false) in the second case. It will
-return C<undef> (also false) in case that both are not present.
-
-You can also specify PAIRS: the key is a language name, and the
-value is either C<0>, C<1>, or C<undef>.
-
-example: use of format()
-
- if($po->format('c')) ...
- unless($po->format('perl-brace')) ...
- if(defined $po->format('java')) ...
-
- $po->format(java => 1); # results in 'java-format'
- $po->format(java => 0); # results in 'no-java-format'
- $po->format(java => undef); # results in ''
-
-=item $obj-E<gt>B<fuzzy>([BOOLEAN])
-
-Returns whether the translation needs human inspection.
-
-=item $obj-E<gt>B<isActive>()
-
-Returns whether the translation has any references, or is the header.
-
-=item $obj-E<gt>B<msgctxt>()
-
-Returns the message context, if provided.
-
-=item $obj-E<gt>B<msgid>()
-
-Returns the actual msgid, which cannot be C<undef>.
-
-=item $obj-E<gt>B<msgstr>([INDEX, [STRING]])
-
-With a STRING, a new translation will be set. Without STRING, a
-lookup will take place. When no plural is defined, the INDEX is
-ignored.
-
-=item $obj-E<gt>B<plural>([STRING])
-
-Returns the actual msgid_plural, which can be C<undef>.
-
-=item $obj-E<gt>B<references>([STRING|LIST|ARRAY])
-
-Returns an unsorted list of LOCATIONS. When options are specified,
-then those will be used to replace all currently defined references.
-Returns the unsorted LIST of references.
-
-=item $obj-E<gt>B<removeReferencesTo>(FILENAME)
-
-Remove all the references to the indicate FILENAME from the list. Returns
-the number of refs left.
-
-=back
-
-=head2 Parsing
-
-=over 4
-
-=item Log::Report::Lexicon::PO-E<gt>B<fromText>(STRING, [WHERE])
-
-Parse the STRING into a new PO object. The WHERE string should explain
-the location of the STRING, to be used in error messages.
-
-=item $obj-E<gt>B<toString>(OPTIONS)
-
-Format the object into a multi-lined string.
-
- -Option --Default
- nr_plurals undef
-
-=over 2
-
-=item nr_plurals => INTEGER
-
-If the number of plurals is specified, then the plural translation
-list can be checked for the correct length. Otherwise, no smart
-behavior is attempted.
-
-=back
-
-=item $obj-E<gt>B<unused>()
-
-The message-id has no references anymore and no translations.
-
-=back
-
-=head1 SEE ALSO
-
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
-
-=head1 LICENSE
-
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
@@ -1,255 +0,0 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
-# For other contributors see ChangeLog.
-# See the manual pages for details on the licensing terms.
-# Pod stripped from pm file by OODoc 2.01.
-package Log::Report::Lexicon::POT;
-use vars '$VERSION';
-$VERSION = '0.994';
-
-use base 'Log::Report::Lexicon::Table';
-
-use warnings;
-use strict;
-
-use Log::Report 'log-report';
-use Log::Report::Lexicon::PO ();
-
-use POSIX qw/strftime/;
-use List::Util qw/sum/;
-
-use constant MSGID_HEADER => '';
-
-
-sub init($)
-{ my ($self, $args) = @_;
-
- $self->{filename} = $args->{filename};
- $self->{charset} = $args->{charset}
- or error __x"charset parameter is required for {fn}"
- , fn => ($args->{filename} || __"unnamed file");
-
- my $version = $args->{version};
- my $domain = $args->{textdomain}
- or error __"textdomain parameter is required";
-
- my $forms = $args->{plural_forms};
- unless($forms)
- { my $nrplurals = $args->{nr_plurals} || 2;
- my $algo = $args->{plural_alg} || 'n!=1';
- $forms = "nplurals=$nrplurals; plural=($algo);";
- }
-
- $self->{index} = $args->{index} || {};
- $self->_createHeader
- ( project => $domain . (defined $version ? " $version" : '')
- , forms => $forms
- , charset => $args->{charset}
- , date => $args->{date}
- );
-
- $self->setupPluralAlgorithm;
- $self;
-}
-
-
-sub read($@)
-{ my ($class, $fn, %args) = @_;
-
- my $self = bless {}, $class;
-
- my $charset = $self->{charset} = $args{charset}
- or error __x"charset parameter is required for {fn}", fn => $fn;
-
- open my $fh, "<:encoding($charset)", $fn
- or fault __x"cannot read in {cs} from file {fn}"
- , cs => $charset, fn => $fn;
-
- local $/ = "\n\n";
- my $linenr = 1; # $/ frustrates $fh->input_line_number
- while(1)
- { my $location = "$fn line $linenr";
- my $block = <$fh>;
- defined $block or last;
-
- $linenr += $block =~ tr/\n//;
-
- $block =~ s/\s+\z//s;
- length $block or last;
-
- my $po = Log::Report::Lexicon::PO->fromText($block, $location);
- $self->add($po) if $po;
- }
-
- close $fh
- or failure __x"failed reading from file {fn}", fn => $fn;
-
- $self->{filename} = $fn;
- $self->setupPluralAlgorithm;
- $self;
-}
-
-
-sub write($@)
-{ my $self = shift;
- my $file = @_%2 ? shift : $self->filename;
- my %args = @_;
-
- defined $file
- or error __"no filename or file-handle specified for PO";
-
- my @opt = (nplurals => $self->nrPlurals);
-
- my $fh;
- if(ref $file) { $fh = $file }
- else
- { my $layers = '>:encoding('.$self->charset.')';
- open $fh, $layers, $file
- or fault __x"cannot write to file {fn} in {layers}"
- , fn => $file, layers => $layers;
- }
-
- $fh->print($self->msgid(MSGID_HEADER)->toString(@opt));
- my $index = $self->index;
- foreach my $msgid (sort keys %$index)
- { next if $msgid eq MSGID_HEADER;
-
- my $po = $index->{$msgid};
- next if $po->unused;
-
- $fh->print("\n", $po->toString(@opt));
- }
-
- $fh->close
- or failure __x"write errors for file {fn}", fn => $file;
-
- $self;
-}
-
-#-----------------------
-
-sub charset() {shift->{charset}}
-sub index() {shift->{index}}
-sub filename() {shift->{filename}}
-
-#-----------------------
-
-sub msgid($) { $_[0]->{index}{$_[1]} }
-
-
-sub msgstr($;$)
-{ my $self = shift;
- my $po = $self->msgid(shift)
- or return undef;
-
- $po->msgstr($self->pluralIndex(defined $_[0] ? $_[0] : 1));
-}
-
-
-sub add($)
-{ my ($self, $po) = @_;
- my $msgid = $po->msgid;
-
- $self->{index}{$msgid}
- and error __x"translation already exists for '{msgid}'", msgid => $msgid;
-
- $self->{index}{$msgid} = $po;
-}
-
-
-sub translations(;$)
-{ my $self = shift;
- @_ or return values %{$self->{index}};
-
- error __x"the only acceptable parameter is 'ACTIVE', not '{p}'", p => $_[0]
- if $_[0] ne 'ACTIVE';
-
- grep { $_->isActive } $self->translations;
-}
-
-
-sub _now() { strftime "%Y-%m-%d %H:%M%z", localtime }
-
-sub header($;$)
-{ my ($self, $field) = (shift, shift);
- my $header = $self->msgid(MSGID_HEADER)
- or error __x"no header defined in POT for file {fn}"
- , fn => $self->filename;
-
- if(!@_)
- { my $text = $header->msgstr(0) || '';
- return $text =~ m/^\Q$field\E\:\s*([^\n]*?)\;?\s*$/im ? $1 : undef;
- }
-
- my $content = shift;
- my $text = $header->msgstr(0);
-
- for($text)
- { if(defined $content)
- { s/^\Q$field\E\:([^\n]*)/$field: $content/im # change
- || s/\z/$field: $content\n/; # new
- }
- else
- { s/^\Q$field\E\:[^\n]*\n?//im; # remove
- }
- }
-
- $header->msgstr(0, $text);
- $content;
-}
-
-
-sub updated(;$)
-{ my $self = shift;
- my $date = shift || _now;
- $self->header('PO-Revision-Date', $date);
- $date;
-}
-
-### internal
-sub _createHeader(%)
-{ my ($self, %args) = @_;
- my $date = $args{date} || _now;
-
- my $header = Log::Report::Lexicon::PO->new
- ( msgid => MSGID_HEADER, msgstr => <<__CONFIG);
-Project-Id-Version: $args{project}
-Report-Msgid-Bugs-To:
-POT-Creation-Date: $date
-PO-Revision-Date: $date
-Last-Translator:
-Language-Team:
-MIME-Version: 1.0
-Content-Type: text/plain; charset=$args{charset}
-Content-Transfer-Encoding: 8bit
-Plural-Forms: $args{forms}
-__CONFIG
-
- my $version = $Log::Report::VERSION || '0.0';
- $header->addAutomatic("Header generated with ".__PACKAGE__." $version\n");
-
- $self->index->{&MSGID_HEADER} = $header
- if $header;
-
- $header;
-}
-
-
-sub removeReferencesTo($)
-{ my ($self, $filename) = @_;
- sum map { $_->removeReferencesTo($filename) } $self->translations;
-}
-
-
-sub stats()
-{ my $self = shift;
- my %stats = (msgids => 0, fuzzy => 0, inactive => 0);
- foreach my $po ($self->translations)
- { next if $po->msgid eq MSGID_HEADER;
- $stats{msgids}++;
- $stats{fuzzy}++ if $po->fuzzy;
- $stats{inactive}++ if !$po->isActive && !$po->unused;
- }
- \%stats;
-}
-
-1;
@@ -1,278 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-Log::Report::Lexicon::POT - manage PO files
-
-=head1 INHERITANCE
-
- Log::Report::Lexicon::POT
- is a Log::Report::Lexicon::Table
-
-=head1 SYNOPSIS
-
- # this is usually not for end-users, See ::Extract::PerlPPI
- # using a PO table
-
- my $pot = Log::Report::Lexicon::POT
- ->read('po/nl.po', charset => 'utf-8')
- or die;
-
- my $po = $pot->msgid('msgid');
- print $pot->nrPlurals;
- print $pot->msgstr('msgid', 3);
- $pot->write;
-
- # creating a PO table
-
- my $po = Log::Report::Lexicon::PO->new(...);
- $pot->add($po);
-
- $pot->write('po/nl.po')
- or die;
-
-=head1 DESCRIPTION
-
-This module is reading, extending, and writing POT files. POT files
-are used to store translations in humanly readable format for most of
-existing translation frameworks, like GNU gettext and Perl's Maketext.
-If you only wish to access the translation, then you may use the much
-more efficient L<Log::Report::Lexicon::POTcompact|Log::Report::Lexicon::POTcompact>.
-
-The code is loosely based on Locale::PO, by Alan Schwartz. The coding
-style is a bit off the rest of C<Log::Report>, and there was a need to
-sincere simplification. Each PO record will be represented by a
-L<Log::Report::Lexicon::PO|Log::Report::Lexicon::PO>.
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"DESCRIPTION">.
-
-=head1 METHODS
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"METHODS">.
-
-=head2 Constructors
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Constructors">.
-
-=over 4
-
-=item Log::Report::Lexicon::POT-E<gt>B<new>(OPTIONS)
-
-Create a new POT file. The initial header is generated for you, but
-it can be changed using the L<header()|Log::Report::Lexicon::POT/"Managing PO's"> method.
-
- -Option --Default
- charset <required>
- date now
- filename undef
- index {}
- nr_plurals 2
- plural_alg n!=1
- plural_forms <constructed from nr_plurals and plural_alg>
- textdomain <required>
- version undef
-
-=over 2
-
-=item charset => STRING
-
-The character-set which is used for the output.
-
-=item date => STRING
-
-Overrule the date which is included in the generated header.
-
-=item filename => STRING
-
-Specify an output filename. The name can also be specified when
-L<write()|Log::Report::Lexicon::POT/"Constructors"> is called.
-
-=item index => HASH
-
-A set of translations (L<Log::Report::Lexicon::PO|Log::Report::Lexicon::PO> objects),
-with msgid as key.
-
-=item nr_plurals => INTEGER
-
-The number of translations each of the translation with plural form
-need to have.
-
-=item plural_alg => EXPRESSION
-
-The algorithm to be used to calculate which translated msgstr to use.
-
-=item plural_forms => RULE
-
-[0.992] When this option is used, it overrules C<nr_plurals> and
-C<plural_alg>. The RULE should be a full "Plural-Forms" field.
-
-=item textdomain => STRING
-
-The package name, used in the directory structure to store the
-PO files.
-
-=item version => STRING
-
-=back
-
-=item Log::Report::Lexicon::POT-E<gt>B<read>(FILENAME, OPTIONS)
-
-Read the POT information from FILENAME.
-
- -Option --Default
- charset <required>
-
-=over 2
-
-=item charset => STRING
-
-The character-set which is used for the file. You must specify
-this explicitly, while it cannot be trustfully detected automatically.
-
-=back
-
-=item $obj-E<gt>B<write>([FILENAME|FILEHANDLE], OPTIONS)
-
-When you pass an open FILEHANDLE, you are yourself responsible that
-the correct character-encoding (binmode) is set. When the write
-followed a L<read()|Log::Report::Lexicon::POT/"Constructors"> or the filename was explicitly set with L<filename()|Log::Report::Lexicon::POT/"Attributes">,
-then you may omit the first parameter.
-
-=back
-
-=head2 Attributes
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Attributes">.
-
-=over 4
-
-=item $obj-E<gt>B<charset>()
-
-The character-set to be used for reading and writing. You do not need
-to be aware of Perl's internal encoding for the characters.
-
-=item $obj-E<gt>B<filename>()
-
-Returns the FILENAME, as derived from L<read()|Log::Report::Lexicon::POT/"Constructors"> or specified during
-initiation with L<new(filename)|Log::Report::Lexicon::POT/"Constructors">.
-
-=item $obj-E<gt>B<index>()
-
-Returns a HASH of all defined PO objects, organized by msgid. Please try
-to avoid using this: use L<msgid()|Log::Report::Lexicon::POT/"Managing PO's"> for lookup and L<add()|Log::Report::Lexicon::POT/"Managing PO's"> for adding
-translations.
-
-=back
-
-=head2 Managing PO's
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Managing PO's">.
-
-=over 4
-
-=item $obj-E<gt>B<removeReferencesTo>(FILENAME)
-
-Remove all the references to the indicate FILENAME from all defined
-translations. Returns the number of refs left.
-
-=item $obj-E<gt>B<stats>()
-
-Returns a HASH with some statistics about this POT table.
-
-=item $obj-E<gt>B<updated>([DATE])
-
-Replace the "PO-Revision-Date" with the specified DATE, or the current
-moment.
-
-=back
-
-=head3 Translation
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Translation">.
-
-=over 4
-
-=item $obj-E<gt>B<msgid>(STRING)
-
-Lookup the L<Log::Report::Lexicon::PO|Log::Report::Lexicon::PO> with the STRING. If you
-want to add a new translation, use L<add()|Log::Report::Lexicon::POT/"Managing PO's">. Returns C<undef>
-when not defined.
-
-=item $obj-E<gt>B<msgstr>(MSGID, [COUNT])
-
-Returns the translated string for MSGID. When COUNT is not specified, the
-translation string related to "1" is returned.
-
-=back
-
-=head3 Administration
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Administration">.
-
-=over 4
-
-=item $obj-E<gt>B<add>(PO)
-
-Add the information from a PO into this POT. If the msgid of the PO
-is already known, that is an error.
-
-=item $obj-E<gt>B<header>([FIELD, [CONTENT]])
-
-The translation of a blank MSGID is used to store a MIME header, which
-contains some meta-data. When only a FIELD is specified, that content is
-looked-up (case-insensitive) and returned. When a CONTENT is specified,
-the knowledge will be stored. In latter case, the header structure
-may get created. When the CONTENT is set to C<undef>, the field will
-be removed.
-
-=item $obj-E<gt>B<nrPlurals>()
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=item $obj-E<gt>B<pluralIndex>(COUNT)
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=item $obj-E<gt>B<setupPluralAlgorithm>()
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=item $obj-E<gt>B<translations>([ACTIVE])
-
-Returns a list with all defined L<Log::Report::Lexicon::PO|Log::Report::Lexicon::PO> objects. When
-the string C<ACTIVE> is given as parameter, only objects which have
-references are returned.
-
-=back
-
-=head1 DIAGNOSTICS
-
-=over 4
-
-=item Error: charset parameter is required
-
-=item Error: no filename or file-handle specified for PO
-
-When a PO file is written, then a filename or file-handle must be
-specified explicitly, or set beforehand using the L<filename()|Log::Report::Lexicon::POT/"Attributes">
-method, or known because the write follows a L<read()|Log::Report::Lexicon::POT/"Constructors"> of the file.
-
-=item Error: only acceptable parameter is 'ACTIVE'
-
-=item Error: textdomain parameter is required
-
-=back
-
-=head1 SEE ALSO
-
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
-
-=head1 LICENSE
-
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
@@ -1,118 +0,0 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
-# For other contributors see ChangeLog.
-# See the manual pages for details on the licensing terms.
-# Pod stripped from pm file by OODoc 2.01.
-package Log::Report::Lexicon::POTcompact;
-use vars '$VERSION';
-$VERSION = '0.994';
-
-use base 'Log::Report::Lexicon::Table';
-
-use warnings;
-use strict;
-
-use Log::Report 'log-report';
-use Log::Report::Util qw/escape_chars unescape_chars/;
-
-sub _unescape($$);
-sub _escape($$);
-
-
-sub read($@)
-{ my ($class, $fn, %args) = @_;
-
- my $self = bless {}, $class;
-
- my $charset = $args{charset}
- or error __x"charset parameter required for {fn}", fn => $fn;
-
- open my $fh, "<:encoding($charset)", $fn
- or fault __x"cannot read in {cs} from file {fn}"
- , cs => $charset, fn => $fn;
-
- # Speed!
- my ($last, $msgctxt, $msgid, @msgstr);
- LINE:
- while(my $line = $fh->getline)
- { next if substr($line, 0, 1) eq '#';
-
- if($line =~ m/^\s*$/) # blank line starts new
- { if(@msgstr)
- { $self->{index}{$msgid} = @msgstr > 1 ? [@msgstr] : $msgstr[0];
- ($msgid, @msgstr) = ();
- }
- next LINE;
- }
-
- if($line =~ s/^msgctxt\s+//)
- { undef $last; # ignore context records
- }
- elsif($line =~ s/^msgid\s+//)
- { $msgid = _unescape $line, $fn;
- $last = \$msgid;
- }
- elsif($line =~ s/^msgstr\[(\d+)\]\s*//)
- { $last = \($msgstr[$1] = _unescape $line, $fn);
- }
- elsif($line =~ s/^msgstr\s+//)
- { $msgstr[0] = _unescape $line, $fn;
- $last = \$msgstr[0];
- }
- elsif($last && $line =~ m/^\s*\"/)
- { $$last .= _unescape $line, $fn;
- }
- }
-
- $self->{index}{$msgid} = (@msgstr > 1 ? \@msgstr : $msgstr[0])
- if @msgstr; # don't forget the last
-
- close $fh
- or failure __x"failed reading from file {fn}", fn => $fn;
-
- $self->{filename} = $fn;
- $self->setupPluralAlgorithm;
- $self;
-}
-
-
-sub index() {shift->{index}}
-sub filename() {shift->{filename}}
-
-
-sub msgid($) { $_[0]->{index}{$_[1]} }
-
-
-# speed!!!
-sub msgstr($;$)
-{ my $po = $_[0]->{index}{$_[1]}
- or return undef;
-
- ref $po # no plurals defined
- or return $po;
-
- $po->[$_[0]->{algo}->(defined $_[2] ? $_[2] : 1)]
- || $po->[$_[0]->{algo}->(1)];
-}
-
-#
-### internal helper routines, shared with ::PO.pm and ::POT.pm
-#
-
-sub _unescape($$)
-{ unless( $_[0] =~ m/^\s*\"(.*)\"\s*$/ )
- { warning __x"string '{text}' not between quotes at {location}"
- , text => $_[0], location => $_[1];
- return $_[0];
- }
- unescape_chars $1;
-}
-
-sub _escape($$)
-{ my @escaped = map { '"' . escape_chars($_) . '"' }
- defined $_[0] && length $_[0] ? split(/(?<=\n)/, $_[0]) : '';
-
- unshift @escaped, '""' if @escaped > 1;
- join $_[1], @escaped;
-}
-
-1;
@@ -1,163 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-Log::Report::Lexicon::POTcompact - use translations from a POT file
-
-=head1 INHERITANCE
-
- Log::Report::Lexicon::POTcompact
- is a Log::Report::Lexicon::Table
-
-=head1 SYNOPSIS
-
- # using a PO table efficiently
- my $pot = Log::Report::Lexicon::POTcompact
- ->read('po/nl.po', charset => 'utf-8')
- or die;
-
- my $header = $pot->msgid('');
- print $pot->msgstr('msgid', 3);
-
-=head1 DESCRIPTION
-
-This module is translating, based on PO files. PO files are used to store
-translations in humanly readable format for most of existing translation
-frameworks, like GNU gettext and Perl's Maketext.
-
-Internally, this module tries to be as efficient as possible: high
-speed and low memory foot-print. You will not be able to sub-class
-this class cleanly.
-
-If you like to change the content of PO files, then use
-L<Log::Report::Lexicon::POT|Log::Report::Lexicon::POT>.
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"DESCRIPTION">.
-
-=head1 METHODS
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"METHODS">.
-
-=head2 Constructors
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Constructors">.
-
-=over 4
-
-=item Log::Report::Lexicon::POTcompact-E<gt>B<new>(OPTIONS)
-
-See L<Log::Report::Lexicon::Table/"Constructors">
-
-=item Log::Report::Lexicon::POTcompact-E<gt>B<read>(FILENAME, OPTIONS)
-
-Read the POT table information from FILENAME, as compact as possible.
-Comments, plural-form, and such are lost on purpose: they are not
-needed for translations.
-
- -Option --Default
- charset <required>
-
-=over 2
-
-=item charset => STRING
-
-The character-set which is used for the file. You must specify
-this explicitly, while it cannot be trustfully detected automatically.
-
-=back
-
-=back
-
-=head2 Attributes
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Attributes">.
-
-=over 4
-
-=item $obj-E<gt>B<filename>()
-
-Returns the name of the source file for this data.
-
-=item $obj-E<gt>B<index>()
-
-Returns a HASH of all defined PO objects, organized by msgid. Please try
-to avoid using this: use L<msgid()|Log::Report::Lexicon::POTcompact/"Managing PO's"> for lookup.
-
-=back
-
-=head2 Managing PO's
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Managing PO's">.
-
-=head3 Translation
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Translation">.
-
-=over 4
-
-=item $obj-E<gt>B<msgid>(STRING)
-
-Lookup the translations with the STRING. Returns a SCALAR, when only
-one translation is known, and an ARRAY wherein there are multiple.
-Returns C<undef> when the translation is not defined.
-
-=item $obj-E<gt>B<msgstr>(MSGID, [COUNT])
-
-Returns the translated string for MSGID. When not specified, COUNT is 1
-(the single form).
-
-=back
-
-=head3 Administration
-
-See L<documentation in the base class|Log::Report::Lexicon::Table/"Administration">.
-
-=over 4
-
-=item $obj-E<gt>B<add>(PO)
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=item $obj-E<gt>B<header>(FIELD)
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=item $obj-E<gt>B<nrPlurals>()
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=item $obj-E<gt>B<pluralIndex>(COUNT)
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=item $obj-E<gt>B<setupPluralAlgorithm>()
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=item $obj-E<gt>B<translations>([ACTIVE])
-
-See L<Log::Report::Lexicon::Table/"Administration">
-
-=back
-
-=head1 DIAGNOSTICS
-
-=over 4
-
-=item Error: only acceptable parameter is 'ACTIVE'
-
-=back
-
-=head1 SEE ALSO
-
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
-
-=head1 LICENSE
-
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
@@ -1,70 +0,0 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
-# For other contributors see ChangeLog.
-# See the manual pages for details on the licensing terms.
-# Pod stripped from pm file by OODoc 2.01.
-package Log::Report::Lexicon::Table;
-use vars '$VERSION';
-$VERSION = '0.994';
-
-
-use warnings;
-use strict;
-
-use Log::Report 'log-report';
-
-use POSIX qw/strftime/;
-use IO::File;
-use List::Util qw/sum/;
-
-
-sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) }
-sub init($) {shift}
-
-#-----------------------
-
-#-----------------------
-
-sub msgid($) {panic "not implemented"}
-sub msgstr($;$) {panic "not implemented"}
-
-#------------------
-
-sub add($) {panic "not implemented"}
-
-
-sub translations(;$) {panic "not implemented"}
-
-
-sub pluralIndex($)
-{ my ($self, $count) = @_;
- my $algo = $self->{algo} or panic;
- $algo->($count);
-}
-
-
-sub setupPluralAlgorithm()
-{ my $self = shift;
- my $forms = $self->header('Plural-Forms')
- or error __x"there is no Plural-Forms field in the header";
-
- my $alg = $forms =~ m/plural\=([n%!=><\s\d|&?:()]+)/ ? $1 : "n!=1";
- $alg =~ s/\bn\b/(\$_[0])/g;
- my $code = eval "sub(\$) {$alg}";
- $@ and error __x"invalid plural-form algorithm '{alg}'", alg => $alg;
- $self->{algo} = $code;
-
- $self->{nplurals} = $forms =~ m/\bnplurals\=(\d+)/ ? $1 : 2;
- $self;
-}
-
-
-sub nrPlurals() {shift->{nplurals}}
-
-
-sub header($@)
-{ my ($self, $field) = @_;
- my $header = $self->msgid('') or return;
- $header =~ m/^\Q$field\E\:\s*([^\n]*?)\;?\s*$/im ? $1 : undef;
-}
-
-1;
@@ -1,111 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-Log::Report::Lexicon::Table - generic interface to translation tables
-
-=head1 INHERITANCE
-
- Log::Report::Lexicon::Table is extended by
- Log::Report::Lexicon::MOTcompact
- Log::Report::Lexicon::POT
- Log::Report::Lexicon::POTcompact
-
-=head1 SYNOPSIS
-
- # use one of the extensions, for instance:
- my $pot = Log::Report::Lexicon::POT
- ->read('po/nl.po', charset => 'utf-8')
- or panic;
-
-=head1 DESCRIPTION
-
-This base class defines the generic interface for translation tables.
-
-=head1 METHODS
-
-=head2 Constructors
-
-=over 4
-
-=item Log::Report::Lexicon::Table-E<gt>B<new>(OPTIONS)
-
-=back
-
-=head2 Attributes
-
-=head2 Managing PO's
-
-=head3 Translation
-
-=over 4
-
-=item $obj-E<gt>B<msgid>(STRING)
-
-Lookup the L<Log::Report::Lexicon::PO|Log::Report::Lexicon::PO> with the STRING.
-Returns C<undef> when not defined.
-
-=item $obj-E<gt>B<msgstr>(MSGID, [COUNT])
-
-Returns the translated string for MSGID. When not specified, COUNT is 1.
-
-=back
-
-=head3 Administration
-
-=over 4
-
-=item $obj-E<gt>B<add>(PO)
-
-Add the information from a PO into this POT. If the msgid of the PO
-is already known, that is an error.
-
-=item $obj-E<gt>B<header>(FIELD)
-
-The translation of a blank MSGID is used to store a MIME header, which
-contains some meta-data. The FIELD value is looked-up (case-insensitive)
-and returned.
-
-=item $obj-E<gt>B<nrPlurals>()
-
-Returns the number of plurals, when not known then '2'.
-
-=item $obj-E<gt>B<pluralIndex>(COUNT)
-
-Returns the msgstr index used to translate a value of COUNT.
-
-=item $obj-E<gt>B<setupPluralAlgorithm>()
-
-This method needs to be called after setting (reading or creating) a new
-table header, to interpret the plural algorithm as specified in the
-C<Plural-Forms> header field.
-
-=item $obj-E<gt>B<translations>([ACTIVE])
-
-Returns a list with all defined L<Log::Report::Lexicon::PO|Log::Report::Lexicon::PO> objects. When
-the string C<ACTIVE> is given as parameter, only objects which have
-references are returned.
-
-=back
-
-=head1 DIAGNOSTICS
-
-=over 4
-
-=item Error: only acceptable parameter is 'ACTIVE'
-
-=back
-
-=head1 SEE ALSO
-
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
-
-=head1 LICENSE
-
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
@@ -1,4 +1,4 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
@@ -6,19 +6,25 @@ use warnings;
use strict;
package Log::Report::Message;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
use Log::Report 'log-report';
use POSIX qw/locale_h/;
use List::Util qw/first/;
+# 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';
+ , '.' => 'concat'
+ , fallback => 1;
sub new($@)
@@ -42,6 +48,7 @@ sub new($@)
if($s{_plural})
{ s/\s+$//, s/^\s+// for $s{_plural};
}
+
bless \%s, $class;
}
@@ -78,6 +85,7 @@ sub msgid() {shift->{_msgid}}
sub append() {shift->{_append}}
sub domain() {shift->{_domain}}
sub count() {shift->{_count}}
+sub context() {shift->{_context}}
sub classes()
@@ -111,15 +119,19 @@ sub toString(;$)
or return (defined $self->{_prepend} ? $self->{_prepend} : '')
. (defined $self->{_append} ? $self->{_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);
+
# create a translation
- my $text = Log::Report->translator($self->{_domain})
- ->translate($self, $locale);
+ my $text = (textdomain $self->{_domain})
+ ->translate($self, $self->{_lang} || $locale || $oldloc);
+
defined $text or return ();
- my $loc = defined $locale ? setlocale(LC_ALL, $locale) : undef;
-
if($self->{_expand})
- { my $re = join '|', map { quotemeta $_ } keys %$self;
+ { my $re = join '|', map quotemeta, keys %$self;
$text =~ s/\{($re)(\%[^}]*)?\}/$self->_expand($1,$2)/ge;
}
@@ -129,7 +141,8 @@ sub toString(;$)
$text .= "$self->{_append}"
if defined $self->{_append};
- setlocale(LC_ALL, $loc) if $loc;
+ setlocale(LC_MESSAGES, $oldloc)
+ if defined $oldloc && (!defined $locale || $oldloc ne $locale);
$text;
}
@@ -6,7 +6,7 @@ Log::Report::Message - a piece of text to be translated
=head1 SYNOPSIS
- # Created by Log::Report's __ functions
+ # Objects created by Log::Report's __ functions
# Full feature description in the DETAILS section
# no interpolation
@@ -46,10 +46,10 @@ that depends on the front-end, the log dispatcher.
=over 4
-=item $obj-E<gt>B<clone>(OPTIONS, VARIABLES)
+=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
+with the specified %options and $variables. The advantage is that the
cached translations are shared between the objects.
example: use of clone()
@@ -60,15 +60,15 @@ example: use of clone()
print $s; # found 5 files
print $t; # found 3 files
-=item Log::Report::Message-E<gt>B<fromTemplateToolkit>(DOMAIN, MSGID, PARAMS)
+=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)
+=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/"Language Translations">
-and friends. The OPTIONS is a mixed list of object initiation parameters
+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.
@@ -77,10 +77,12 @@ translated C<_msgid> string.
_category undef
_class []
_classes []
+ _context undef
_count undef
- _domain from use
+ _domain <from "use Log::Report">
_expand false
_join $" $LIST_SEPARATOR
+ _lang <from locale>
_msgid undef
_plural undef
_prepend undef
@@ -113,6 +115,12 @@ ARRAY lists all tokens separately. See L<classes()|Log::Report::Message/"Accesso
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
@@ -123,6 +131,16 @@ is given, the number of keys in the HASH is used.
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.
@@ -131,6 +149,12 @@ Indicates whether variables are to be filled-in.
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 _msgid => MSGID
The message label, which refers to some translation information.
@@ -178,6 +202,10 @@ after this one. Usually C<undef>.
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
@@ -195,15 +223,15 @@ Returns the msgid which will later be translated.
Returns the string which is prepended to this one. Usually C<undef>.
-=item $obj-E<gt>B<to>([NAME])
+=item $obj-E<gt>B<to>( [$name] )
-Returns the NAME of a dispatcher if explicitly specified with
+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)
+=item $obj-E<gt>B<valueOf>($parameter)
-Lookup the named PARAMETER for the message. All pre-defined names
+Lookup the named $parameter for the message. All pre-defined names
have their own method which should be used with preference.
example:
@@ -243,11 +271,11 @@ Simplified, the above example can also be written as:
=over 4
-=item $obj-E<gt>B<concat>(STRING|OBJECT, [PREPEND])
+=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
+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
@@ -255,12 +283,12 @@ example: of concatenation
print __"Hello" . ' ' . __"World!";
print __("Hello")->concat(' ')->concat(__"World!")->concat("\n");
-=item $obj-E<gt>B<inClass>(CLASS|REGEX)
+=item $obj-E<gt>B<inClass>($class|Regexp)
-Returns true if the message is in the specified CLASS (string) or
-matches the REGEX. The trueth value is the (first matching) class.
+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<toString>([LOCALE])
+=item $obj-E<gt>B<toString>( [$locale] )
Translate a message. If not specified, the default locale is used.
@@ -314,8 +342,13 @@ parameter can disappear.
=head3 Interpolation of VARIABLES
-There is no way of checking beforehand whether you have provided all required
-values, to be interpolated in the translated string.
+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:
@@ -352,35 +385,6 @@ interpolation parameter via the C<_join> OPTION.
error __x"matching files: {files}", files => \@files, _join => ', ';
-=head3 Interpolating formatted
-
-Next to the name, you can specify a format code. With C<gettext()>,
-you often see this:
-
- printf gettext("approx pi: %.6f\n"), PI;
-
-Locale::TextDomain has two ways.
-
- printf __"approx pi: %.6f\n", PI;
- print __x"approx pi: {approx}\n", approx => sprintf("%.6f", PI);
-
-The first does not respect the wish to be able to reorder the
-arguments during translation. The second version is quite long.
-With C<Log::Report>, above syntaxes do work, but you can also do
-
- print __x"approx pi: {pi%.6f}\n", pi => PI;
-
-So: the interpolation syntax is C< { name [format] } >. Other
-examples:
-
- print __x "{perms} {links%2d} {user%-8s} {size%10d} {fn}\n"
- , perms => '-rw-r--r--', links => 1, user => 'me'
- , size => '12345', fn => $filename;
-
-An additional advantage is the fact that not all languages produce
-comparable length strings. Now, the translators can take care that
-the layout of tables is optimal.
-
=head3 Interpolation of OPTIONS
You are permitted the interpolate OPTION values in your string. This may
@@ -452,8 +456,9 @@ interpolation:
{ print $s;
}
-Oops, not what you mean.
-With Log::Report, you can do it.
+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;
@@ -478,19 +483,19 @@ In either case, the translation will be looked-up only once.
=over 4
-=item overload: B<as function>()
+=item overload: B<as $function>
-When the object is used to call as function, a new object is
+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>()
+=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>()
+=item overload: B<stringification>
When the object is used in string context, it will get translated.
Implemented as L<toString()|Log::Report::Message/"Processing">.
@@ -499,12 +504,12 @@ Implemented as L<toString()|Log::Report::Message/"Processing">.
=head1 SEE ALSO
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
=head1 LICENSE
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -1,40 +0,0 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
-# For other contributors see ChangeLog.
-# See the manual pages for details on the licensing terms.
-# Pod stripped from pm file by OODoc 2.01.
-use warnings;
-use strict;
-
-package Log::Report::Translator::Gettext;
-use vars '$VERSION';
-$VERSION = '0.994';
-
-use base 'Log::Report::Translator';
-
-use Locale::gettext;
-
-use Log::Report 'log-report';
-
-
-sub translate($;$)
-{ my ($msg, $lang) = @_;
-
-#XXX MO: how to use $lang when specified?
- my $domain = $msg->{_textdomain};
- load_domain $domain;
-
- my $count = $msg->{_count};
-
- defined $count
- ? ( defined $msg->{_category}
- ? dcngettext($domain, $msg->{_msgid}, $msg->{_plural}, $count
- , $msg->{_category})
- : dngettext($domain, $msg->{_msgid}, $msg->{_plural}, $count)
- )
- : ( defined $msg->{_category}
- ? dcgettext($domain, $msg->{_msgid}, $msg->{_category})
- : dgettext($domain, $msg->{_msgid})
- );
-}
-
-1;
@@ -1,63 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-Log::Report::Translator::Gettext - the GNU gettext infrastructure
-
-=head1 INHERITANCE
-
- Log::Report::Translator::Gettext
- is a Log::Report::Translator
-
-=head1 SYNOPSIS
-
- # normal use (end-users view)
-
- use Log::Report 'my-domain'
- , translator => Log::Report::Translator::Gettext->new;
-
- print __"Hello World\n"; # language determined by environment
-
- # internal use
-
- my $msg = Log::Report::Message->new
- ( _msgid => "Hello World\n"
- , _textdomain => 'my-domain'
- );
-
- print Log::Report::Translator::Gettext->new
- ->translate($msg, 'nl-BE');
-
-=head1 DESCRIPTION
-
-UNTESTED!!! PLEASE CONTRIBUTE!!!
-Translate a message using the GNU gettext infrastructure.
-
-Guido Flohr reports:
-be aware that Locale::gettext is only a binding for the C library
-libintl and depends on its features. That means that your module will
-effectively only run on GNU systems and maybe on Solaris (depending
-on the exact version), because only these systems provide the plural
-handling functions ngettext(), dngettext() and dcngettext(). Sooner or
-later you will probably also need bind_textdomain_codeset() which is
-also only available on certain systems.
-
-See L<documentation in the base class|Log::Report::Translator/"DESCRIPTION">.
-
-=head1 METHODS
-
-See L<documentation in the base class|Log::Report::Translator/"METHODS">.
-
-=head1 SEE ALSO
-
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
-
-=head1 LICENSE
-
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
@@ -1,80 +0,0 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
-# For other contributors see ChangeLog.
-# See the manual pages for details on the licensing terms.
-# Pod stripped from pm file by OODoc 2.01.
-use warnings;
-use strict;
-
-package Log::Report::Translator::POT;
-use vars '$VERSION';
-$VERSION = '0.994';
-
-use base 'Log::Report::Translator';
-
-use Log::Report 'log-report', syntax => 'SHORT';
-use Log::Report::Lexicon::Index;
-use Log::Report::Lexicon::POTcompact;
-
-use POSIX qw/:locale_h/;
-
-my %indices;
-
-# Work-around for missing LC_MESSAGES on old Perls and Windows
-{ no warnings;
- eval "&LC_MESSAGES";
- *LC_MESSAGES = sub(){5} if $@;
-}
-
-
-sub translate($;$)
-{ my ($self, $msg, $lang) = @_;
-
- my $domain = $msg->{_domain};
- my $locale = $lang || setlocale(LC_MESSAGES)
- or return $self->SUPER::translate($msg, $lang);
-
- my $pot
- = exists $self->{pots}{$locale}
- ? $self->{pots}{$locale}
- : $self->load($domain, $locale);
-
- defined $pot
- or return $self->SUPER::translate($msg, $lang);
-
- $pot->msgstr($msg->{_msgid}, $msg->{_count})
- || $self->SUPER::translate($msg, $lang); # default translation is 'none'
-}
-
-sub load($$)
-{ my ($self, $domain, $locale) = @_;
-
- foreach my $lex ($self->lexicons)
- { my $fn = $lex->find($domain, $locale);
-
- !$fn && $lex->list($domain)
- and last; # there are tables for domain, but not our lang
-
- $fn or next;
-
- my ($ext) = lc($fn) =~ m/\.(\w+)$/;
- my $class
- = $ext eq 'mo' ? 'Log::Report::Lexicon::MOTcompact'
- : $ext eq 'po' ? 'Log::Report::Lexicon::POTcompact'
- : error __x"unknown translation table extension '{ext}' in {filename}"
- , ext => $ext, filename => $fn;
-
- info __x"read table {filename} as {class} for {domain} in {locale}"
- , filename => $fn, class => $class, domain => $domain
- , locale => $locale
- if $domain ne 'log-report'; # avoid recursion
-
- eval "require $class" or panic $@;
-
- return $self->{pots}{$locale}
- = $class->read($fn, charset => $self->charset);
- }
-
- $self->{pots}{$locale} = undef;
-}
-
-1;
@@ -1,108 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-Log::Report::Translator::POT - translation based on POT files
-
-=head1 INHERITANCE
-
- Log::Report::Translator::POT
- is a Log::Report::Translator
-
-=head1 SYNOPSIS
-
- # internal use
- my $msg = Log::Report::Message->new
- ( _msgid => "Hello World\n"
- , _domain => 'my-domain'
- );
-
- print Log::Report::Translator::POT
- ->new(lexicon => ...)
- ->translate($msg, 'nl-BE');
-
- # normal use (end-users view)
- use Log::Report 'my-domain'
- , translator => Log::Report::Translator::POT->new;
- print __"Hello World\n";
-
-=head1 DESCRIPTION
-
-Translate a message by directly accessing POT files. The files will load
-lazily (unless forced). This module accesses the PO's in a compact way,
-using L<Log::Report::Lexicon::POTcompact|Log::Report::Lexicon::POTcompact>, which is much more efficient
-than L<Log::Report::Lexicon::PO|Log::Report::Lexicon::PO>.
-
-See L<documentation in the base class|Log::Report::Translator/"DESCRIPTION">.
-
-=head1 METHODS
-
-See L<documentation in the base class|Log::Report::Translator/"METHODS">.
-
-=head2 Constructors
-
-See L<documentation in the base class|Log::Report::Translator/"Constructors">.
-
-=over 4
-
-=item Log::Report::Translator::POT-E<gt>B<new>(OPTIONS)
-
- -Option --Defined in --Default
- charset Log::Report::Translator <from locale>
- lexicons Log::Report::Translator <see text>
-
-=over 2
-
-=item charset => STRING
-
-=item lexicons => DIRECTORY|ARRAY-of-DIRECTORYs
-
-=back
-
-=back
-
-=head2 Accessors
-
-See L<documentation in the base class|Log::Report::Translator/"Accessors">.
-
-=over 4
-
-=item $obj-E<gt>B<charset>()
-
-See L<Log::Report::Translator/"Accessors">
-
-=item $obj-E<gt>B<lexicons>()
-
-See L<Log::Report::Translator/"Accessors">
-
-=back
-
-=head2 Translating
-
-See L<documentation in the base class|Log::Report::Translator/"Translating">.
-
-=over 4
-
-=item $obj-E<gt>B<load>(DOMAIN, LOCALE)
-
-See L<Log::Report::Translator/"Translating">
-
-=item $obj-E<gt>B<translate>(MESSAGE, [LANGUAGE])
-
-See L<Log::Report::Translator/"Translating">
-
-=back
-
-=head1 SEE ALSO
-
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
-
-=head1 LICENSE
-
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
@@ -1,25 +1,21 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
package Log::Report::Translator;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
use warnings;
use strict;
-use File::Spec ();
-
-use Log::Report 'log-report', syntax => 'SHORT';
-
-use Log::Report::Lexicon::Index ();
+use Log::Report 'log-report';
use Log::Report::Message;
+use File::Spec ();
my %lexicons;
-sub _filename_to_lexicon($);
+sub _fn_to_lexdir($);
sub new(@)
@@ -29,20 +25,31 @@ sub new(@)
sub init($)
{ my ($self, $args) = @_;
+
my $lex = delete $args->{lexicons} || delete $args->{lexicon}
- || _filename_to_lexicon $args->{callerfn};
+ || (ref $self eq __PACKAGE__ ? [] : _fn_to_lexdir $args->{callerfn});
my @lex;
- foreach my $lex (ref $lex eq 'ARRAY' ? @$lex : $lex)
- { push @lex, $lexicons{$lex} ||= # lexicon indexes are shared
- Log::Report::Lexicon::Index->new($lex);
+ foreach my $dir (ref $lex eq 'ARRAY' ? @$lex : $lex)
+ { unless(exists $INC{'Log/Report/Lexicon/Index.pm'})
+ { eval "require Log::Report::Lexicon::Index";
+ panic $@ if $@;
+
+ error __x"You have to upgrade Log::Report::Lexicon to at least 1.00"
+ if $Log::Report::Lexicon::Index::VERSION < 1.00;
+ }
+
+ # lexicon indexes are shared
+ my $l = $lexicons{$dir} ||= Log::Report::Lexicon::Index->new($dir);
+ $l->index; # index the files now
+ push @lex, $l;
}
$self->{lexicons} = \@lex;
$self->{charset} = $args->{charset} || 'utf-8';
$self;
}
-sub _filename_to_lexicon($)
+sub _fn_to_lexdir($)
{ my $fn = shift;
$fn =~ s/\.pm$//;
File::Spec->catdir($fn, 'messages');
@@ -57,7 +64,7 @@ sub charset() {shift->{charset}}
# this is called as last resort: if a translator cannot find
# any lexicon or has no matching language.
-sub translate($)
+sub translate($$$)
{ my $msg = $_[1];
defined $msg->{_count} && $msg->{_count} != 1
@@ -17,7 +17,8 @@ Log::Report::Translator - base implementation for translating messages
print Log::Report::Translator->new(...)->translate($msg);
# normal use
- use Log::Report 'my-domain';
+ textdomain 'my-domain'
+ , translator => Log::Report::Translator->new; # default
print __"Hello World\n";
=head1 DESCRIPTION
@@ -37,7 +38,7 @@ language packs are not installed.
=over 4
-=item Log::Report::Translator-E<gt>B<new>(OPTIONS)
+=item Log::Report::Translator-E<gt>B<new>(%options)
-Option --Default
charset <from locale>
@@ -93,15 +94,15 @@ translation files may be located.
=over 4
-=item $obj-E<gt>B<load>(DOMAIN, LOCALE)
+=item $obj-E<gt>B<load>($domain, $locale)
-Load the translation information in the text DOMAIN for the indicated 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])
+=item $obj-E<gt>B<translate>( $message, [$language, $ctxt] )
-Returns the translation of the MESSAGE, a C<Log::Report::Message> object,
+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
@@ -111,12 +112,12 @@ message object, for performance reasons.
=head1 SEE ALSO
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
=head1 LICENSE
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -1,128 +0,0 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
-# For other contributors see ChangeLog.
-# See the manual pages for details on the licensing terms.
-# Pod stripped from pm file by OODoc 2.01.
-
-use warnings;
-use strict;
-
-package Log::Report::Util;
-use vars '$VERSION';
-$VERSION = '0.994';
-
-use base 'Exporter';
-
-our @EXPORT = qw/@reasons %reason_code
- parse_locale expand_reasons escape_chars unescape_chars/;
-
-use Log::Report 'log-report';
-
-# 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 @user = qw/MISTAKE ERROR/;
-my @program = qw/TRACE ASSERT INFO NOTICE WARNING PANIC/;
-my @system = qw/FAULT ALERT FAILURE/;
-
-
-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)
- };
-}
-
-
-sub expand_reasons($)
-{ my $reasons = shift;
- my %r;
- foreach my $r (split m/\,/, $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($r eq 'USER') { $r{$reason_code{$_}}++ for @user }
- elsif($r eq 'PROGRAM') { $r{$reason_code{$_}}++ for @program }
- elsif($r eq 'SYSTEM') { $r{$reason_code{$_}}++ for @system }
- elsif($r eq 'ALL') { $r{$reason_code{$_}}++ for @reasons }
- else
- { error __x"unknown reason {which} in '{reasons}'"
- , which => $r, reasons => $reasons;
- }
- }
- (undef, @reasons)[sort {$a <=> $b} keys %r];
-}
-
-
-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"\\])/$escape{$1} || '?'/ge;
- $str;
-}
-
-sub unescape_chars($)
-{ my $str = shift;
- $str =~ s/(\\.)/$unescape{$1} || $1/ge;
- $str;
-}
-
-1;
@@ -1,93 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-Log::Report::Util - helpful routines to Log::Report
-
-=head1 INHERITANCE
-
- Log::Report::Util
- is a Exporter
-
-=head1 DESCRIPTION
-
-This module collects a few functions and definitions which are
-shared between different components in the L<Log::Report|Log::Report>
-infrastructure.
-
-=head1 FUNCTIONS
-
-=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<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]
- BLOCK = '-' TO | FROM '-' TO | ONE | SOURCE
- FROM,TO,ONE = 'TRACE' | 'ASSERT' | ,,, | 'PANIC'
- SOURCE = 'USER' | 'PROGRAM' | 'SYSTEM' | 'ALL'
-
-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
- -INFO # == TRACE-INFO
- ALERT- # == ALERT,FAILURE,PANIC
- USER # == MISTAKE,ERROR
- ALL # == TRACE-PANIC
-
-=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<unescape_chars>(STRING)
-
-Replace all backslash-something escapes by their escape character.
-For instance, backslash-t is replaced by a tab character.
-
-=back
-
-=head1 SYNOPSYS
-
- my ($language, $territory, $charset, $modifier)
- = parse_locale 'nl_BE.utf-8@home';
-
- my @take = expand_reasons 'INFO-ERROR,PANIC';
-
-=head1 SEE ALSO
-
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
-
-=head1 LICENSE
-
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
@@ -1,389 +0,0 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
-# For other contributors see ChangeLog.
-# See the manual pages for details on the licensing terms.
-# Pod stripped from pm file by OODoc 2.01.
-use warnings;
-use strict;
-
-package Log::Report::Win32Locale;
-use vars '$VERSION';
-$VERSION = '0.994';
-
-use base 'Exporter';
-
-our @EXPORT = qw/codepage_to_iso iso_to_codepage
- iso_locale charset_encoding
- ms_codepage_id ms_install_codepage_id ms_locale/;
-
-use Win32::TieRegistry;
-
-my %codepage2iso;
-my %localewin2iso;
-my %charsetwin;
-while(<DATA>)
-{ my ($codepage, $iso, $localewin, $charsetwin, $name) = split /\,\s*/, $_, 5;
- defined $name or die "Missing field in '$_'";
- $codepage2iso{hex $codepage} = $iso;
- $localewin2iso{$localewin} = $iso;
- $charsetwin{$localewin} = $charsetwin;
-}
-my %iso2codepage = reverse %codepage2iso;
-close DATA;
-
-
-sub codepage_to_iso($)
-{ my $cp = shift;
- defined $cp ? $codepage2iso{$cp =~ m/^0x/i ? hex($cp) : $cp} : ();
-}
-
-
-sub iso_to_codepage($)
-{ my $iso = shift;
- return $iso2codepage{$iso}
- if $iso2codepage{$iso};
-
- my ($lang) = split $iso, /\_/;
- $iso2codepage{$lang};
-}
-
-
-sub iso_locale(;$)
-{ my $locale = shift;
- if(defined $locale)
- { my $iso = $localewin2iso{$locale} || $codepage2iso{$locale};
- return $iso if $iso;
- }
-
- codepage_to_iso(ms_codepage_id())
- || codepage_to_iso(ms_locale());
-}
-
-# the following functions are rewrites of Win32::Codepage version 1.00
-# Copyright 2005 Clotho Advanced Media, Inc. Under perl license.
-# Win32 does not nicely export the functions.
-
-my $nls = 'HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Nls';
-my $del = {Access => Win32::TieRegistry::KEY_READ(), Delimiter => '/'};
-my $codepages = Win32::TieRegistry->new("$nls/CodePage", $del);
-my $languages = Win32::TieRegistry->new("$nls/Language", $del);
-
-
-sub charset_encoding
-{ my $charset = $codepages->GetValue("ACP") || $codepages->GetValue("OEMCP");
- $charset && $charset =~ m/^[0-9a-fA-F]+$/ ? "cp".lc($charset) : undef;
-}
-
-
-sub ms_codepage_id
-{ my $id = $languages->GetValue("Default");
- $id && $id =~ m/^[0-9a-fA-F]+$/ ? hex($id) : undef;
-}
-
-
-sub ms_install_codepage_id
-{ my $id = $languages->GetValue("InstallLanguage");
- $id && $id =~ m/^[0-9a-fA-F]+$/ ? hex($id) : undef;
-}
-
-# the following functions are rewrites of Win32::Locale version 0.04
-# Copyright (c) 2001,2003 Sean M. Burke, Under perl license.
-# The module seems unmaintained, and treating the 'region' in the ISO
-# code as lower-case is a mistake.
-
-my $i18n = Win32::TieRegistry->new
- ("HKEY_CURRENT_USER/Control Panel/International", $del);
-
-
-sub ms_locale
-{ my $locale = $i18n->GetValue("Locale");
- $locale =~ m/^[0-9a-fA-F]+$/ ? hex($locale) : undef;
-}
-
-1;
-
-# taken from http://www.microsoft.com/globaldev/nlsweb on 2007/10/22
-# merged with http://docs.moodle.org/en/Table_of_locales
-# columns: codepage,ISO,localewin,localewincharset,language name
-
-# use a wide terminal and tabstop=8
-# After changes, sort with :.,$!sort -t, -k2,2
-__DATA__
-0x0036, af, , , Afrikaans
-0x0436, af_ZA, Afrikaans_South Africa.1252, WINDOWS-1252, Afrikaans (South Africa)
-0x045E, am_ET, , , Amharic (Ethiopia)
-0x0001, ar, , , Arabic
-0x3801, ar_AE, , , Arabic (U.A.E.)
-0x3C01, ar_BH, , , Arabic (Bahrain)
-0x1401, ar_DZ, , , Arabic (Algeria)
-0x0C01, ar_EG, , , Arabic (Egypt)
-0x0801, ar_IQ, , , Arabic (Iraq)
-0x2C01, ar_JO, , , Arabic (Jordan)
-0x3401, ar_KW, , , Arabic (Kuwait)
-0x3001, ar_LB, , , Arabic (Lebanon)
-0x1001, ar_LY, , , Arabic (Libya)
-0x1801, ar_MA, , , Arabic (Morocco)
-0x047A, arn_CL, , , Mapudungun (Chile)
-0x2001, ar_OM, , , Arabic (Oman)
-0x4001, ar_QA, , , Arabic (Qatar)
-0x0401, ar_SA, Arabic_Saudi Arabia.1256, WINDOWS-1256, Arabic (Saudi Arabia)
-0x2801, ar_SY, , , Arabic (Syria)
-0x1C01, ar_TN, , , Arabic (Tunisia)
-0x2401, ar_YE, , , Arabic (Yemen)
-0x044D, as_IN, , , Assamese (India)
-0x002C, az, , , Azeri
-0x082C, az_Cyrl_AZ, , , Azeri (Cyrillic, Azerbaijan)
-0x042C, az_Latn_AZ, , , Azeri (Latin, Azerbaijan)
-0x046D, ba_RU, , , Bashkir (Russia)
-0x0023, be, , , Belarusian
-0x0423, be_BY, Belarusian_Belarus.1251, WINDOWS-1251, Belarusian (Belarus)
-0x0002, bg, Bulgarian_Bulgaria.1251, WINDOWS-1251, Bulgarian
-0x0402, bg_BG, , , Bulgarian (Bulgaria)
-0x0845, bn_BD, , , Bengali (Bangladesh)
-0x0445, bn_IN, Bengali (India), , Bengali (India)
-0x0451, bo_CN, , , Tibetan (PRC)
-0x047E, br_FR, , , Breton (France)
-0x201A, bs_Cyrl_BA, , , Bosnian (Cyrillic, Bosnia and Herzegovina)
-0x141A, bs_Latn_BA, Serbian (Latin), WINDOWS-1250, Bosnian (Latin, Bosnia and Herzegovina)
-0x0003, ca, , , Catalan
-0x0403, ca_ES, Catalan_Spain.1252, WINDOWS-1252, Catalan (Catalan)
-0x0483, co_FR, , , Corsican (France)
-0x0005, cs, , , Czech
-0x0405, cs_CZ, Czech_Czech Republic.1250, WINDOWS-1250, Czech (Czech Republic)
-0x0452, cy_GB, , , Welsh (United Kingdom)
-0x0006, da, , , Danish
-0x0406, da_DK, Danish_Denmark.1252, WINDOWS-1252, Danish (Denmark)
-0x0007, de, , , German
-0x0C07, de_AT, , , German (Austria)
-0x0807, de_CH, , , German (Switzerland)
-0x0407, de_DE, German_Germany.1252, WINDOWS-1252, German (Germany)
-0x1407, de_LI, , , German (Liechtenstein)
-0x1007, de_LU, , , German (Luxembourg)
-0x0065, div, , , Divehi
-0x0465, div_MV, , , Divehi (Maldives)
-0x0008, el, , , Greek
-0x0408, el_GR, Greek_Greece.1253, WINDOWS-1253, Greek (Greece)
-0x0009, en, , , English
-0x2409, en_029, , , English (Caribbean)
-0x0C09, en_AU, English_Australia.1252, , English (Australia)
-0x2809, en_BZ, , , English (Belize)
-0x1009, en_CA, , , English (Canada)
-0x0809, en_GB, , , English (United Kingdom)
-0x1809, en_IE, , , English (Ireland)
-0x4009, en_IN, , , English (India)
-0x2009, en_JM, , , English (Jamaica)
-0x4409, en_MY, , , English (Malaysia)
-0x1409, en_NZ, , , English (New Zealand)
-0x3409, en_PH, , , English (Republic of the Philippines)
-0x4809, en_SG, , , English (Singapore)
-0x2C09, en_TT, , , English (Trinidad and Tobago)
-0x0409, en_US, , , English (United States)
-0x1C09, en_ZA, , , English (South Africa)
-0x3009, en_ZW, , , English (Zimbabwe)
-0x000A, es, , , Spanish
-0x2C0A, es_AR, , , Spanish (Argentina)
-0x400A, es_BO, , , Spanish (Bolivia)
-0x340A, es_CL, , , Spanish (Chile)
-0x240A, es_CO, , , Spanish (Colombia)
-0x140A, es_CR, , , Spanish (Costa Rica)
-0x1C0A, es_DO, , , Spanish (Dominican Republic)
-0x300A, es_EC, , , Spanish (Ecuador)
-0x0C0A, es_ES, Spanish_Spain.1252, WINDOWS-1252, Spanish (Spain)
-0x100A, es_GT, , , Spanish (Guatemala)
-0x480A, es_HN, , , Spanish (Honduras)
-0x080A, es_MX, , , Spanish (Mexico)
-0x4C0A, es_NI, , , Spanish (Nicaragua)
-0x180A, es_PA, , , Spanish (Panama)
-0x280A, es_PE, , , Spanish (Peru)
-0x500A, es_PR, , , Spanish (Puerto Rico)
-0x3C0A, es_PY, , , Spanish (Paraguay)
-0x440A, es_SV, , , Spanish (El Salvador)
-0x540A, es_US, , , Spanish (United States)
-0x380A, es_UY, , , Spanish (Uruguay)
-0x200A, es_VE, , , Spanish (Venezuela)
-0x0025, et, , , Estonian
-0x0425, et_EE, Estonian_Estonia.1257, WINDOWS-1257, Estonian (Estonia)
-0x002D, eu, , , Basque
-0x042D, eu_ES, Basque_Spain.1252, WINDOWS-1252, Basque (Basque)
-0x0029, fa, , , Persian
-0x0429, fa_IR, , , Persian
-, fa_IR, Farsi_Iran.1256, WINDOWS-1256, Farsi (Iran)
-0x000B, fi, , , Finnish
-0x040B, fi_FI, Finnish_Finland.1252, WINDOWS-1252, Finnish (Finland)
-0x0464, fil_PH, Filipino_Philippines.1252, WINDOWS-1252, Filipino (Philippines)
-0x0038, fo, , , Faroese
-0x0438, fo_FO, , , Faroese (Faroe Islands)
-0x000C, fr, , , French
-0x080C, fr_BE, , , French (Belgium)
-0x0C0C, fr_CA, , , French (Canada)
-0x100C, fr_CH, , , French (Switzerland)
-0x040C, fr_FR, French_France.1252, WINDOWS-1252, French (France)
-0x140C, fr_LU, , , French (Luxembourg)
-0x180C, fr_MC, , , French (Principality of Monaco)
-0x0462, fy_NL, , , Frisian (Netherlands)
-, ga, , WINDOWS-1252, Gaelic; Scottish Gaelic
-0x083C, ga_IE, , , Irish (Ireland)
-0x0056, gl, , , Galician
-0x0456, gl_ES, , , Galician (Galician)
-, gl_ES, Galician_Spain.1252, WINDOWS-1252, Gallego
-0x0484, gsw_FR, , , Alsatian (France)
-0x0047, gu, , , Gujarati
-0x0447, gu_IN, Gujarati_India.0, , Gujarati (India)
-0x0468, ha_Latn_NG, , , Hausa (Latin, Nigeria)
-0x000D, he, , , Hebrew
-0x040D, he_IL, Hebrew_Israel.1255, WINDOWS-1255, Hebrew (Israel)
-0x0039, hi, Hindi.65001, , Hindi
-0x0439, hi_IN, , , Hindi (India)
-0x001A, hr, , , Croatian
-0x101A, hr_BA, , , Croatian (Latin, Bosnia and Herzegovina)
-0x041A, hr_HR, Croatian_Croatia.1250, WINDOWS-1250, Croatian (Croatia)
-0x000E, hu, , , Hungarian
-0x040E, hu_HU, Hungarian_Hungary.1250, WINDOWS-1250, Hungarian (Hungary)
-0x002B, hy, , , Armenian
-0x042B, hy_AM, , , Armenian (Armenia)
-0x0021, id, , , Indonesian
-0x0421, id_ID, Indonesian_indonesia.1252, WINDOWS-1252, Indonesian (Indonesia)
-0x0470, ig_NG, , , Igbo (Nigeria)
-0x0478, ii_CN, , , Yi (PRC)
-0x000F, is, , , Icelandic
-0x040F, is_IS, Icelandic_Iceland.1252, WINDOWS-1252, Icelandic (Iceland)
-0x0010, it, , , Italian
-0x0810, it_CH, , , Italian (Switzerland)
-0x0410, it_IT, Italian_Italy.1252, WINDOWS-1252, Italian (Italy)
-0x045D, iu_Cans_CA, , , Inuktitut (Syllabics, Canada)
-0x085D, iu_Latn_CA, , , Inuktitut (Latin, Canada)
-0x0011, ja, , , Japanese
-0x0411, ja_JP, Japanese_Japan.932, CP932, Japanese (Japan)
-0x0037, ka, , , Georgian
-0x0437, ka_GE, , , Georgian (Georgia)
-, ka_GE, Georgian_Georgia.65001, , Georgian
-0x003F, kk, , , Kazakh
-0x043F, kk_KZ, , , Kazakh (Kazakhstan)
-0x046F, kl_GL, , , Greenlandic (Greenland)
-, km, Khmer.65001, , Khmer
-0x0453, km_KH, , , Khmer (Cambodia)
-0x004B, kn, , , Kannada
-0x044B, kn_IN, kn_IN.UTF-8, Kannada.65001, Kannada (India)
-0x0012, ko, , , Korean
-0x0057, kok, , , Konkani
-0x0457, kok_IN, , , Konkani (India)
-0x0412, ko_KR, Korean_Korea.949, EUC-KR, Korean (Korea)
-0x0040, ky, , , Kyrgyz
-0x0440, ky_KG, , , Kyrgyz (Kyrgyzstan)
-0x046E, lb_LU, , , Luxembourgish (Luxembourg)
-0x0454, lo_LA, Lao_Laos.UTF-8, WINDOWS-1257, Lao (Lao P.D.R.)
-0x0027, lt, , , Lithuanian
-0x0427, lt_LT, Lithuanian_Lithuania.1257, WINDOWS-1257, Lithuanian (Lithuania)
-0x0026, lv, , , Latvian
-0x0426, lv_LV, Latvian_Latvia.1257, WINDOWS-1257, Latvian (Latvia)
-0x0481, mi_NZ, Maori.1252, WINDOWS-1252, Maori (New Zealand)
-0x002F, mk, , , Macedonian
-0x042F, mk_MK, , , Macedonian (Former Yugoslav Republic of Macedonia)
-0x044C, ml_IN, Malayalam_India.x-iscii-ma, x-iscii-ma, Malayalam (India)
-0x0050, mn, , , Mongolian
-0x0450, mn_MN, Cyrillic_Mongolian.1251, , Mongolian (Cyrillic, Mongolia)
-0x0850, mn_Mong_CN, , , Mongolian (Traditional Mongolian, PRC)
-0x047C, moh_CA, , , Mohawk (Mohawk)
-0x004E, mr, , , Marathi
-0x044E, mr_IN, , , Marathi (India)
-0x003E, ms, , , Malay
-0x083E, ms_BN, , , Malay (Brunei Darussalam)
-0x043E, ms_MY, , , Malay (Malaysia)
-0x043A, mt_MT, , , Maltese (Malta)
-0x0461, ne_NP, , , Nepali (Nepal)
-0x0013, nl, , , Dutch
-0x0813, nl_BE, , , Dutch (Belgium)
-0x0413, nl_NL, Dutch_Netherlands.1252, WINDOWS-1252, Dutch (Netherlands)
-0x0814, nn_NO, Norwegian-Nynorsk_Norway.1252, WINDOWS-1252, Norwegian, Nynorsk (Norway)
-0x0014, no, , , Norwegian
-0x0414, no_NO, Norwegian_Norway.1252, WINDOWS-1252, Norwegian, Bokmål (Norway)
-0x046C, nso_ZA, , , Sesotho sa Leboa (South Africa)
-0x0482, oc_FR, , , Occitan (France)
-0x0448, or_IN, , , Oriya (India)
-0x0046, pa, , , Punjabi
-0x0446, pa_IN, , , Punjabi (India)
-0x0015, pl, , , Polish
-0x0415, pl_PL, Polish_Poland.1250, WINDOWS-1250, Polish (Poland)
-0x048C, prs_AF, , , Dari (Afghanistan)
-0x0463, ps_AF, , , Pashto (Afghanistan)
-0x0016, pt, , , Portuguese
-0x0416, pt_BR, Portuguese_Brazil.1252, WINDOWS-1252, Portuguese (Brazil)
-0x0816, pt_PT, Portuguese_Portugal.1252, WINDOWS-1252, Portuguese (Portugal)
-0x0486, qut_GT, , , K'iche (Guatemala)
-0x046B, quz_BO, , , Quechua (Bolivia)
-0x086B, quz_EC, , , Quechua (Ecuador)
-0x0C6B, quz_PE, , , Quechua (Peru)
-0x0417, rm_CH, , , Romansh (Switzerland)
-0x0018, ro, , , Romanian
-0x0418, ro_RO, Romanian_Romania.1250, WINDOWS-1250, Romanian (Romania)
-0x0019, ru, , , Russian
-0x0419, ru_RU, Russian_Russia.1251, WINDOWS-1251, Russian (Russia)
-0x0487, rw_RW, , , Kinyarwanda (Rwanda)
-0x004F, sa, , , Sanskrit
-0x0485, sah_RU, , , Yakut (Russia)
-0x044F, sa_IN, , , Sanskrit (India)
-0x0C3B, se_FI, , , Sami, Northern (Finland)
-0x043B, se_NO, , , Sami, Northern (Norway)
-0x083B, se_SE, , , Sami, Northern (Sweden)
-0x045B, si_LK, , , Sinhala (Sri Lanka)
-0x001B, sk, , , Slovak
-0x041B, sk_SK, Slovak_Slovakia.1250, WINDOWS-1250, Slovak (Slovakia)
-0x0024, sl, , , Slovenian
-0x0424, sl_SI, Slovenian_Slovenia.1250, WINDOWS-1250, Slovenian (Slovenia)
-0x183B, sma_NO, , , Sami, Southern (Norway)
-0x1C3B, sma_SE, , , Sami, Southern (Sweden)
-0x103B, smj_NO, , , Sami, Lule (Norway)
-0x143B, smj_SE, , , Sami, Lule (Sweden)
-0x243B, smn_FI, , , Sami, Inari (Finland)
-0x203B, sms_FI, , , Sami, Skolt (Finland)
-, so_SO, , , Somali (Somalia)
-0x001C, sq, , , Albanian
-0x041C, sq_AL, Albanian_Albania.1250, WINDOWS-1250, Albanian (Albania)
-0x7C1A, sr, , , Serbian
-0x1C1A, sr_Cyrl_BA,Serbian (Cyrillic)_Serbia and Montenegro.1251,WINDOWS-1251,Serbian (Cyrillic, Bosnia and Herzegovina)
-0x0C1A, sr_Cyrl_SP, , , Serbian (Cyrillic, Serbia)
-0x181A, sr_Latn_BA, , , Serbian (Latin, Bosnia and Herzegovina)
-0x081A, sr_Latn_SP, , , Serbian (Latin, Serbia)
-0x001D, sv, , , Swedish
-0x081D, sv_FI, , , Swedish (Finland)
-0x041D, sv_SE, Swedish_Sweden.1252, WINDOWS-1252, Swedish (Sweden)
-0x0041, sw, , , Kiswahili
-0x0441, sw_KE, , , Kiswahili (Kenya)
-0x005A, syr, , , Syriac
-0x045A, syr_SY, , , Syriac (Syria)
-0x0049, ta, , , Tamil
-0x0449, ta_IN, , , Tamil (India)
-0x004A, te, , , Telugu
-0x044A, te_IN, , , Telugu (India)
-0x0428, tg_Cyrl_TJ, , , Tajik (Cyrillic, Tajikistan)
-0x001E, th, , , Thai
-0x041E, th_TH, Thai_Thailand.874, WINDOWS-874, Thai (Thailand)
-0x0442, tk_TM, , , Turkmen (Turkmenistan)
-0x085F, tmz_Latn_DZ, , , Tamazight (Latin, Algeria)
-0x0432, tn_ZA, , , Setswana (South Africa)
-0x001F, tr, , , Turkish
-0x041F, tr_TR, Turkish_Turkey.1254, WINDOWS-1254, Turkish (Turkey)
-0x0044, tt, , , Tatar
-0x0444, tt_RU, , , Tatar (Russia)
-0x0480, ug_CN, , , Uighur (PRC)
-0x0022, uk, , , Ukrainian
-0x0422, uk_UA, Ukrainian_Ukraine.1251, WINDOWS-1251, Ukrainian (Ukraine)
-0x0020, ur, , , Urdu
-0x0420, ur_PK, , , Urdu (Islamic Republic of Pakistan)
-0x0043, uz, , , Uzbek
-0x0843, uz_Cyrl_UZ, , , Uzbek (Cyrillic, Uzbekistan)
-0x0443, uz_Latn_UZ, , , Uzbek (Latin, Uzbekistan)
-0x002A, vi, , , Vietnamese
-0x042A, vi_VN, Vietnamese_Viet Nam.1258, WINDOWS-1258, Vietnamese (Vietnam)
-0x082E, wee_DE, , , Lower Sorbian (Germany)
-0x042E, wen_DE, , , Upper Sorbian (Germany)
-0x0488, wo_SN, , , Wolof (Senegal)
-0x0434, xh_ZA, , , isiXhosa (South Africa)
-0x046A, yo_NG, , , Yoruba (Nigeria)
-0x0804, zh_CN, Chinese_China.936, CP936, Chinese (People's Republic of China)
-0x0004, zh_Hans,, , Chinese (Simplified)
-0x7C04, zh_Hant,, , Chinese (Traditional)
-0x0C04, zh_HK, , , Chinese (Hong Kong S.A.R.)
-0x1404, zh_MO, , , Chinese (Macao S.A.R.)
-0x1004, zh_SG, , , Chinese (Singapore)
-0x0404, zh_TW, Chinese_Taiwan.950, CP950, Chinese (Taiwan)
-0x0435, zu_ZA, , , siZulu (South Africa)
@@ -1,91 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-Log::Report::Win32Locale - unix/windows locales
-
-=head1 INHERITANCE
-
- Log::Report::Win32Locale
- is a Exporter
-
-=head1 DESCRIPTION
-
-Windows uses different locales to represent languages: codepages. Programs
-which are written with Log::Report however, will contain ISO encoded
-language names; this module translates between them.
-
-The algorithms in this module are based on Win32::Locale and Win32::Codepage.
-
-=head1 FUNCTIONS
-
-=over 4
-
-=item B<charset_encoding>()
-
-Returns the encoding name (usable with module Encode) based on the current
-codepage. For example, C<cp1252> for iso-8859-1 (latin-1) or C<cp932> for
-Shift-JIS Japanese. Returns undef if the encoding cannot be identified.
-
-=item B<codepage_to_iso>(CODEPAGE)
-
-Translate windows CODEPAGE into ISO code. The CODEPAGE is numeric
-or a hex string like '0x0304'.
-
-=item B<iso_locale>([CODEPAGE])
-
-Returns the ISO string for the Microsoft codepage locale. Might return
-C<undef>/false. By default, the actual codepage is used.
-
-=item B<iso_to_codepage>(ISO)
-
-Returns the numeric value of the codepage. The ISO may look like
-this: C<xx_YY>. Then, first the C<xx_YY> is looked-up. If that does
-not exist, C<xx> is tried.
-
-=item B<ms_codepage_id>()
-
-Returns the numeric language ID for the current codepage language.
-For example, the numeric value for C<0x0409> for C<en-US>, and C<0x0411>
-for C<ja>. Returns false if the codepage cannot be identified.
-
-=item B<ms_install_codepage_id>()
-
-Returns the numeric language ID for the installed codepage language.
-This is like L<ms_codepage_id()|Log::Report::Win32Locale/"FUNCTIONS">, but refers to the codepage that was
-the default when Windows was first installed.
-
-=item B<ms_locale>()
-
-Returns the locale setting from the control panel.
-
-=back
-
-=head1 SYNOPSYS
-
- # Only usable on Windows
- print codepage_to_iso(0x0413); # nl-NL
- print iso_to_codepage('nl_NL'); # 1043
- printf "%x", iso_to_codepage('nl_NL'); # 413
-
- my $iso = iso_locale(ms_codepage_id());
- my $iso = iso_locale; # same
-
- print charset_encoding; # cp1252
- print ms_codepage_id; # 1043
- print ms_install_codepage_id; # 1043
- print ms_locale; # Dutch (Netherlands)
-
-=head1 SEE ALSO
-
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
-
-=head1 LICENSE
-
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
@@ -1,4 +1,4 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
@@ -7,92 +7,94 @@ use warnings;
use strict;
package Log::Report;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
use base 'Exporter';
-use List::Util qw/first/;
+use List::Util qw/first/;
+use Scalar::Util qw/blessed/;
-# domain 'log-report' via work-arounds:
-# Log::Report cannot do "use Log::Report"
+use Log::Report::Util;
+### 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/;
+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);
-require Log::Report::Util;
-require Log::Report::Message;
-require Log::Report::Dispatcher;
-require Log::Report::Dispatcher::Try;
-
-# See section Run modes
-my %is_reason = map {($_=>1)} @Log::Report::Util::reasons;
-my %is_fatal = map {($_=>1)} qw/ERROR FAULT FAILURE PANIC/;
-my %use_errno = map {($_=>1)} qw/FAULT ALERT FAILURE/;
-
-sub _whats_needed(); sub dispatcher($@);
+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(@);
-require Log::Report::Translator::POT;
-
-my $reporter;
-my %domain_start;
-my %settings;
-my $default_mode = 0;
-
#
# Some initiations
#
-__PACKAGE__->_setting('log-report', translator =>
- Log::Report::Translator::POT->new(charset => 'utf-8'));
+my $reporter = {};
+my $default_mode = 0;
+my @nested_tries;
-__PACKAGE__->_setting('rescue', translator => Log::Report::Translator->new);
+# we can only load these after Log::Report has compiled, because
+# the use this module themselves.
-dispatcher PERL => 'default', accept => 'NOTICE-';
+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;
+#eval "require Log::Report::Translator::POT"; panic $@ if $@;
+#, translator => Log::Report::Translator::POT->new(charset => 'utf-8');
+textdomain 'log-report';
+
+dispatcher PERL => 'default', accept => 'NOTICE-';
-# $^S = $EXCEPTIONS_BEING_CAUGHT; parse: undef, eval: 1, else 0
sub report($@)
-{ my $opts = ref $_[0] eq 'HASH' ? +{ %{ (shift) } } : {};
+{ my $opts = ref $_[0] eq 'HASH' ? +{ %{ (shift) } } : {};
my $reason = shift;
- my $stop = exists $opts->{is_fatal} ? $opts->{is_fatal} :$is_fatal{$reason};
+ my $stop = exists $opts->{is_fatal} ? $opts->{is_fatal} : is_fatal $reason;
+
+ my $try = $nested_tries[-1];
+ my @disp = ($stop && $try) ? () : @{$reporter->{needs}{$reason} || []};
+ push @disp, $try if defined $try && $try->needs($reason);
# return when no-one needs it: skip unused trace() fast!
- my $disp = $reporter->{needs}{$reason};
- $disp || $stop or return;
+ @disp || $stop or return;
- $is_reason{$reason}
+ 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};
+ if use_errno($reason) && !defined $opts->{errno};
if(my $to = delete $opts->{to})
{ # explicit destination, still disp may not need it.
if(ref $to eq 'ARRAY')
- { my %disp = map {$_->name => $_} @$disp;
- $disp = [ grep defined, @disp{@$to} ];
+ { my %disp = map +($_->name => $_), @disp;
+ @disp = grep defined, @disp{@$to};
}
else
- { $disp = [ grep $_->name eq $to, @$disp ];
+ { @disp = grep $_->name eq $to, @disp;
}
- @$disp || $stop
+ @disp || $stop
or return;
}
+ my $message = shift;
+
+ 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 $message = shift;
my $exception;
if(UNIVERSAL::isa($message, 'Log::Report::Message'))
{ @_==0 or error __x"a message object is reported with more parameters";
@@ -108,43 +110,44 @@ sub report($@)
}
if(my $to = $message->to)
- { $disp = [ grep $_->name eq $to, @$disp ];
- @$disp or return;
+ { @disp = grep $_->name eq $to, @disp;
+ @disp or return;
}
- my @last_call; # call Perl dispatcher always last
- if($reporter->{filters})
+ my @last_call; # call Perl dispatcher always last, it calls real die
+ my $domain = $message->domain;
+ if(my $filters = $reporter->{filters})
{
DISPATCHER:
- foreach my $d (@$disp)
+ foreach my $d (@disp)
{ my ($r, $m) = ($reason, $message);
- foreach my $filter ( @{$reporter->{filters}} )
+ foreach my $filter (@$filters)
{ next if keys %{$filter->[1]} && !$filter->[1]{$d->name};
- ($r, $m) = $filter->[0]->($d, $opts, $r, $m);
+ ($r, $m) = $filter->[0]->($d, $opts, $r, $m, $domain);
$r or next DISPATCHER;
}
if($d->isa('Log::Report::Dispatcher::Perl'))
- { @last_call = ($d, { %$opts }, $r, $m) }
- else { $d->log($opts, $r, $m) }
+ { @last_call = ($d, { %$opts }, $r, $m, $domain) }
+ else { $d->log($opts, $r, $m, $domain) }
}
}
else
- { foreach my $d (@$disp)
+ { foreach my $d (@disp)
{ if($d->isa('Log::Report::Dispatcher::Perl'))
- { @last_call = ($d, { %$opts }, $reason, $message) }
- else { $d->log($opts, $reason, $message) }
+ { @last_call = ($d, { %$opts }, $reason, $message, $domain) }
+ else { $d->log($opts, $reason, $message, $domain) }
}
}
- if(@last_call)
+ if(@last_call && !$^S)
{ # the PERL dispatcher may terminate the program
shift(@last_call)->log(@last_call);
}
if($stop)
- { # ^S = EXCEPTIONS_BEING_CAUGHT, within eval or try
- $^S or exit($opts->{errno} || 0);
+ { # $^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
@@ -152,7 +155,7 @@ sub report($@)
die; # $@->PROPAGATE() will be called, some eval will catch this
}
- @$disp;
+ @disp;
}
@@ -173,12 +176,14 @@ sub dispatcher($@)
if($command eq 'list')
{ mistake __"the 'list' sub-command doesn't expect additional parameters"
if @_;
- return values %{$reporter->{dispatchers}};
+ my @disp = values %{$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};
+ unless is_reason $reason;
my $disp = $reporter->{needs}{$reason};
return $disp ? @$disp : ();
}
@@ -242,26 +247,26 @@ sub try(&@)
and report {location => [caller 0]}, PANIC =>
__x"odd length parameter list for try(): forgot the terminating ';'?";
- local $reporter->{dispatchers} = undef;
- local $reporter->{needs};
-
- my $disp = dispatcher TRY => 'try', @_;
+ my $disp = Log::Report::Dispatcher::Try->new(TRY => 'try', @_);
+ push @nested_tries, $disp;
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 = $@;
- if( $err
- && !$disp->wasFatal
- && !UNIVERSAL::isa($err, 'Log::Report::Exception'))
- { eval "require Log::Report::Die"; panic $@ if $@;
- ($err, my($opts, $reason, $text)) = Log::Report::Die::die_decode($err);
+ my $err = $@;
+ pop @nested_tries;
+
+ my $is_exception = blessed $err && $err->isa('Log::Report::Exception');
+ if($err && !$is_exception && !$disp->wasFatal)
+ { ($err, my($opts, $reason, $text)) = Log::Report::Die::die_decode($err);
$disp->log($opts, $reason, __$text);
}
- $disp->died($err);
+ $disp->died($err)
+ if $err && ($is_exception ? $err->isFatal : 1);
+
$@ = $disp;
wantarray ? @ret : $ret;
@@ -281,12 +286,7 @@ sub failure(@) {report FAILURE => @_}
sub panic(@) {report PANIC => @_}
-sub _default_domain(@)
-{ my $f = $domain_start{$_[1]} or return undef;
- my $domain;
- do { $domain = $_->[1] if $_->[0] < $_[2] } for @$f;
- $domain;
-}
+sub _default_domain(@) { pkg2domain $_[0] }
sub __($)
{ Log::Report::Message->new
@@ -301,10 +301,12 @@ sub __x($@)
{ @_%2 or error __x"even length parameter list for __x at {where}",
where => join(' line ', (caller)[1,2]);
+ my $msgid = shift;
Log::Report::Message->new
- ( _msgid => @_
+ ( _msgid => $msgid
, _expand => 1
, _domain => _default_domain(caller)
+ , @_
);
}
@@ -359,102 +361,102 @@ sub N__w(@) {split " ", $_[0]}
sub import(@)
{ my $class = shift;
- my $textdomain = @_%2 ? shift : undef;
- my %opts = @_;
- my $syntax = delete $opts{syntax} || 'SHORT';
- my ($pkg, $fn, $linenr) = caller;
-
- if(my $trans = delete $opts{translator})
- { $class->translator($textdomain, $trans, $pkg, $fn, $linenr);
+ if($INC{'Log/Report/Minimal.pm'})
+ { my ($pkg, $fn, $line) = caller; # do not report on LR:: modules
+ if(index($pkg, 'Log::Report::') != 0)
+ { my @pkgs = Log::Report::Optional->usedBy;
+ die "Log::Report loaded too late in $fn line $line, "
+ . "put in $pkg before ", (join ',', @pkgs) if @pkgs;
+ }
}
- if(my $native = delete $opts{native_language})
- { my ($lang) = parse_locale $native;
+ my $to_level = ($_[0] && $_[0] =~ m/^\+\d+$/ ? shift : undef) || 0;
+ my $textdomain = @_%2 ? shift : undef;
+ my %opts = @_;
- error "the specified native_language '{locale}' is not a valid locale"
- , locale => $native unless defined $lang;
+ my ($pkg, $fn, $linenr) = caller $to_level;
+ my $domain;
- $class->_setting($textdomain, native_language => $native
- , $pkg, $fn, $linenr);
+ 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';
}
- push @{$domain_start{$fn}}, [$linenr => $textdomain];
-
- my @export = (@functions, @make_msg);
-
- if($syntax eq 'SHORT')
- { push @export, @reason_functions
+ my @export;
+ if(my $in = delete $opts{import})
+ { push @export, ref $in eq 'ARRAY' ? @$in : $in;
}
- elsif($syntax ne 'REPORT' && $syntax ne 'LONG')
- { error __x"syntax flag must be either SHORT or REPORT, not `{syntax}'"
- , syntax => $syntax;
+ 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;
+ }
}
- $class->export_to_level(1, undef, @export);
-}
+ $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($;$$$$)
-{ my ($class, $domain) = (shift, shift);
+{ # replaced by (textdomain $domain)->configure
- @_ or return $class->_setting($domain => 'translator')
- || $class->_setting(rescue => 'translator');
+ my ($class, $name) = (shift, shift);
+ my $domain = textdomain $name
+ or error __x"textdomain `{domain}' for translator not defined"
+ , domain => $name;
- defined $domain
- or error __"textdomain for translator not defined";
+ @_ 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 __"translator must be a Log::Report::Translator object";
+ or error __x"translator must be a {pkg} object for {domain}"
+ , pkg => 'Log::Report::Translator', domain => $name;
- $class->_setting($domain, translator => $translator, $pkg, $fn, $line);
+ $domain->configure(translator => $translator, where => [$pkg, $fn, $line]);
}
-# c_method setting TEXTDOMAIN, NAME, [VALUE]
-# When a VALUE is provided (of unknown structure) then it is stored for the
-# NAME related to TEXTDOMAIN. Otherwise, the value related to the NAME is
-# returned. The VALUEs may only be set once in your program, and count for
-# all packages in the same TEXTDOMAIN.
-
-sub _setting($$;$)
-{ my ($class, $domain, $name, $value) = splice @_, 0, 4;
- $domain ||= 'rescue';
-
- defined $value
- or return $settings{$domain}{$name};
- # Where is the setting done?
- my ($pkg, $fn, $line) = @_;
- ($pkg, $fn, $line) = caller # direct call, not via import
- unless defined $pkg;
-
- my $s = $settings{$domain} ||= {_pkg => $pkg, _fn => $fn, _line => $line};
-
- error __x"only one package can contain configuration; for {domain} already in {pkg} in file {fn} line {line}"
- , domain => $domain, pkg => $s->{_pkg}
- , fn => $s->{_fn}, line => $s->{_line}
- if $s->{_pkg} ne $pkg || $s->{_fn} ne $fn;
+sub textdomain(@)
+{ # used for testing
+ return delete $reporter->{textdomains}{$_[0]}
+ if @_==2 && $_[1] eq 'DELETE';
- error __x"value for {name} specified twice", name => $name
- if exists $s->{$name};
+ my $name = (@_%2 ? shift : _default_domain(caller)) || 'default';
+ my $domain = $reporter->{textdomains}{$name}
+ ||= Log::Report::Domain->new(name => $name);
- $s->{$name} = $value;
+ $domain->configure(@_, where => [caller]) if @_;
+ $domain;
}
-sub isValidReason($) { $is_reason{$_[1]} }
-sub isFatal($) { $is_fatal{$_[1]} }
-
-
sub needs(@)
{ my $thing = shift;
my $self = ref $thing ? $thing : $reporter;
@@ -11,94 +11,97 @@ Log::Report - report a problem, with exceptions and translation support
=head1 SYNOPSIS
- # Invocation with mode helps debugging
+ # Invocation with 'mode' to get trace and verbose messages
use Log::Report mode => 'DEBUG';
- error "oops"; # like die(), no translation
- -f $config or panic "Help!"; # alert/error/fault/info/...more
+ # Usually invoked with a domain, which groups packages
+ use Log::Report 'my-domain', %options;
- # Provide a name-space to use translation tables. Like Locale::TextDomain
- use Log::Report 'my-domain';
- error __x"Help!"; # __x() handles translation
- print __x"my name is {name}", name => $fullname;
+ # Interpolation syntax via String::Print
+ # First step to translations, once you need it.
+ print __x"my name is {name}", name => $n; # print, so no exception
+ print __"Hello World\n"; # (optional) translation, no interpolation
print __x'Hello World'; # SYNTAX ERROR!! ' is alternative for ::
- # Many destinations for message in parallel possible.
- dispatcher PERL => 'default' # See Log::Report::Dispatcher: use die/warn
- , reasons => 'NOTICE-'; # this disp. is already present at start
-
- dispatcher SYSLOG => 'syslog'# also send to syslog
- , charset => 'iso-8859-1' # explicit character conversions
- , locale => 'en_US'; # overrule user's locale
-
- dispatcher close => 'PERL'; # stop dispatching to die/warn
+ # Functions replacing die/warn/carp, casting exceptions.
+ error "oops"; # exception like die(), no translation
+ -f $config or panic "Help!"; # alert/error/fault/info/...more
- # Produce an error, long syntax (rarely used)
- report ERROR => __x('gettext string', param => $param, ...)
+ # Combined exception, interpolation, and optional translation
+ error __x"Help!"; # __x() creates ::Message object
+ error __x('gettext msgid', param => $value, ...)
if $condition;
- # When syntax=SHORT (default since 0.26)
- error __x('gettext string', param => $param, ...)
- if $condition;
+ # Also non fatal "exceptions" find their way to dispatchers
+ info __x"started {pid}", pid => $$; # translatable
+ debug "$i was here!"; # you probably do not want to translate debug
+ panic "arrghhh"; # like Carp::Confess
+
+ # Many destinations for an exception message (may exist in parallel)
+ dispatcher PERL => 'default' # see Log::Report::Dispatcher: use die/warn
+ , reasons => 'NOTICE-'; # this dispatcher is already present at start
- # Overrule standard behavior for single message with HASH as
- # first parameter. Only long syntax
- use Errno qw/ENOMEM/;
- use Log::Report syntax => 'REPORT';
- report {to => 'syslog', errno => ENOMEM}
- , FAULT => __x"cannot allocate {size} bytes", size => $size;
+ dispatcher SYSLOG => 'syslog'# also send to syslog
+ , charset => 'iso-8859-1' # explicit character conversions
+ , locale => 'en_US'; # overrule user's locale
- # Avoid messages without report level for daemons
- print __"Hello World", "\n"; # only translation, no exception
+ dispatcher close => 'default'; # stop default die/warn dispatcher
- # fill-in values, like Locale::TextDomain and gettext
+ # Fill-in values, like Locale::TextDomain and gettext
# See Log::Report::Message section DETAILS
- fault __x "cannot allocate {size} bytes", size => $size;
- fault "cannot allocate $size bytes"; # no translation
- fault __x "cannot allocate $size bytes"; # wrong, not static
+ fault __x"cannot allocate {size} bytes", size => $size;
+ fault "cannot allocate $size bytes"; # no translation, ok
+ fault __x"cannot allocate $size bytes"; # not translatable, wrong
+
+ # Translation depending on count
+ # Leading and trailing whitespace stay magically outside translation
+ # tables. @files in scalar context. Special parameter with _
+ print __xn"found one file\n", "found {_count} files", @files;
- # translation depends on count.
- print __xn("found one file", "found {_count} files", @files), "\n";
+ # Borrow from an other text-domain (see Log::Report::Message)
+ print __x(+"errors in {line}", _domain => 'global', line => $line);
# catch errors (implements hidden eval/die)
try { error };
if($@) {...} # $@ isa Log::Report::Dispatcher::Try
+ if(my $exception = $@->wasFatal) # ::Exception object
- # Language translations at the IO/layer
+ # Language translations at the output component
+ # Translation management via Log::Report::Lexicon
use POSIX::1003::Locale qw/setlocale LC_ALL/;
setlocale(LC_ALL, 'nl_NL');
info __"Hello World!"; # in Dutch, if translation table found
# Exception classes, see Log::Report::Exception
- my $msg = __x"something", _class => 'parsing,schema';
- if($msg->inClass('parsing')) ...
+ try { error __x"something", _class => 'parsing,schema' };
+ if($@->wasFatal->inClass('parsing')) ...
=head1 DESCRIPTION
Handling messages directed to users can be a hassle, certainly when the
-same software is used for command-line and in a graphical interfaces (you
-may not now how it is used), or has to cope with internationalization;
-this modules tries to simplify this.
+same software is used for command-line and in a graphical interfaces
+(you may not now how it is used, writing an abstract module), or has to
+cope with internationalization; this modules tries to simplify this.
-Log::Report combines
+C<Log::Report> combines
=over 4
=item . exceptions (like error and info), with
-=item . logging (like Log::Log4Perl and syslog), and
+=item . logging (like L<Log::Log4Perl> and syslog), and
-=item . translations (like gettext and Locale::TextDomain)
+=item . translations (like C<gettext> and L<Locale::TextDomain>)
=back
-You do not need to use it for all three reasons: pick what you need
-now, maybe extend the usage later. Read more about how and why in the
-L</DETAILS> section, below. Especially, you should B<read about the
-REASON parameter>.
+You B<do not need> to use this module for all three reasons: pick what
+you need now, maybe extend the usage later. Read more about how and
+why in the L</DETAILS> section, below. Especially, you should B<read
+about the REASON parameter>.
Also, you can study this module swiftly via the article published in
-the German Perl $foo-magazine. English version:
+the German Perl C<$foo-magazine>. English version:
F<http://perl.overmeer.net/log-report/papers/201306-PerlMagazine-article-en.html>
=head1 FUNCTIONS
@@ -107,11 +110,11 @@ F<http://perl.overmeer.net/log-report/papers/201306-PerlMagazine-article-en.html
=over 4
-=item B<dispatcher>((TYPE, NAME, OPTIONS)|(COMMAND => NAME, [NAMEs]))
+=item B<dispatcher>( <$type, $name, %options>|<$command, @names> )
The C<dispatcher> function controls access to dispatchers: the back-ends
which process messages, do the logging. Dispatchers are global entities,
-addressed by a symbolic NAME. Please read L<Log::Report::Dispatcher|Log::Report::Dispatcher> as
+addressed by a symbolic $name. Please read L<Log::Report::Dispatcher|Log::Report::Dispatcher> as
well.
The C<Log::Report> suite has its own dispatcher TYPES, but also connects
@@ -119,19 +122,19 @@ to external dispatching frameworks. Each need some (minor) conversions,
especially with respect to translation of REASONS of the reports
into log-levels as the back-end understands.
-The OPTIONS are a mixture of parameters needed for the
+The %options are a mixture of parameters needed for the
Log::Report dispatcher wrapper and the settings of the back-end.
See L<Log::Report::Dispatcher|Log::Report::Dispatcher>, the documentation for the back-end
specific wrappers, and the back-ends for more details.
Implemented COMMANDs are C<close>, C<find>, C<list>, C<disable>,
C<enable>, C<mode>, C<filter>, and C<needs>. Most commands are followed
-by a LIST of dispatcher NAMEs to be address. For C<mode> see section
+by a LIST of dispatcher @names to be addressed. For C<mode> see section
L</Run modes>; it requires a MODE argument before the LIST of NAMEs.
Non-existing names will be ignored. When C<ALL> is specified, then
all existing dispatchers will get addressed. For C<filter> see
L<Log::Report::Dispatcher/Filters>; it requires a CODE reference before
-the NAMEs of the dispatchers which will have the it applied (defaults to
+the @names of the dispatchers which will have the it applied (defaults to
all).
With C<needs>, you only provide a REASON: it will return the list of
@@ -164,24 +167,26 @@ example: play with dispatchers
dispatcher PERL => 'default', mode => 'DEBUG', accept => 'ALL'
if $debug;
-=item B<report>([HASH-of-OPTIONS], REASON, MESSAGE|(STRING,PARAMS),)
+=item B<report>( [%options], $reason, $message|<STRING,$params>, )
+
+The C<report> function is sending (for some $reason) a $message to be
+displayed or logged (by a `dispatcher'). This function is the core
+for L<error()|Log::Report/"Abbreviations for report()">, L<info()|Log::Report/"Abbreviations for report()"> etc functions, which are nicer names for this
+exception throwing: better use those short names.
-The 'report' function is sending (for some REASON) a MESSAGE to be
-displayed or logged by a dispatcher. This function is the core for
-use L<error()|Log::Report/"Abbreviations for report()">, L<info()|Log::Report/"Abbreviations for report()"> etc functions which are nicer names for
-this exception throwing: better use those short names.
+The $reason is a string like 'ERROR' (for function C<error()>).
+The $message is a L<Log::Report::Message|Log::Report::Message> object (which are created with
+the special translation syntax like L<__x()|Log::Report/"Language Translations">). The $message may also
+be a plain string, or an L<Log::Report::Exception|Log::Report::Exception> object. The optional
+first parameter is a HASH which can be used to influence the dispatchers.
-The REASON is a string like 'ERROR'. The MESSAGE is a
-L<Log::Report::Message|Log::Report::Message> object (which are created with the special
-translation syntax like L<__x()|Log::Report/"Language Translations">). The MESSAGE may also be a plain
-string or an L<Log::Report::Exception|Log::Report::Exception> object. The optional first
-parameter is a HASH which can be used to influence the dispatchers.
-The HASH contains any combination of the OPTIONS listed below.
+The optional %options are listed below. Quite differently from other
+functions and methods, they have to be passed in a HASH as first parameter.
-This function returns the LIST of dispatchers which accepted the MESSAGE.
-When empty, no back-end has accepted it so the MESSAGE was "lost".
-Even when no back-end need the message, it program will still exit when
-there is REASON to die.
+This function returns the LIST of dispatchers which accepted the $message.
+When empty, no back-end has accepted it so the $message was "lost".
+Even when no back-end needs the message, the program will still exit
+when there is a $reason to C<die()>.
-Option --Default
errno $! or 1
@@ -195,12 +200,12 @@ there is REASON to die.
=item errno => INTEGER
-When the REASON includes the error text (See L</Run modes>), you can
+When the $reason includes the error text (See L</Run modes>), you can
overrule the error code kept in C<$!>. In other cases, the return code
-default to C<1> (historical UNIX behavior). When the message REASON
+defaults to C<1> (historical UNIX behavior). When the message $reason
(combined with the run-mode) is severe enough to stop the program,
-this value as return code. The use of this option itself will not
-trigger an C<die()>.
+this value as return code of the program. The use of this option itself
+will not trigger an C<die()>.
=item is_fatal => BOOLEAN
@@ -226,7 +231,7 @@ it is collected via C<caller()> if needed.
=item to => NAME|ARRAY-of-NAMEs
-Sent the MESSAGE only to the NAMEd dispatchers. Ignore unknown NAMEs.
+Sent the $message only to the NAMEd dispatchers. Ignore unknown NAMEs.
Still, the dispatcher needs to be enabled and accept the REASONs.
=back
@@ -250,7 +255,7 @@ example: for use of L<report()|Log::Report/"Report Production and Configuration"
report {locale => 'pt_BR'}
, WARNING => "do this at home!";
-=item B<try>(CODE, OPTIONS)
+=item B<try>(CODE, %options)
Execute the CODE while blocking all dispatchers as long as it is running.
The exceptions which occur while running the CODE are caught until it
@@ -265,12 +270,12 @@ Run-time errors from Perl and die's, croak's and confess's within the
program (which shouldn't appear, but you never know) are collected into an
L<Log::Report::Message|Log::Report::Message> object, using L<Log::Report::Die|Log::Report::Die>.
-The OPTIONS are passed to the constructor of the try-dispatcher, see
+The %options are passed to the constructor of the try-dispatcher, see
L<Log::Report::Dispatcher::Try::new()|Log::Report::Dispatcher::Try/"Constructors">. For instance, you may like to
add C<< mode => 'DEBUG' >>, or C<< accept => 'ERROR-' >>.
B<Be warned> that the parameter to C<try> is a CODE reference. This means
-that you shall not use a comma after the block when there are OPTIONS
+that you shall not use a comma after the block when there are %options
specified. On the other hand, you shall use a semi-colon after the
block if there are no arguments.
@@ -305,49 +310,49 @@ C<report()>, which are usually not needed anyway.
=over 4
-=item B<alert>(MESSAGE)
+=item B<alert>($message)
-Short for C<< report ALERT => MESSAGE >>
+Short for C<< report ALERT => $message >>
-=item B<assert>(MESSAGE)
+=item B<assert>($message)
-Short for C<< report ASSERT => MESSAGE >>
+Short for C<< report ASSERT => $message >>
-=item B<error>(MESSAGE)
+=item B<error>($message)
-Short for C<< report ERROR => MESSAGE >>
+Short for C<< report ERROR => $message >>
-=item B<failure>(MESSAGE)
+=item B<failure>($message)
-Short for C<< report FAILURE => MESSAGE >>
+Short for C<< report FAILURE => $message >>
-=item B<fault>(MESSAGE)
+=item B<fault>($message)
-Short for C<< report FAULT => MESSAGE >>
+Short for C<< report FAULT => $message >>
-=item B<info>(MESSAGE)
+=item B<info>($message)
-Short for C<< report INFO => MESSAGE >>
+Short for C<< report INFO => $message >>
-=item B<mistake>(MESSAGE)
+=item B<mistake>($message)
-Short for C<< report MISTAKE => MESSAGE >>
+Short for C<< report MISTAKE => $message >>
-=item B<notice>(MESSAGE)
+=item B<notice>($message)
-Short for C<< report NOTICE => MESSAGE >>
+Short for C<< report NOTICE => $message >>
-=item B<panic>(MESSAGE)
+=item B<panic>($message)
-Short for C<< report PANIC => MESSAGE >>
+Short for C<< report PANIC => $message >>
-=item B<trace>(MESSAGE)
+=item B<trace>($message)
-Short for C<< report TRACE => MESSAGE >>
+Short for C<< report TRACE => $message >>
-=item B<warning>(MESSAGE)
+=item B<warning>($message)
-Short for C<< report WARNING => MESSAGE >>
+Short for C<< report WARNING => $message >>
=back
@@ -386,7 +391,7 @@ no counterpart.
=over 4
-=item B<N__>(MSGID)
+=item B<N__>($msgid)
Label to indicate that the string is a text which will be translated
later. The function itself does nothing. See also L<N__w()|Log::Report/"Language Translations">.
@@ -407,7 +412,7 @@ example: how to use N__()
# however: this will always create all Log::Report::Message objects,
# where maybe only one is used.
-=item B<N__n>(SINGLE_MSGID, PLURAL_MSGID)
+=item B<N__n>($single_msgid, $plural_msgid)
Label to indicate that the two MSGIDs are related, the first as
single, the seconds as its plural. Only used to find the text
@@ -435,16 +440,17 @@ example: of L<N__w()|Log::Report/"Language Translations">
my @colors = N__w"red green blue"; # same
print __ $colors[1];
-=item B<__>(MSGID)
+=item B<__>($msgid)
-This function (name is B<two> under-score characters) will cause the MSGID
+This function (name is B<two> under-score characters) will cause the $msgid
to be replaced by the translations when doing the actual output. Returned
is a L<Log::Report::Message|Log::Report::Message> object, which will be used in translation
later. Translating is invoked when the object gets stringified. When
-you have no translation tables, the MSGID will be shown untranslated.
+you have no translation tables, the $msgid will be shown untranslated.
-If you need options for L<Log::Report::Message::new()|Log::Report::Message/"Constructors"> then
-use L<__x()|Log::Report/"Language Translations">.
+If you need options for L<Log::Report::Message::new()|Log::Report::Message/"Constructors"> then use L<__x()|Log::Report/"Language Translations">;
+the prototype of this function does not permit parameters: it is a
+prefix operator!
example: how to use __()
@@ -458,11 +464,11 @@ example: how to use __()
print $s; # ok, translated
print $s->toString('fr'); # ok, forced into French
-=item B<__n>(MSGID, PLURAL_MSGID, COUNT, PAIRS)
+=item B<__n>($msgid, $plural_msgid, $count, PAIRS)
-It depends on the value of COUNT (and the selected language) which
+It depends on the value of $count (and the selected language) which
text will be displayed. When translations can not be performed, then
-MSGID will be used when COUNT is 1, and PLURAL_MSGSID in other cases.
+$msgid will be used when $count is 1, and PLURAL_MSGSID in other cases.
However, some languages have more complex schemes than English.
The PAIRS are options for L<Log::Report::Message::new()|Log::Report::Message/"Constructors"> and variables
@@ -484,9 +490,9 @@ example: how to use __n()
# ARRAYs and HASHes are counted
print __n "one", "more", \@r;
-=item B<__nx>(MSGID, PLURAL_MSGID, COUNT, PAIRS)
+=item B<__nx>($msgid, $plural_msgid, $count, PAIRS)
-It depends on the value of COUNT (and the selected language) which
+It depends on the value of $count (and the selected language) which
text will be displayed. See details in L<__n()|Log::Report/"Language Translations">. After translation,
the VARIABLES will be filled-in.
@@ -501,16 +507,16 @@ example: how to use __nx()
local $" = ', ';
print __nx "one file: {f}", "{_count} files: {f}", @files, f => \@files;
-=item B<__x>(MSGID, PAIRS)
+=item B<__x>($msgid, PAIRS)
-Translate the MSGID and then interpolate the VARIABLES in that string.
+Translate the $msgid and then interpolate the VARIABLES in that string.
Of course, translation and interpolation is delayed as long as possible.
Both OPTIONS and VARIABLES are key-value pairs.
The PAIRS are options for L<Log::Report::Message::new()|Log::Report::Message/"Constructors"> and variables
to be filled in.
-=item B<__xn>(SINGLE_MSGID, PLURAL_MSGID, COUNT, PAURS)
+=item B<__xn>($single_msgid, $plural_msgid, $count, $paurs)
Same as L<__nx()|Log::Report/"Language Translations">, because we have no preferred order for 'x' and 'n'.
@@ -520,34 +526,51 @@ Same as L<__nx()|Log::Report/"Language Translations">, because we have no prefer
=over 4
-=item $obj-E<gt>B<import>([DOMAIN], OPTIONS)
+=item $obj-E<gt>B<import>( [$level,][$domain,] %options )
The import is automatically called when the package is compiled. For all
packages but one in your distribution, it will only contain the name of
-the DOMAIN. For one package, it will contain configuration information.
-These OPTIONS are used for all packages which use the same DOMAIN.
+the $domain.
+
+For one package, the import list may additionally contain textdomain
+configuration %options. These %options are used for all packages which
+use the same $domain. These are alternatives:
+
+ use Log::Report 'my-domain', %config, %domain_config;
+
+ use Log::Report 'my-domain', %config;
+ textdomain 'my-domain', %domain_config;
- -Option --Default
- mode 'NORMAL'
- native_language 'en_US'
- syntax 'SHORT'
- translator <rescue>
+The latter syntax has major advantages, when the configuration of the
+domain is determined at run-time. It is probably also easier to understand.
+
+See L<Log::Report::Domain::configure()|Log::Report::Domain/"Attributes">, for the B<list of %options>
+for the domain configuration. Here, we only list the options which are
+related to the normal import behavior.
+
+The export $level is a plus (+) followed by a number, for instance C<+1>,
+to indicate to on which caller level we need to work. This is used
+in L<Log::Report::Optional|Log::Report::Optional>. It defaults to '0': my direct caller.
+
+ -Option--Default
+ import undef
+ mode 'NORMAL'
+ syntax 'SHORT'
=over 2
+=item import => FUNCTION|ARRAY
+
+[0.998] When not specified, the C<syntax> option determines the list
+of functions which are being exported. With this option, the C<syntax>
+option is ignored and only the specified FUNCTION(s) are imported.
+
=item mode => LEVEL
This sets the default mode for all created dispatchers. You can
also selectively change the output mode, like
dispatcher PERL => 'default', mode => 3
-=item 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 syntax => 'REPORT'|'SHORT'|'LONG'
The SHORT syntax will add the report abbreviations (like function
@@ -555,53 +578,33 @@ L<error()|Log::Report/"Abbreviations for report()">) to your name-space. Otherw
with L<report()|Log::Report/"Report Production and Configuration">. C<LONG> is an alternative to C<REPORT>: both do not
polute your namespace with the useful abbrev functions.
-=item translator => Log::Report::Translator
-
-Without explicit translator, a dummy translator is used for the domain
-which will use the untranslated message-id.
-
=back
example: of import
- use Log::Report mode => 3; # or 'DEBUG'
+ use Log::Report mode => 3; # '3' or 'DEBUG'
use Log::Report 'my-domain'; # in each package producing messages
use Log::Report 'my-domain' # in one package, top of distr
, mode => 'VERBOSE'
+ , syntax => 'REPORT' # report ERROR, not error()
, translator => Log::Report::Translator::POT->new
- ( lexicon => '/home/me/locale' # bindtextdomain
- , charset => 'UTF-8' # codeset
+ ( lexicon => '/home/mine/locale' # bindtextdomain
+ , charset => 'UTF-8' # codeset
)
- , native_language => 'nl_NL' # untranslated msgs are Dutch
- , syntax => 'REPORT';# report ERROR, not error()
-
-=item Log::Report-E<gt>B<translator>(TEXTDOMAIN, [TRANSLATOR])
+ , native_language => 'nl_NL'; # untranslated msgs are Dutch
-Returns the translator configured for the TEXTDOMAIN. By default,
-a translator is configured which does not translate but directly
-uses the gettext message-ids.
+ use Log::Report import => 'try'; # or ARRAY of functions
-When a TRANSLATOR is specified, it will be set to be used for the
-TEXTDOMAIN. When it is C<undef>, the configuration is removed.
-You can only specify one TRANSLATOR per TEXTDOMAIN.
+=item B<textdomain>( <[$domain], $config> | <$domain, 'DELETE'> )
-example: use if L<translator()|Log::Report/"Configuration">
+[1.00] Without CONFIGuration, this returns the L<Log::Report::Domain|Log::Report::Domain> object
+which administers the $domain, by default the domain effictive in the scope
+of the package.
- # in three steps
- use Log::Report;
- my $gettext = Log::Report::Translator::POT->new(...);
- Log::Report->translator('my-domain', $gettext);
-
- # in two steps
- use Log::Report;
- Log::Report->translator('my-domain'
- , Log::Report::Translator::POT->new(...));
-
- # in one step
- use Log::Report 'my-domain'
- , translator => Log::Report::Translator::POT->new(...);
+A very special case is for "DELETE", which will remove the domain
+configuration.
=back
@@ -609,24 +612,9 @@ example: use if L<translator()|Log::Report/"Configuration">
=over 4
-=item $obj-E<gt>B<isFatal>(REASON)
-
-=item Log::Report-E<gt>B<isFatal>(REASON)
-
-Returns true if the REASON is severe enough to cause an exception
-(or program termination).
+=item Log::Report-E<gt>B<needs>( $reason, [$reasons] )
-=item $obj-E<gt>B<isValidReason>(STRING)
-
-=item Log::Report-E<gt>B<isValidReason>(STRING)
-
-Returns true if the STRING is one of the predefined REASONS.
-
-=item $obj-E<gt>B<needs>(REASON, [REASONS])
-
-=item Log::Report-E<gt>B<needs>(REASON, [REASONS])
-
-Returns true when the reporter needs any of the REASONS, when any of
+Returns true when the reporter needs any of the $reasons, when any of
the active dispatchers is collecting messages in the specified level.
This is useful when the processing of data for the message is relatively
expensive, but for instance only required in debug mode.
@@ -646,23 +634,25 @@ example:
There are three steps in this story: produce some text on a certain
condition, translate it to the proper language, and deliver it in some
-way to a user. Texts are usually produced by commands like C<print>,
+way to a user. Texts in Perl are produced by commands like C<print>,
C<die>, C<warn>, C<carp>, or C<croak>, which have no way of configuring
-the way of delivery to the user. Therefore, they are replaced with a
-single new command: C<report> (with various abbreviations)
+the way they deliver text to the user. Therefore, they are replaced
+with a single new command: C<report> with many abbreviations.
-Besides, the C<print>/C<warn>/C<die> together produce only three levels of
-reasons to produce the message: many people manually implement more, like
-verbose and debug. Syslog has some extra levels as well, like C<critical>.
-The REASON argument to C<report()> replace them all.
+Besides, the C<print>/C<warn>/C<die> together produce only three different
+output levels with a message. Many people manually implement their
+own additional levels, like verbose and debug. Syslog has some extra
+levels as well, like C<critical>. The $reason argument to C<report()>
+offers them all.
-The translations use the beautiful syntax defined by
+The (optional) translations use the beautiful syntax defined by
Locale::TextDomain, with some extensions (of course). The main
difference is that the actual translations are delayed till the delivery
-step. This means that the pop-up in the graphical interface of the
-user will show the text in the language of the user, say Chinese,
-but at the same time syslog may write the English version of the text.
-With a little luck, translations can be avoided.
+step: until a dispatcher actually writes this message into a file or sends
+it to syslog. This means that the pop-up in the graphical interface of
+the user may show the text in the language of the user --say Chinese in
+utf8--, but at the same time syslog may write the latin1 English version
+of the same message.
=head2 Background ideas
@@ -680,29 +670,20 @@ simplifies programming and maintenance.
=item . multiple dispatchers
-It is not the location where the (for instance) error occurs determines
-what will happen with the text, but the main application which uses the
-the complaining module has control. Messages have a reason. Based
-on the reason, they can get ignored, send to one, or send to multiple
-dispatchers (like Log::Dispatch, Log::Log4perl, or UNIX syslog(1))
+It is not the location where the (for instance) error occurs which
+determines what will happen with the text, but the main application which
+uses the the complaining module has control. Messages have a reason.
+Based on the `reason' classification, they can get ignored, send to one
+or multiple dispatchers, like Log::Dispatch, Log::Log4perl,
+or UNIX syslog.
=item . delayed translations
The background ideas are that of Locale::TextDomain, based
-on C<gettext()>. However, the C<Log::Report> infrastructure has a
-pluggable translation backend. Translations are postponed until the
-text is dispatched to a user or log-file; the same report can be sent
-to syslog in (for instance) English and to the user interface in Dutch.
-
-=item . avoid duplication
-
-The same message may need to be documented on multiple locations: in
-web-pages for the graphical interface, in pod for the command-line
-configuration. The same text may even end-up in pdf user-manuals. When
-the message is written inside the Perl code, it's quite hard to get it
-out, to generate these documents. Only an abstract message description
-protocol will make flexible re-use possible.
-This component still needs to be implemented.
+on C<gettext()>. However, in the C<Log::Report> infrastructure,
+translations are postponed until the text is dispatched to a screen
+or log-file; the same report can be sent to syslog in (for instance)
+English and to the user interface in Dutch.
=back
@@ -908,7 +889,7 @@ See L<Log::Report::Dispatcher::Try|Log::Report::Dispatcher::Try> and L<Log::Repo
=head3 die/warn/Carp
-A typical perl5 program can look like this
+A typical perl5 program can look like this:
my $dir = '/etc';
@@ -948,7 +929,7 @@ A typical perl5 program can look like this
Where C<die>, C<warn>, and C<print> are used for various tasks. With
C<Log::Report>, you would write
- use Log::Report syntax => 'SHORT';
+ use Log::Report;
# can be left-out when there is no debug/verbose
dispatcher PERL => 'default', mode => 'DEBUG';
@@ -994,16 +975,6 @@ changes. There is no need for a new-line after the text of the message.
When applicable (error about system problem), then the C<$!> is added
automatically.
-The distinction between C<error> and C<fault> is a bit artificial her, just
-to demonstrate the difference between the two. In this case, I want to
-express very explicitly that the user made an error by passing the name
-of a directory in which a file is not readable. In the common case,
-the user is not to blame and we can use C<fault>.
-
-A CPAN module like C<Log::Message> is an object oriented version of the
-standard Perl functions, and as such not really contributing to
-abstraction.
-
=head3 Log::Dispatch and Log::Log4perl
The two major logging frameworks for Perl are Log::Dispatch and
@@ -1059,12 +1030,12 @@ wishes to return a LIST of objects, not the count of them.
=head1 SEE ALSO
-This module is part of Log-Report distribution version 0.994,
-built on August 22, 2013. Website: F<http://perl.overmeer.net/log-report/>
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
=head1 LICENSE
-Copyrights 2007-2013 by [Mark Overmeer]. For other contributors see ChangeLog.
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -0,0 +1,39 @@
+# Copyrights 2007-2014 by [Mark Overmeer].
+# For other contributors see ChangeLog.
+# See the manual pages for details on the licensing terms.
+# Pod stripped from pm file by OODoc 2.01.
+package MojoX::Log::Report;
+our $VERSION = '1.02';
+
+use Mojo::Base 'Mojo::Log'; # implies use strict etc
+
+use Log::Report 'log-report', import => 'report';
+
+
+sub new(@) {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+
+ # issue with Mojo, where the base-class registers a function --not
+ # a method-- to handle the message.
+ $self->unsubscribe('message'); # clean all listeners
+ $self->on(message => '_message'); # call it OO
+ $self;
+}
+
+my %level2reason = qw/
+ debug TRACE
+ info INFO
+ warn WARNING
+ error ERROR
+ fatal ALERT
+/;
+
+sub _message($$@)
+{ my ($self, $level) = (shift, shift);
+
+ report +{is_fatal => 0} # do not die on errors
+ , $level2reason{$level}, join('', @_);
+}
+
+1;
@@ -0,0 +1,62 @@
+=encoding utf8
+
+=head1 NAME
+
+MojoX::Log::Report - divert log messages into Log::Report
+
+=head1 INHERITANCE
+
+ MojoX::Log::Report
+ is a Mojo::Log
+
+=head1 SYNOPSIS
+
+ use MojoX::Log::Report;
+ my $log = MojoX::Log::Report->new(%options);
+ $app->log($log); # install logger in the Mojo::App
+
+=head1 DESCRIPTION
+
+[Included since Log::Report v1.00]
+Mojo likes to log messages directly into a file, by default. Log::Report
+constructs a L<Log::Report::Exception|Log::Report::Exception> object first.
+
+Be aware that this extension does catch the messages to be logged,
+but that the dispatching of the error follows a different route now.
+For instance, you cannot use C<$ENV{MOJO_LOG_LEVEL}> to control the output
+level, but you need to use L<Log::Report::dispatcher()|Log::Report/"Report Production and Configuration"> action C<mode>.
+
+Mojo defines five "levels" of messages, which map onto Log::Report's
+reasons this way:
+
+ debug TRACE
+ info INFO
+ warn WARNING
+ error ERROR
+ fatal ALERT
+
+=head1 METHODS
+
+=head2 Constructors
+
+=over 4
+
+=item MojoX::Log::Report-E<gt>B<new>(%options)
+
+Inherited %options C<path> and C<level> are ignored.
+
+=back
+
+=head1 SEE ALSO
+
+This module is part of Log-Report distribution version 1.02,
+built on March 10, 2014. Website: F<http://perl.overmeer.net/log-report/>
+
+=head1 LICENSE
+
+Copyrights 2007-2014 by [Mark Overmeer]. For other contributors see ChangeLog.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
@@ -2,7 +2,7 @@
use warnings;
use strict;
-use Test::More tests => 18;
+use Test::More tests => 11;
# The versions of the following packages are reported to help understanding
# the environment in which the tests are run. This is certainly not a
@@ -14,8 +14,12 @@ my @show_versions =
Log::Log4perl
Sys::Syslog
Log::Dispatch
+ String::Print
+ Mojolicious
/;
+# Log::Report::Optional
+# Log::Report::Lexicon
warn "Perl $]\n";
foreach my $package (sort @show_versions)
{ eval "require $package";
@@ -35,20 +39,11 @@ use_ok('Log::Report::Dispatcher::File');
use_ok('Log::Report::Dispatcher::Try');
use_ok('Log::Report::Dispatcher::Perl');
use_ok('Log::Report::Dispatcher::Callback');
+use_ok('Log::Report::Domain');
use_ok('Log::Report::Exception');
-use_ok('Log::Report::Extract');
-use_ok('Log::Report::Extract::Template');
-use_ok('Log::Report::Lexicon::Index');
-use_ok('Log::Report::Lexicon::PO');
-use_ok('Log::Report::Lexicon::POT');
-use_ok('Log::Report::Lexicon::POTcompact');
use_ok('Log::Report::Message');
use_ok('Log::Report::Translator');
-use_ok('Log::Report::Translator::POT');
-use_ok('Log::Report::Util');
-# Log::Report::Extract::PerlPPI requires optional PPI
# Log::Report::Dispatcher::Syslog requires optional Sys::Syslog
# Log::Report::Dispatcher::LogDispatch requires optional Log::Dispatch
# Log::Report::Dispatcher::Log4perl requires optional Log::Log4perl
-# Log::Report::Translator::Gettext requires optional Locale::gettext
@@ -1,74 +0,0 @@
-#!/usr/bin/env perl
-# test locale
-
-use Test::More;
-use POSIX;
-
-my $alt_locale;
-BEGIN {
- eval "POSIX->import( qw/setlocale :locale_h/ )";
-
- # locale disabled?
- defined setlocale(LC_ALL, 'C')
- or plan skip_all => "no translation support in Perl or OS";
-
- LOCALE:
- foreach my $l (qw/nl_NL de_DE pt_PT tr_TR/) # only non-english!
- { foreach my $c ('utf-8', 'iso-8859-1', '')
- { $alt_locale = $c ? "$l.$c" : $l;
- my $old = setlocale LC_ALL, $alt_locale;
- my $set = setlocale LC_ALL, $alt_locale;
-
- last LOCALE
- if defined $set && $set eq $alt_locale;
- }
- undef $alt_locale;
- }
-
- defined $alt_locale
- or plan skip_all => "cannot find alternative language for tests";
-
- plan tests => 11;
-}
-
-ok(1, "alt locale: $alt_locale");
-
-ok(defined setlocale(LC_ALL, 'C'), 'set C');
-
-my $try = setlocale(LC_ALL);
-ok(defined $try, 'explicit C found');
-ok($try eq 'C' || $try eq 'POSIX');
-
-$! = 2;
-my $err_posix = "$!";
-ok(defined $err_posix, $err_posix); # english
-
-my $change = setlocale LC_ALL, $alt_locale;
-ok(defined $change, "returned change to alternative locale");
-if($change eq $alt_locale)
-{ ok(1, "WARNING: setlocale() returns new locale value, not the previous");
- warn "*** WARNING: setlocale() returns new locale value, not the previous\n";
-}
-else
-{ ok(1, "result is old value");
-}
-
-is(setlocale(LC_ALL), $alt_locale, "set to $alt_locale successful?");
-$! = 2;
-my $err_alt = "$!";
-ok(defined $err_alt, $err_alt);
-
-if($err_posix eq $err_alt)
-{ # some platforms have mistakes in their language configuration
- ok(1, "ERROR: libc translations not switched");
- warn "*** ERROR: changing language of libc error messages did not work\n";
- sleep 1;
-}
-else
-{ ok(1, "libc does translate standard errors");
-}
-
-setlocale(LC_ALL, 'C');
-$! = 2;
-my $err_posix2 = "$!";
-is($err_posix, $err_posix2, $err_posix2);
@@ -1,57 +0,0 @@
-#!/usr/bin/env perl
-use warnings;
-use strict;
-
-use Test::More tests => 53;
-
-use Log::Report;
-use Log::Report::Util;
-
-#
-## parse_locale
-#
-
-sub try_parse($@)
-{ my $locale = shift;
- my @l = parse_locale $locale;
- is($l[0], $_[0], $locale);
- is($l[1], $_[1], ' ... territory');
- is($l[2], $_[2], ' ... charset');
- is($l[3], $_[3], ' ... modifier');
-}
-
-try_parse('nl', 'nl');
-try_parse('');
-try_parse('nl_NL', 'nl', 'NL');
-try_parse('nl_NL.utf-8', 'nl', 'NL', 'utf-8');
-try_parse('nl_NL.utf-8@mod', 'nl', 'NL', 'utf-8', 'mod');
-try_parse('nl.utf-8', 'nl', undef, 'utf-8');
-try_parse('nl.utf-8@mod', 'nl', undef, 'utf-8', 'mod');
-try_parse('nl_NL@mod', 'nl', 'NL', undef, 'mod');
-try_parse('nl@mod', 'nl', undef, undef, 'mod');
-
-try_parse('C', 'C');
-try_parse('POSIX', 'POSIX');
-
-#
-## expand_reasons
-#
-
-sub try_expand($$)
-{ my ($reasons, $expanded) = @_;
- my @got = expand_reasons $reasons;
- my $got = join ',', @got;
- is($got, $expanded, $reasons);
-}
-
-my $all = join ',', @reasons;
-try_expand('', '');
-try_expand('TRACE', 'TRACE');
-try_expand('PANIC,TRACE', 'TRACE,PANIC');
-try_expand('USER', 'MISTAKE,ERROR');
-try_expand('USER,PROGRAM,SYSTEM', $all);
-try_expand('ALL', $all);
-try_expand('WARNING-FAULT','WARNING,MISTAKE,ERROR,FAULT');
-try_expand('-INFO','TRACE,ASSERT,INFO');
-try_expand('ALERT-','ALERT,FAILURE,PANIC');
-
@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+# Try constructing a message object
+
+use warnings;
+use strict;
+
+use Test::More tests => 22;
+use Scalar::Util 'refaddr';
+
+use Log::Report;
+use Log::Report::Message;
+
+### direct creation
+
+my $msg = Log::Report::Message->new
+ ( _msgid => 'try'
+ , _domain => 'test'
+ , _class => 'monkey, donkey'
+ , var => 42
+ );
+
+ok(defined $msg, 'created message manually');
+isa_ok($msg, 'Log::Report::Message');
+is($msg->msgid, 'try');
+is($msg->domain, 'test');
+is($msg->valueOf('_domain'), 'test');
+is($msg->valueOf('var'), 42);
+
+my @c = $msg->classes;
+cmp_ok(scalar @c, '==', 2, 'list classes');
+is($c[0], 'monkey');
+is($c[1], 'donkey');
+
+ok($msg->inClass('monkey'), 'inClass');
+ok($msg->inClass('donkey'));
+is($msg->inClass( qr/^d/ ), 'donkey');
+is($msg->inClass( qr/key/ ), 'monkey');
+
+### indirect creation, non-translated
+
+try { report ERROR => 'not translated', _classes => 'one two' };
+my $err = $@;
+isa_ok($err, 'Log::Report::Dispatcher::Try');
+my $fatal = $err->wasFatal;
+isa_ok($fatal, 'Log::Report::Exception');
+my $message = $fatal->message;
+isa_ok($message, 'Log::Report::Message');
+
+is("$message", 'not translated', 'untranslated');
+is($message->inClass('one'), 'one');
+is($message->inClass('two'), 'two');
+is($fatal->inClass('two'), 'two');
+
+my $fatal2 = $err->wasFatal(class => 'two');
+isa_ok($fatal2, 'Log::Report::Exception');
+cmp_ok(refaddr $fatal, '==', refaddr $fatal2);
@@ -1,118 +0,0 @@
-#!/usr/bin/env perl
-# Try Lexicon POT
-
-use warnings;
-use strict;
-use lib 'lib', '../lib';
-use utf8;
-
-use Test::More tests => 44;
-use File::Basename qw/dirname/;
-use File::Spec::Functions qw/catfile/;
-use Encode qw/is_utf8/;
-
-use_ok('Log::Report::Lexicon::PO');
-use_ok('Log::Report::Lexicon::POT');
-
-my $sl_po = catfile(dirname(__FILE__), 'hello-world-slovak.po');
-
-#
-# Try reading complex example
-# slightly modified from gettext examples in slovak
-#
-
-my $pot = Log::Report::Lexicon::POT->read($sl_po,
- charset => 'utf-8');
-
-ok(defined $pot, "read pot file");
-isa_ok($pot, 'Log::Report::Lexicon::POT');
-
-#
-# header
-#
-
-is($pot->header('mime-version'), '1.0', 'access to header');
-
-#
-# plurals
-#
-
-cmp_ok($pot->nrPlurals, '==', 4, 'test plural evaluation');
-cmp_ok($pot->pluralIndex(0), '==', 0);
-cmp_ok($pot->pluralIndex(1), '==', 1);
-cmp_ok($pot->pluralIndex(2), '==', 2);
-cmp_ok($pot->pluralIndex(3), '==', 3);
-cmp_ok($pot->pluralIndex(4), '==', 3);
-cmp_ok($pot->pluralIndex(5), '==', 0);
-cmp_ok($pot->pluralIndex(6), '==', 0);
-cmp_ok($pot->pluralIndex(101), '==', 1);
-
-#
-# extended single case
-#
-
-my $po = $pot->msgid('Hello, world!');
-ok(defined $po, "got greeting");
-isa_ok($po, 'Log::Report::Lexicon::PO');
-is($po->msgid, 'Hello, world!');
-ok(!defined $po->plural);
-
-is($po->comment, 'translator comment
-translator comment line 2
-');
-
-is($po->automatic, 'automatic comment
-automatic comment line 2
-');
-
-my @refs = sort $po->references;
-cmp_ok(scalar @refs, '==', 4);
-is($refs[0], 'bis');
-is($refs[1], 'hello-1.pl.in:18');
-is($refs[2], 'hello-1.pl.in:20');
-is($refs[3], 'hello-2.pl.in:13');
-
-is($po->msgstr, "Pozdravljen, svet!");
-is($po->msgstr(0), "Pozdravljen, svet!");
-is($po->msgstr(1), "Pozdravljen, svet!"); # index gets ignored
-
-is($pot->msgstr("Hello, world!"), "Pozdravljen, svet!");
-is($pot->msgstr("Hello, world!", 0), "Pozdravljen, svet!");
-
-is($po->toString, <<'__DUMP');
-# translator comment
-# translator comment line 2
-#. automatic comment
-#. automatic comment line 2
-#: bis hello-1.pl.in:18 hello-1.pl.in:20 hello-2.pl.in:13
-msgid "Hello, world!"
-msgstr "Pozdravljen, svet!"
-__DUMP
-
-#
-# with plurals
-#
-
-is($pot->msgstr('Aap', 0), 'A', 'msgstr by plural');
-is($pot->msgstr('Aap', 1), 'B');
-is($pot->msgstr('Aap', 2), 'C');
-is($pot->msgstr('Aap', 3), 'D');
-is($pot->msgstr('Aap', 4), 'D');
-is($pot->msgstr('Aap', 5), 'A');
-is($pot->msgstr('Aap', 6), 'A');
-is($pot->msgstr('Aap', 100), 'A');
-is($pot->msgstr('Aap', 101), 'B');
-
-is($pot->msgid('Aap')->plural, 'Apen');
-
-#
-# with multi-lines and utf
-#
-
-my $po2 = $pot->msgid("This program is running as process number {pid}.multi-line\n");
-ok(defined $po2, 'test multi');
-
-my $po2t = $po2->msgstr;
-is($po2t, "Ta program teče kot proces številka {pid}.multi\tline\n");
-ok(is_utf8($po2t), 'is utf8');
-
@@ -1,197 +0,0 @@
-#!/usr/bin/env perl
-# Try Lexicon PO modifications
-
-use warnings;
-use strict;
-use utf8;
-
-use Test::More tests => 29;
-use_ok('Log::Report::Lexicon::PO');
-use_ok('Log::Report::Lexicon::POT');
-
-#
-# Create header
-#
-
-$Log::Report::VERSION = 'SOME_VERSION';
-my $pot = Log::Report::Lexicon::POT->new
- ( textdomain => 'log-report'
- , version => '2.3'
- , charset => 'UTF-8'
- , date => 'DUMMY' # don't want this to change during test
- );
-
-is($pot->msgstr(''), <<'__HEADER');
-Project-Id-Version: log-report 2.3
-Report-Msgid-Bugs-To:
-POT-Creation-Date: DUMMY
-PO-Revision-Date: DUMMY
-Last-Translator:
-Language-Team:
-MIME-Version: 1.0
-Content-Type: text/plain; charset=UTF-8
-Content-Transfer-Encoding: 8bit
-Plural-Forms: nplurals=2; plural=(n!=1);
-__HEADER
-
-is($pot->msgid('')->toString, <<'__HEAD');
-#. Header generated with Log::Report::Lexicon::POT SOME_VERSION
-msgid ""
-msgstr ""
-"Project-Id-Version: log-report 2.3\n"
-"Report-Msgid-Bugs-To:\n"
-"POT-Creation-Date: DUMMY\n"
-"PO-Revision-Date: DUMMY\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"
-__HEAD
-
-cmp_ok($pot->nrPlurals, "==", 2);
-
-is($pot->header('mime-version'), '1.0');
-is($pot->header('mime-version', '3.14'), '3.14');
-is($pot->header('mime-version'), '3.14');
-is($pot->header('mime-version', undef), undef);
-is($pot->header('new-field', 'some value'), 'some value');
-
-$pot->updated('NEWDATE');
-
-is($pot->msgid('')->toString, <<'__HEAD');
-#. Header generated with Log::Report::Lexicon::POT SOME_VERSION
-msgid ""
-msgstr ""
-"Project-Id-Version: log-report 2.3\n"
-"Report-Msgid-Bugs-To:\n"
-"POT-Creation-Date: DUMMY\n"
-"PO-Revision-Date: NEWDATE\n"
-"Last-Translator:\n"
-"Language-Team:\n"
-"Content-Type: text/plain; charset=UTF-8\n"
-"Content-Transfer-Encoding: 8bit\n"
-"Plural-Forms: nplurals=2; plural=(n!=1);\n"
-"new-field: some value\n"
-__HEAD
-
-#
-# Create non-plural
-#
-
-my $po = Log::Report::Lexicon::PO->new
- ( msgid => 'aap'
- , references => 'aap.pm:10'
- );
-
-is($po->toString, <<'__AAP', 'no translation');
-#: aap.pm:10
-msgid "aap"
-msgstr ""
-__AAP
-
-$po->addReferences('monkey.pm:12 aap.pm:3');
-$po->msgstr(0, 'monkey');
-is($po->toString, <<'__AAP', 'with translation');
-#: aap.pm:10 aap.pm:3 monkey.pm:12
-msgid "aap"
-msgstr "monkey"
-__AAP
-
-is($po->plural("apen"), 'apen', 'add plural');
-ok($po->fuzzy(1), 'is fuzzy');
-
-is($po->toString, <<'__AAP');
-#: aap.pm:10 aap.pm:3 monkey.pm:12
-#, fuzzy
-msgid "aap"
-msgid_plural "apen"
-msgstr[0] "monkey"
-msgstr[1] ""
-__AAP
-
-is($po->toString(nr_plurals => $pot->nrPlurals), <<'__AAP');
-#: aap.pm:10 aap.pm:3 monkey.pm:12
-#, fuzzy
-msgid "aap"
-msgid_plural "apen"
-msgstr[0] "monkey"
-msgstr[1] ""
-__AAP
-
-$po->msgstr(1, 'monkeys');
-$po->fuzzy(0);
-cmp_ok($po->removeReferencesTo('aap.pm'), '==', 1);
-
-is($po->toString(nr_plurals => $pot->nrPlurals), <<'__AAP');
-#: monkey.pm:12
-msgid "aap"
-msgid_plural "apen"
-msgstr[0] "monkey"
-msgstr[1] "monkeys"
-__AAP
-
-#
-# Index
-#
-
-ok(!$pot->msgid('aap'));
-is($pot->add($po), $po, 'add');
-is($pot->msgid('aap'), $po);
-
-is($pot->msgstr('aap', 0), 'monkeys');
-is($pot->msgstr('aap', 1), 'monkey');
-is($pot->msgstr('aap', 2), 'monkeys');
-
-#
-# disable/enable
-#
-
-cmp_ok($po->removeReferencesTo('monkey.pm'), "==", 0, 'rm last ref');
-is($po->toString(nr_plurals => $pot->nrPlurals), <<'__AAP');
-#~ msgid "aap"
-#~ msgid_plural "apen"
-#~ msgstr[0] "monkey"
-#~ msgstr[1] "monkeys"
-__AAP
-
-$po->addReferences('noot.pm:12', 'aap.pm:42');
-is($po->toString(nr_plurals => $pot->nrPlurals), <<'__AAP');
-#: aap.pm:42 noot.pm:12
-msgid "aap"
-msgid_plural "apen"
-msgstr[0] "monkey"
-msgstr[1] "monkeys"
-__AAP
-
-#
-# Write
-#
-
-my $text = '';
-open TEXT, '>:utf8', \$text;
-$pot->write(\*TEXT);
-close TEXT;
-
-is($text, <<'__ALL')
-#. Header generated with Log::Report::Lexicon::POT SOME_VERSION
-msgid ""
-msgstr ""
-"Project-Id-Version: log-report 2.3\n"
-"Report-Msgid-Bugs-To:\n"
-"POT-Creation-Date: DUMMY\n"
-"PO-Revision-Date: NEWDATE\n"
-"Last-Translator:\n"
-"Language-Team:\n"
-"Content-Type: text/plain; charset=UTF-8\n"
-"Content-Transfer-Encoding: 8bit\n"
-"Plural-Forms: nplurals=2; plural=(n!=1);\n"
-"new-field: some value\n"
-
-#: aap.pm:42 noot.pm:12
-msgid "aap"
-msgid_plural "apen"
-msgstr[0] "monkey"
-msgstr[1] "monkeys"
-__ALL
@@ -1,71 +0,0 @@
-#!/usr/bin/env perl
-# Try Lexicon POTcompact
-# Structure of parsed result has also been checked manually, using
-# Data::Dumper (MO 2007/05/11)
-
-use warnings;
-use strict;
-use lib 'lib', '../lib';
-use utf8;
-
-use Test::More tests => 21;
-
-use File::Basename qw/dirname/;
-use File::Spec::Functions qw/catfile/;
-
-use_ok('Log::Report::Lexicon::POTcompact');
-
-my $sl_po = catfile(dirname(__FILE__), 'hello-world-slovak.po');
-
-#
-# Try reading complex example
-# slightly modified from gettext examples in slovak
-#
-
-my $pot = Log::Report::Lexicon::POTcompact->read($sl_po,
- charset => 'utf-8');
-
-ok(defined $pot, "read pot file");
-isa_ok($pot, 'Log::Report::Lexicon::POTcompact');
-
-#
-# header
-#
-
-is($pot->header('mime-version'), '1.0', 'access to header');
-
-#
-# extended single case
-#
-
-my $po = $pot->msgid('Hello, world!');
-ok(defined $po, "got greeting");
-ok(!ref $po, "one translation only");
-is($po, "Pozdravljen, svet!");
-
-is($pot->msgstr("Hello, world!"), "Pozdravljen, svet!");
-is($pot->msgstr("Hello, world!", 0), "Pozdravljen, svet!");
-is($pot->msgstr("Hello, world!", 5), "Pozdravljen, svet!");
-
-#
-# with plurals
-#
-
-is($pot->msgstr('Aap', 0), 'A', 'msgstr by plural');
-is($pot->msgstr('Aap', 1), 'B');
-is($pot->msgstr('Aap', 2), 'C');
-is($pot->msgstr('Aap', 3), 'D');
-is($pot->msgstr('Aap', 4), 'D');
-is($pot->msgstr('Aap', 5), 'A');
-is($pot->msgstr('Aap', 6), 'A');
-is($pot->msgstr('Aap', 100), 'A');
-is($pot->msgstr('Aap', 101), 'B');
-
-#
-# with multi-lines and utf
-#
-
-my $po2 = $pot->msgid("This program is running as process number {pid}.multi-line\n");
-ok(defined $po2, 'test multi');
-is($po2, "Ta program teče kot proces številka {pid}.multi\tline\n");
-
@@ -1,106 +0,0 @@
-#!/usr/bin/env perl
-# Try Extract PPI
-
-use warnings;
-use strict;
-
-use File::Temp qw/tempdir/;
-use Test::More;
-
-use constant MSGIDS => 24;
-use constant PLURAL_MSGIDS => 4;
-BEGIN
-{ eval "require PPI";
- plan skip_all => 'PPI not installed'
- if $@;
-
- plan tests => 34 + MSGIDS*3 + PLURAL_MSGIDS*1;
- use_ok('Log::Report::Extract::PerlPPI');
-}
-
-my $lexicon = tempdir CLEANUP => 1;
-
-my %expect_pos = ('' => 1); # expect header
-sub take($@)
-{ my $result = shift;
- ok("$result", "$result");
- $expect_pos{$_}++ for @_;
-}
-
-###
-
-my $ppi = Log::Report::Extract::PerlPPI->new
- ( lexicon => $lexicon
- );
-
-ok(defined $ppi, 'created parser');
-isa_ok($ppi, 'Log::Report::Extract::PerlPPI');
-
-$ppi->process( __FILE__ ); # yes, this file!
-$ppi->write;
-
-my @potfns = $ppi->index->list('first-domain');
-cmp_ok(scalar @potfns, '==', 1, "one file created");
-my $potfn = shift @potfns;
-ok(defined $potfn);
-ok(-s $potfn, "produced file $potfn has size");
-
-####
-
-sub dummy($) {shift}
-
-use Log::Report 'first-domain'; # cannot use variable textdomain
-take("a0");
-take(__"a1", 'a1');
-take((__"a2"), 'a2');
-take((__"a3a", "a3b"), 'a3a');
-take(__("a4"), 'a4');
-take(__ dummy('a7'));
-take(__ dummy 'a8');
-take(__(dummy 'a9'));
-
-take((__x"b2"), 'b2');
-take((__x"b3a", b2b => "b3c"), 'b3a');
-take(__x("b4"), 'b4');
-take(__x("b5a", b5b => "b5c"), 'b5a');
-take(__x('b6a', b6b => "b6c"), 'b6a');
-take(__x(qq{b7a}, b7b => "b7c"), 'b7a');
-take(__x(q{b8a}, b8b => "b8c"), 'b8a');
-take(__x(b9a => b9b => "b9c"), 'b9a');
-
-take((__n "c1", "c2", 1), "c1", "c2");
-take((__n "c3", "c4", 0), "c3", "c4");
-take(__n("c5", "c6", 1), "c5", "c6");
-take(__n("c7", "c8", 0), "c7", "c8");
-
-take(N__("d1"), "d1", "d1");
-
-take(join(',', N__w("d2 d3")), "d2", "d3");
-take(join(',', N__w(" d4 d5
- d6
-d7")), "d4", "d5", "d6", "d7"); # line contains tab
-
-### check that all tags were found in POT
-
-my $pot = Log::Report::Lexicon::POT->read($potfn, charset => 'utf-8');
-ok(defined $pot, 'read translation table');
-my @pos = $pot->translations('ACTIVE');
-ok(@pos > 0);
-cmp_ok(scalar @pos, '==', MSGIDS, 'correct number tests');
-cmp_ok(scalar @pos, '==', scalar $pot->translations); # all active
-
-my %msgids;
-for my $po (@pos)
-{ my $msgid = $po->msgid;
- ok(defined $msgid, "processing $msgid");
- ok(!defined $msgids{$msgid}, 'check not double');
- $msgids{$msgid}++;
- ok(delete $expect_pos{$msgid}, 'was expected');
-
- my $plural = $po->plural
- or next;
- ok(delete $expect_pos{$plural}, 'plural was expected');
-}
-
-cmp_ok(scalar keys %expect_pos, '==', 0, "all msgids found");
-warn "NOT FOUND: $_\n" for keys %expect_pos;
@@ -1,109 +0,0 @@
-#!/usr/bin/env perl
-# Try Extract templates
-
-use warnings;
-use strict;
-
-use File::Temp qw/tempdir/;
-
-use Test::More;
-
-use Log::Report; # mode => 'DEBUG';
-use Log::Report::Lexicon::POT;
-use Log::Report::Extract::Template;
-
-use constant MSGIDS => 12;
-
-# see after __END__
-my @expect_pos = split /\n/, <<'_EXPECT';
-first
-second
-third
-fourth
-fifth
-six six six
-%d seven
-eight
-nine
-tenth
-{a} eleven
-twelve {b}
-_EXPECT
-
-chomp $expect_pos[-1];
-cmp_ok(scalar @expect_pos, '==', MSGIDS);
-my %expect_pos = map { ($_ => 1) } @expect_pos;
-$expect_pos{''} = 1; # header
-
-BEGIN {
- plan tests => 15 + MSGIDS*3;
-}
-
-my $lexicon = tempdir CLEANUP => 1;
-
-my $extr = Log::Report::Extract::Template->new
- ( lexicon => $lexicon
- , domain => 'my-domain'
- , pattern => 'TT2-loc'
- );
-
-ok(defined $extr, 'created parser');
-isa_ok($extr, 'Log::Report::Extract::Template');
-
-my $found = $extr->process( __FILE__ ); # yes, this file!
-cmp_ok($found, '==', MSGIDS);
-
-$extr->write;
-
-my @potfns = $extr->index->list('my-domain');
-cmp_ok(scalar @potfns, '==', 1, "one file created");
-my $potfn = shift @potfns;
-ok(defined $potfn);
-ok(-s $potfn, "produced file $potfn has size");
-
-#system "cat $potfn";
-
-my $pot = Log::Report::Lexicon::POT->read($potfn, charset => 'utf-8');
-ok(defined $pot, 'read translation table');
-my @pos = $pot->translations('ACTIVE');
-ok(@pos > 0);
-
-# (+1 for the header)
-cmp_ok(scalar @pos, '==', MSGIDS+1, 'correct number tests');
-cmp_ok(scalar @pos, '==', scalar $pot->translations); # all active
-
-my %msgids;
-for my $po (@pos)
-{ my $msgid = $po->msgid;
- ok(defined $msgid, "processing '$msgid'");
- ok(!defined $msgids{$msgid}, 'check not double');
- $msgids{$msgid}++;
- ok(delete $expect_pos{$msgid}, 'was expected');
-}
-
-cmp_ok(scalar keys %expect_pos, '==', 0, "all msgids found");
-warn "NOT FOUND: $_\n" for keys %expect_pos;
-
-__END__
-Here, the example template starts
-[%loc("first")%]
-[%loc("second")%]
-[%loc('third')%]
-[% loc ( 'fourth' ) %]
- [%
- loc
- (
- 'fifth'
- , params
- )
- %]
-[%xloc('not found')%]
-[%loc('six six six')%]
-[% loc('%d seven|%d sevens', 7) %]
-[% INCLUDE header.tt
- title = loc("eight") loc ('nine' )
- css =loc( 'tenth' )
-%]
-
-[% '{a} eleven' | loc(a => 3) %]
-[%| loc(b=>4) %]twelve {b}[%END%]
@@ -6,7 +6,7 @@ use strict;
use Test::More tests => 38;
-use Log::Report undef, syntax => 'SHORT';
+use Log::Report;
use POSIX 'locale_h';
setlocale(LC_ALL, 'en_US');
@@ -19,7 +19,7 @@ isa_ok($disp[0], 'Log::Report::Dispatcher');
my $file1 = '';
open my($fh1), ">", \$file1 or die $!;
-my $d = dispatcher FILE => 'file1', to => $fh1;
+my $d = dispatcher FILE => 'file1', to => $fh1, format => sub {shift};
@disp = dispatcher 'list';
cmp_ok(scalar(@disp), '==', 2);
@@ -42,7 +42,8 @@ my $file2 = '';
open my($fh2), ">", \$file2 or die $!;
my $e = dispatcher FILE => 'file2'
, format_reason => 'UPPERCASE'
- , to => $fh2, accept => '-INFO';
+ , to => $fh2, accept => '-INFO'
+ , format => sub {shift};
ok(defined $e, 'created second disp');
isa_ok($e, 'Log::Report::Dispatcher::File');
@@ -6,6 +6,7 @@ use strict;
use File::Temp qw/tempfile/;
use Test::More;
+use Fcntl qw/SEEK_CUR/;
use Log::Report undef, syntax => 'SHORT';
@@ -31,12 +32,10 @@ log4perl.category.$name = INFO, Logfile
log4perl.appender.Logfile = Log::Log4perl::Appender::File
log4perl.appender.Logfile.filename = $outfn
log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout
-log4perl.appender.Logfile.layout.ConversionPattern = %d %F{2} %L> %m
+log4perl.appender.Logfile.layout.ConversionPattern = %d %F{2} %L> %m %n
__CONFIG
-dispatcher 'Log::Log4perl' => $name, config => \$conf
- , to_level => ['ALERT-' => 3];
-
+dispatcher LOG4PERL => $name, config => \$conf;
dispatcher close => 'default';
cmp_ok(-s $outfn, '==', 0);
@@ -49,17 +48,24 @@ notice "this is a test"; $line_number = __LINE__;
my $s1 = -s $outfn;
cmp_ok($s1, '>', 0);
$log_line = <$out>;
+#warn "LINE1 = $log_line";
+
$log_line =~ s!\\!/!g; # windows
-$expected_msg = " $0 $line_number> notice: this is a test";
-like($log_line, qr/^$date_qr\Q$expected_msg\E$/);
+$expected_msg = "$line_number> notice: this is a test";
+# do not anchor at the end: $ does not match on Windows
+like($log_line, qr!^$date_qr t[/\\]53log4perl\.t \Q$expected_msg\E!);
warning "some more"; $line_number = __LINE__;
my $s2 = -s $outfn;
-cmp_ok($s2, '>', $s1);
-$log_line = do { <$out> };
+cmp_ok $s2, '>', $s1;
+
+seek $out, 0, SEEK_CUR;
+$log_line = <$out>;
+#warn "LINE2 = $log_line";
+
$log_line =~ s!\\!/!g; # windows
-$expected_msg = " $0 $line_number> warning: some more";
-like($log_line, qr/^$date_qr\Q$expected_msg\E$/);
+$expected_msg = "$line_number> warning: some more";
+like($log_line, qr!^$date_qr t[/\\]53log4perl\.t \Q$expected_msg\E!);
unlink $outfn;
@@ -4,7 +4,7 @@
use warnings;
use strict;
-use Test::More tests => 49;
+use Test::More tests => 36;
use Log::Report undef, syntax => 'SHORT';
use Carp; # required for tests
@@ -19,7 +19,7 @@ my $text = '';
open my($fh), '>', \$text;
dispatcher close => 'default';
-dispatcher FILE => 'out', to => $fh, accept => 'ALL';
+dispatcher FILE => 'out', to => $fh, accept => 'ALL', format => sub {shift};
cmp_ok(length $text, '==', 0, 'created normal file logger');
@@ -33,9 +33,9 @@ cmp_ok(scalar(@l1), '==', 1);
is($l1[0]->name, 'out');
try { my @l2 = dispatcher 'list';
- cmp_ok(scalar(@l2), '==', 1);
- is($l2[0]->name, 'try', 'only try dispatcher');
- error "this is an error"
+ cmp_ok(scalar(@l2), '==', 2);
+ is($l2[1]->name, 'try', 'only try dispatcher');
+ error "this is an error";
};
my $caught = $@; # be careful with this... Test::More may spoil it.
@@ -56,37 +56,6 @@ my @r2 = $caught->wasFatal;
cmp_ok(scalar(@r2), '==', 1);
isa_ok($r2[0], 'Log::Report::Exception');
-try { info "nothing wrong";
- trace "trace more"
- } # no comma!
- mode => 'DEBUG';
-
-$caught = $@;
-isa_ok($caught, 'Log::Report::Dispatcher::Try');
-ok($caught->success);
-ok($caught ? 0 : 1);
-my @r3 = $caught->wasFatal;
-cmp_ok(scalar(@r3), '==', 0);
-
-my @r4 = $caught->exceptions;
-cmp_ok(scalar(@r4), '==', 2);
-
-isa_ok($r4[0], 'Log::Report::Exception');
-is($r4[0]->toString, "info: nothing wrong\n");
-is("$r4[0]", "info: nothing wrong\n");
-
-isa_ok($r4[1], 'Log::Report::Exception');
-is($r4[1]->toString, "trace: trace more\n");
-is("$r4[1]", "trace: trace more\n");
-
-$caught->reportAll; # pass on errors
-my $text_l3 = length $text;
-cmp_ok($text_l3, '>', $text_l2, 'passed on loggings');
-is(substr($text, $text_l2), <<__EXTRA);
-info: nothing wrong
-trace: trace more
-__EXTRA
-
eval {
try { try { failure "oops! no network" };
$@->reportAll;
@@ -131,18 +100,18 @@ isa_ok($die_ex, 'Log::Report::Exception');
is($die_ex->reason, 'ERROR');
like("$@", qr[^try-block stopped with ERROR: oops at ] );
-my $croak = try { croak "oops" };
+my $croak = try { croak "oops2" };
ok(ref $@, 'caught croak');
isa_ok($@, 'Log::Report::Dispatcher::Try');
my $croak_ex = $@->wasFatal;
isa_ok($croak_ex, 'Log::Report::Exception');
is($croak_ex->reason, 'ERROR');
-like("$@", qr[^try-block stopped with ERROR: oops at ] );
+like("$@", qr[^try-block stopped with ERROR: oops2 at ] );
-my $confess = try { confess "oops" };
+my $confess = try { confess "oops3" };
ok(ref $@, 'caught confess');
isa_ok($@, 'Log::Report::Dispatcher::Try');
my $confess_ex = $@->wasFatal;
isa_ok($confess_ex, 'Log::Report::Exception');
is($confess_ex->reason, 'PANIC');
-like("$@", qr[^try-block stopped with PANIC: oops at ] );
+like("$@", qr[^try-block stopped with PANIC: oops3 at ] );
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+# Test MojoX::Log::Report
+
+use warnings;
+use strict;
+use lib 'lib', '../lib';
+
+use Test::More;
+use Log::Report undef;
+
+use Data::Dumper;
+
+BEGIN
+{ eval "require Mojo::Base";
+ plan skip_all => 'Mojo is not installed'
+ if $@;
+
+ plan tests => 7;
+}
+
+use_ok('MojoX::Log::Report');
+
+my $log = MojoX::Log::Report->new;
+isa_ok($log, 'MojoX::Log::Report');
+isa_ok($log, 'Mojo::Log');
+
+my $tmp;
+try { $log->error("going to die"); $tmp = 42 } mode => 3;
+my $err = $@;
+#warn Dumper $err;
+
+cmp_ok($tmp, '==', 42, 'errors not cast directly');
+ok($@->success, 'block continued succesfully');
+
+my @exc = $err->exceptions;
+cmp_ok(scalar @exc, '==', 1, "caught 1");
+is("$exc[0]", "error: going to die\n");
@@ -1,10 +1,9 @@
-# Copyrights 2007-2013 by [Mark Overmeer].
+# Copyrights 2007-2014 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.01.
package DieTests;
-use vars '$VERSION';
-$VERSION = '0.994';
+our $VERSION = '1.02';
use warnings;
use strict;
@@ -1,50 +0,0 @@
-# -*- mode: po; coding: utf-8; -*- Slovenian message catalog for GNU gettext-example
-# Copyright (C) 2005 Yoyodyne, Inc.
-# Primož Peterlin <primoz.peterlin@biofiz.mf.uni-lj.si>, 2005.
-# $Id: sl.po,v 1.2 2006/04/20 14:10:34 haible Exp $
-msgid ""
-msgstr ""
-"Project-Id-Version: hello-perl 0.14.5\n"
-"Report-Msgid-Bugs-To: bug-gnu-gettext@gnu.org\n"
-"POT-Creation-Date: 2007-04-18 15:27+0200\n"
-"PO-Revision-Date: 2005-09-29 13:38+0200\n"
-"Last-Translator: Primož Peterlin <primoz.peterlin@biofiz.mf.uni-lj.si>\n"
-"Language-Team: Slovenian <translation-team-sl@lists.sourceforge.net>\n"
-"MIME-Version: 1.0\n"
-"Content-Type: text/plain; charset=UTF-8\n"
-"Content-Transfer-Encoding: 8bit\n"
-"Plural-Forms: nplurals=4; plural=(n%100==1 ? 1 : n%100==2 ? 2 : n%100==3 || n"
-"%100==4 ? 3 : 0);\n"
-
-# translator comment
-# translator comment line 2
-#. automatic comment
-#. automatic comment line 2
-#: hello-1.pl.in:20
-#: hello-1.pl.in:18 hello-2.pl.in:13
-#: hello-1.pl.in:20 bis
-msgid "Hello, world!"
-msgstr "Pozdravljen, svet!"
-
-#: hello-1.pl.in:20
-#, perl-format
-msgid "This program is running as process number %d."
-msgstr "Ta program teče kot proces številka %d."
-
-#: hello-2.pl.in:16
-#, perl-brace-format
-msgid "This program is running as process number {pid}."
-"multi-line\n"
-msgstr "Ta program teče kot proces številka {pid}."
-"multi\tline\n"
-
-#: hello-2.pl.in:17
-msgid "Aap"
-msgid_plural "Apen"
-msgstr[0] "A"
-msgstr[1] "B"
-msgstr[2] "C"
-msgstr[3] "D"
-
-
-
@@ -1,54 +0,0 @@
-#!/usr/bin/env perl
-# test the lexicon index.
-
-use warnings;
-use strict;
-
-use Test::More;
-
-my $mailman_po;
-my $not_exist = 'does-not-exist';
-
-BEGIN
-{ $mailman_po = '/usr/lib/mailman/messages';
- unless(-d $mailman_po)
- { plan skip_all => 'cannot find sample translations, no problem';
- exit 0;
- }
- plan tests => 12;
-}
-
-use Log::Report;
-use_ok('Log::Report::Lexicon::Index');
-
-#
-# Directory does not exist
-#
-
-my $t = Log::Report::Lexicon::Index->new($not_exist);
-ok(defined $t, 'create useless index');
-isa_ok($t, 'Log::Report::Lexicon::Index');
-ok(!defined $t->find('domain', 'locale'));
-
-#
-# Now it does exist
-#
-
-my $v = Log::Report::Lexicon::Index->new($mailman_po);
-ok(defined $v, 'create mailman index');
-isa_ok($v, 'Log::Report::Lexicon::Index');
-ok(defined $v->index);
-is($v->find('mailman', 'nl_NL.utf-8@test'), $mailman_po.'/nl/LC_MESSAGES/mailman.mo');
-is($v->find('mailman', 'pt_BR'), $mailman_po.'/pt_BR/LC_MESSAGES/mailman.mo');
-ok(!defined $v->find('mailman', 'xx_XX.ISO-8859-1@modif'));
-
-#use Data::Dumper;
-#warn Dumper $v;
-
-#
-# list textdomain files
-#
-
-my @l = $v->list('mailman');
-ok(@l+0, 'list');
-cmp_ok(scalar(@l), '>', 30); # I have 58, on the moment