Log-Report-0.998/0000755000175000001440000000000012231427551014255 5ustar00markovusers00000000000000Log-Report-0.998/META.yml0000644000175000001440000000111212231427551015521 0ustar00markovusers00000000000000--- abstract: 'report a problem, pluggable handlers and language support' author: - 'Mark Overmeer' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120630' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Log-Report no_index: directory: - t - inc requires: Devel::GlobalDestruction: 0.09 Encode: 2.00 Scalar::Util: 0 Sys::Syslog: 0.27 Test::More: 0.86 version: 0.998 Log-Report-0.998/xt/0000755000175000001440000000000012231427551014710 5ustar00markovusers00000000000000Log-Report-0.998/xt/99pod.t0000644000175000001440000000041612231427544016044 0ustar00markovusers00000000000000#!/usr/bin/env perl use warnings; use strict; use Test::More; BEGIN { eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; plan skip_all => "devel home uses OODoc" if $ENV{MARKOV_DEVEL}; } all_pod_files_ok(); Log-Report-0.998/xt/30index.t0000644000175000001440000000225312231427544016353 0ustar00markovusers00000000000000#!/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 Log-Report-0.998/Makefile.PL0000644000175000001440000000234612231427544016236 0ustar00markovusers00000000000000use ExtUtils::MakeMaker; use 5.008; my $version = '0.998'; my %prereq = ( Test::More => 0.86 , Sys::Syslog => '0.27' , Encode => '2.00' , Scalar::Util => 0 , Devel::GlobalDestruction => 0.09 ); $prereq{ 'Win32::TieRegistry' } = 0.24 if $^O eq 'MSWin32'; 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' , LICENSE => 'perl' ); sub MY::postamble { <<'__POSTAMBLE' } # for OODoc's oodist, DIST RAWDIR = ../public_html/log-report/raw DISTDIR = ../public_html/log-report/source LICENSE = artistic SKIP_LINKS = XML::LibXML # for OODoc's oodist, POD FIRST_YEAR = 2007 EMAIL = perl@overmeer.net WEBSITE = http://perl.overmeer.net/log-report/ EXTENDS = # for OODoc's oodist, HTML HTML_OUTPUT = ../public_html/log-report/html HTML_DOCROOT = /log-report/html HTML_PACKAGE = ../public_html/log-report/htmlpkg __POSTAMBLE # for translation tables #linkext:: # - PERL5LIB="lib:$PERL5LIB" bin/xgettext-perl --mode=VERBOSE \ # -p lib/Log/Report/messages lib bin Log-Report-0.998/README0000644000175000001440000000112212231427544015133 0ustar00markovusers00000000000000==== README for Log::Report = Last update: 25 May 2007, Mark Overmeer The Log::Report module is entangled with various other modules, which may each take a long time to install but then are never used. Therefore, these modules will produce compile-time errors. Optional modules: Needed for: Log::Dispatch and ::* Log::Report::Dispatcher::LogDispatch Log::Log4perl Log::Report::Dispatcher::Log4perl Sys::Syslog Log::Report::Dispatcher::Syslog PPI Log::Report::Extract::PerlPPI Locale::gettext Log::Report::Translator::Gettext Log-Report-0.998/ChangeLog0000644000175000001440000004236112231427544016037 0ustar00markovusers00000000000000 ==== version history of Log::Report TODO: . connect to Message::Passing framework . extract a Log::Report::Optional distribution 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: - link to paper [Richard Still] - chicken-egg problem with error on illegal mode setting. Improvements: - try to build new translation table at each 'make' version 0.993: Thu Mar 28 10:59:27 CET 2013 Fixes: - filename/linenumber caller-depth in Log4Perl. rt.cpan.org#83736 [Dominik Jarmulowicz] - actually try to use existing mo files. Improvements: - use Devel::GlobalDestruction rt.cpan.org#80612 [Riba Sushi] - ::Template extractor of translatable strings now understands [%|loc%]$msgid[%END%] and [%'$msgid'| loc %] - improvements on documentation. - move t/30index.t towards xt/30index.t, because the test is too sensitive for the actual environment. version 0.992: Fri Dec 21 11:59:55 CET 2012 Improvements: - add support for msgctxt in po-files to Log::Report::Lexicon::POT* - new option Log::Report::Lexicon::PO::new(plural_forms) - new generic base-class Log::Report::Lexicon::Table for Log::Report::Lexicon::POT* - ::POT.pm ignores any index when the msgid has no plural form. This results in a smaller memory foot-print. - support for MO files, in Log::Report::Lexicon::MOTcompact version 0.991: Mon Nov 26 09:27:08 CET 2012 Fixes: - t/50file.t test failed on HASH order [cpantesters] version 0.99: Wed Oct 3 09:13:58 CEST 2012 Changes: - do not call overloaded stringification in stack-trace. Fixes: - do only include .po files in the index which are not in a directory which starts with a dot (for instance, not in /.svn/) or do not start with a dot. [Richard Still] Improvements: - remove \r from the end of comment lines in PO files. version 0.98: Thu Sep 6 14:46:52 CEST 2012 Changes: - rewrote message-id extractor in ::Extract::Template to support more TemplateToolkit features. - print __x("who am i\n") is now interpreted as print __x("who am i"), "\n"; So: no trailing newlines in the PO-tables. Fixes: - PO file parse errors reported on the wrong location. - ::Message::toString() uses $" when an ARRAY of elements gets inlined. This should be the $" on the moment of message's definition, not the $" when it gets stringified. Improvements: - new option ::Message::new(_join) version 0.97: Mon Sep 3 15:54:04 CEST 2012 Changes: - repair mistake of 0.96: Log::Report::Translate::TemplateToolkit() must have been Log::Report::Message::fromTemplateToolkit() Improvements: - count for message with plural can be ARRAY or HASH, which get numified automatically. version 0.96: Fri Aug 31 16:43:31 CEST 2012 Fixes: - scan templates for msgid containing white-space. - ::Translate::translate() was documented to accept a language parameter. Fixed the docs and implemented it ;-) Improvements: - support for plural forms in templates. - explanation/support method how to integrate the translations with Template::Toolkit. version 0.95: Thu Aug 30 23:15:50 CEST 2012 Changes: - new parameters for xgettext-perl, now also able to handle extracting from templates. Script needs man-page. Fixes: - xgettext-perl showed counts twice. - text-domain specified as "qw/domain/" now gets recognized by PerlPPI. Improvements: - some spelling corrections by rt.cpan.org#70959 [Fabrizio Regalli] - synopsis fix in ::Dispatcher::Callback by [gbjk] - cleaned-up the synopsis of Log::Report a bit. - split base-class Log::Report::Extract from ::Extract::PerlPPI - remove dependency to Test::Pod - add Log::Report::Extract::Template and t/42templ.t version 0.94: Tue Aug 23 11:14:59 CEST 2011 Changes: - when an exception get throw()n again, but with a different "reason", the fatality "is_fatal" will automatically adapt. Improvements: - add Log::Report::Exception::isFatal() version 0.93: Thu Jun 30 09:45:24 CEST 2011 Fixes: - faults caused by $? should not exit with 0 rt.cpan.org #68496 [Zephaniah E. Hull] - die's in try blocks did not produce a Log::Report::Message reported by [Patrick Powell] - fix use for non-admin Windows users rt.cpan.org#67935 [unknown] Improvements: - ability to change message and reason of an ::Exception - lazy-load Log::Report::Die version 0.92: Fri Apr 15 10:26:33 CEST 2011 Fixes: - another attempt to silence test for Windows bug. Improvements: - additional doc to dispatcher(), triggered by [Patrick Powell] - add error 'xx', _to => $disp; as alternative to report {to => $disp}, ERROR => 'xx'; version 0.91: Wed Jan 26 16:24:25 CET 2011 Fixes: - enabling and disabling dispatchers did not work [Patrick Powell] Improvements: - produce nice error when __x received even length list. - added Log::Report::Dispatcher::Callback - typos in new Callback.pm [Patrick Powell] - disable test which fails on bug in confess on Windows http://rt.perl.org/rt3/Ticket/Display.html?id=81586 - improved output with new OODoc version 0.90: Wed Dec 22 16:29:51 CET 2010 Changes: - ::Exception stringifies with lowercase reason, was uppercase Fixes: - repair Log::Report::report(is_fatal) option. - reimplementation of totalDigits and fractionDigits facets, triggered by rt.cpan.org#63464 [mimon-cz] - fix handling results of filters Improvements: - reorder checks in report() to be faster when the message is ignored (for instance trace) version 0.28: Mon May 31 16:00:12 CEST 2010 Fixes: - ::Exception::toString() should produce a string, sometimes it was an overloaded ::Message object. - More test fixes to repair Test::More changes. - Avoid call to close on undef in END rt.cpan.org#57955 [Jan Henning Thorsen] version 0.27: Fri May 28 15:37:44 CEST 2010 Fixes: - turn autoflush on for FILE dispatcher. Found by [Robin V.] - Test::More 0.95_01 changes is() w.r.t. overloading... broken tests. rt.cpan.org#57703 [Slaven Rezic] version 0.26: Mon Feb 15 10:08:23 CET 2010 Changes: - default of 'syntax' changed from 'REPORT' to 'SHORT'. Improvements: - fixes in dispatcher doc "mode" table. - document use of ::Exception::throw a bit better. - more useful error when parameter list has odd length. version 0.25: Thu Jul 16 12:18:51 CEST 2009 Improvements: - new method Log::Report::Exception::toString(), also overloaded for stringification. version 0.24: Mon Apr 27 10:02:12 CEST 2009 Fixes: - default language switching broken. - fix t/50file.t in Dutch environment [Peter de Vos] version 0.23: Fri Apr 24 16:18:12 CEST 2009 Fixes: - remember global mode, for dispatchers started later. - let try() use dispatcher mode, not to loose trace etc. - resolve complaint on exit. Improvements: - when an empty list has to be expanded, it will show '(none)' - require Sys::Syslog 0.27 version 0.22: Mon Jan 26 09:05:55 CET 2009 Fixes: - do not use /bin/pwd in t/pod.t, because it fails on Windows [Serguei Trouchelle] - translate long Windows locales into short rt.cpan.org#41943 [Serguei Trouchelle] version 0.21: Wed Jan 21 10:31:48 CET 2009 Fixes: - avoid recursion when locale setting is not understood. rt.cpan.org#41943 [Serguei Trouchelle] Improvements: - add Log::Report::needs() for convenience version 0.20: Thu Dec 11 14:18:15 CET 2008 Fixes: - dispatcher does not convert output to a default charset, because the optimal default cannot be established on most platforms. version 0.19: Mon Nov 24 12:52:34 CET 2008 Fixes: - fix for Test::More interface change in 0.86. - be strict on the character-set of the messages which are written, by default in UTF-8. (LC_CTYPE for the File dispatcher if available) Improvements: - work around missing LC_MESSAGES on old perls [Toby Corkindale] - few improvements in main SYNOPSIS - removed ::Dispatcher::File setting of encoding in binmode, in favor of explicit (internal) encoding for all dispatched messages. - require Encode 2.00+ - test do not say 'ERROR' but 'WARNING' in t/04setlocale.t when the setlocale() call does not return the old value as it should, according to the standards. Less confusion to the end-user, hopefully. version 0.18: Fri May 9 15:36:06 CEST 2008 Fixes: - few fixes to Win32Locale and parse_locale() [Ari Jolma] - Require Sys::Syslog 0.24 version 0.17: Fri Apr 18 18:20:51 CEST 2008 Fixes: - strackTrace error with isa() when parameter string contains a '::' and when a parameter is undefined. Changes: - changing the run-mode will change the accepted reasons as well, because it was too complex to understand. Improvements: - complain if syntax option has an invalid value. - use warnings and strict in Win32Locale [cpants] - dispatcher command on "ALL" defined dispatchers. - use Log::Report mode => 'something' version 0.16: Thu Mar 27 11:32:08 CET 2008 Fixes: - assert, error, and such are functions, but where documented as being methods. - xgettext-perl -h did not exit. - complaints on Windows about prototype mistake when redefining LC_MESSAGES [Adam Kennedy] Improvements: - ::Lexicon::Index::list() got second optional argument, to filter filenames. - Silence symlink recursion errors in ::Lexicon::Index version 0.15: Mon Feb 25 15:36:37 CET 2008 Changes: - ::Dispatcher::Syslog::new(format_reason) change default to 'IGNORE'. - warning does not get a line-number/filename. Use alert if you need those. Improvements: - added logsocket option to SYSLOG dispatcher. - exception can be re-throw-n with a different reason. - stop parse_locale() from complaining about locale==undef - ::Util::parse_locale() does a better job trying to conform to various standards. In SCALAR context, it now returns more information. - avoid calling ::Dispatcher::DESTROY during global destruction, because Perl produces horrible complaints for some releases of Perl. - link manual-pages with Text::Catalog (renamed from Log::Report::View) version 0.14: Fri Nov 2 15:00:49 CET 2007 Fixes: - Another syntax error, now using Win32Locale. via cpantesters [mmusgrove] - Close DATA handle after reading Win32 locale table. via cpantesters [mmusgrove] version 0.13: Mon Oct 29 09:20:04 CET 2007 Fixes: - Stupid syntax error in the new Win32Locale. via cpantesters [mmusgrove] Improvements: - Log::Report::Dispatchers should now be able to handle situations where locale_h is not exported by POSIX. version 0.12: Tue Oct 23 15:26:07 CEST 2007 Improvements: - t/04locale.t also tries charset eq '' - t/04locale.t will produce a warning, not an error, when the setlocale() does not work - t/*.t will use the 'C' locale, not the less often supported 'POSIX'. - added Log::Report::Win32Locale, with experimental application in Log::Report::Lexicon::Index - on some platforms, LC_MESSAGES is not defined. Work-around in Log::Report::Translator::POT. version 0.11: Thu Oct 18 09:34:18 CEST 2007 Fixes: - Running tests, a temporary directory remained in /tmp. [Andreas Koenig] Improvements: - Makefile.PL use 5.008 i.s.o. 5.8.2, otherwise not understood by perl 5.5. [Slaven Rezic] - Added versions of optional modules to test output version 0.10: Mon Oct 15 17:55:44 CEST 2007 Changes: - WARNINGs should not included $!... use alert if you are tempted. Improvements: - few doc fixes. version 0.09: Thu Aug 9 22:46:56 CEST 2007 Changes: - a try{} block executes eval in the correct context, and returns its results. Just like eval() does. - a non-translated message MUST be only one string to be passed to report(), because other parameters are passed to the message constructor. Fixes: - stack-trace did not remove the trace of the Log::Report internal helpers. - if try died indirectly from a nested died try, then that object is not captured in died() itself. Improvements: - try() catches Perl die/croak/warn as well, and translates them using Log::Report::Die. - try() dies if parameter list has odd length (semi-colon forgotten) - implementation of exception classes. See Log::Report::(Message|Exception)::inClass version 0.08: Wed Jul 11 14:09:32 CEST 2007 Changes: - default dispatcher is now named 'default', type PERL Improvements: - added comments by [Guido Flohr] about use of Locale::gettext - NetBSD has locale C and POSIX in lower-case. [cpan-testers] - improve handling of undef values during expand - added PERL=Log::Report::Dispatcher::Perl version 0.07: Wed Jun 20 14:01:18 CEST 2007 Improvements: - another attempt to find-out why some platforms report a deep recursion. version 0.06: Sat Jun 9 10:33:23 CEST 2007 Improvements: - t/51syslog.t compares required version via UNIVERSAL::VERSION (cpan-tester David Cantrell) Other version checks adapted as well. - add t/pod.t, which tests produced pods - t/01locale.t even smarter, with help of Andreas Koenig version 0.05: Thu Jun 7 13:18:13 CEST 2007 Changes: - the stderr dispatcher will be opened when there is any file at STDERR, not only a tty. Improvements: - simplified t/50files.t - another attempt to get t/01locale.t correct on all platforms - ::Util; locale parser must accept C and POSIX - ::Dispatcher; make message output format translatable - ::Extract::PPI; report mistake when msgid ends with new-line - ::Extract::PPI; mistake when a variable is interpolated in msgid - ::Extract::PPI; qq{} msgids will now be detected as well - ::Extract::PPI; special characters the "" and qq{} strings with get interpreted (PPI does not do that automatically) - ::Extract::PPI: only report the nessecary - after a long discussion within Amsterdam.pm about concatenation of translated fragments, it was decided to permit it but put some extra warnings in the docs. - also warn about __'xx' meaning __::xx ' - updated log-report/nl_NL.po translations - configure native_language for a domain - untranslated messages will still be formatted according to the rules of the native_language - translator table setting per domain now integrated with other settings for the domain. - ran ispell on the man-pages version 0.04: Mon Jun 4 11:05:10 CEST 2007 - removed incorrect doc about "mode TRY", which does not exist. - included syslog in "reason" comparison table - have Makefile.PL install xgettext-perl - t/50file.t needed more work-arounds to pass automated module tests (which go without -t STDERR) - attempts to make test-scripts run on various platforms. version 0.03: Mon May 28 20:16:26 CEST 2007 - Log::Report::Message without msgid forgot _append. - Log::Report::Message must clone at concatenation. - remove translations from POT when not referenced anymore, and not translated either. - $@ after try will not show the message, because we want people to use reportAll() or reportFatal(). - dispatchers now have a format_reason, defaulting to LOWERCASE which looks nicer than uppercase. - added docs to ::Try - reorganized some docs. - Log::Report::Util lacked the trailing "1;" - fall-back to no translation in case of unknown locale in ::POT - test functionality of setlocale, and hopefully fixed things version 0.02: Mon May 28 00:49:52 CEST 2007 - added HTML documentation to http://perl.overmeer.net/log-report/ - added README and Changelog to MANIFEST - filters are not defined on the dispatcher object, but under control of Log::Report::report(). - Log::Report::Message new methods append(), msgid(), and prepend() - added Log::Report::Exception and Log::Report::Dispatcher::Try - added isValidReason() and isFatal() to Log::Report - added Log::Report::Message::untranslated(); - Log::Report::report() will convert untranslated strings into Log::Report::Message objects internally too. - by David Cantrell via cpan-testers: . require at least perl 5.8.2, for POSIX :local_h and because unique was broken before that release. . t/00use.t cannot test LogDispatch and Gettext, because they depend on optional module . t/50file.t failed because no -t STDERR version 0.01: Fri May 25 12:13:13 CEST 2007 - initial (quite complete) implementation. Log-Report-0.998/bin/0000755000175000001440000000000012231427551015025 5ustar00markovusers00000000000000Log-Report-0.998/bin/xgettext-perl0000644000175000001440000000633712231427544017577 0ustar00markovusers00000000000000#!/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, $fn_match); my ($char_in, $char_out, $domain, $mode, $template); GetOptions 'domain|d=s' => \$domain , 'files-from|f=s' => \$from # file with filenames (MANIFEST?) or '-' , 'files-match|m=s' => \$fn_match # select filename is dir , 'from-code=s' => \$char_in , 'help|h' => \$help , 'language|L=s' => \$lang , 'mode=s' => \$mode , 'output-dir|p=s' => \$output , 'template|t=s' => \$template # pattern in ::Template , 'to-code=s' => \$char_out # missing in xgettext? , 'verbose=i' => \$mode , 'version|V' => \$version , 'v+' => \$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"; if($from eq '-') { @filenames = ; } else { open FILENAMES, '<:raw', $from or fault __x"cannot read filename list from {fn}", fn => $from; @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 => $template ); $fn_match ||= qr/\.tt2?$/i; foreach my $filename (@filenames) { unless($filename =~ $fn_match) { info __x"skipping (not a template) {fn}", fn => $filename; next; } $extr->process($_, charset => $char_in) } } else { # process the pm files eval "require Log::Report::Extract::PerlPPI"; panic $@ if $@; $extr = Log::Report::Extract::PerlPPI->new ( lexicon => $output , charset => $char_out ); $fn_match ||= qr/\.p[lm]$/i; foreach my $filename (@filenames) { unless($filename =~ $fn_match) { info __x"skipping (not perl) {fn}", fn => $filename; next; } $extr->process($filename, charset => $char_in); } } $extr->showStats; $extr->write; Log-Report-0.998/lib/0000755000175000001440000000000012231427551015023 5ustar00markovusers00000000000000Log-Report-0.998/lib/Log/0000755000175000001440000000000012231427551015544 5ustar00markovusers00000000000000Log-Report-0.998/lib/Log/Report/0000755000175000001440000000000012231427551017017 5ustar00markovusers00000000000000Log-Report-0.998/lib/Log/Report/Translator/0000755000175000001440000000000012231427551021150 5ustar00markovusers00000000000000Log-Report-0.998/lib/Log/Report/Translator/Gettext.pod0000644000175000001440000000335012231427545023304 0ustar00markovusers00000000000000=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. =head1 METHODS See L. =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Translator/POT.pm0000644000175000001440000000422012231427545022151 0ustar00markovusers00000000000000# 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.998'; 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}{$domain}{$locale} ? $self->{pots}{$domain}{$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}{$domain}{$locale} = $class->read($fn, charset => $self->charset); } $self->{pots}{$domain}{$locale} = undef; } 1; Log-Report-0.998/lib/Log/Report/Translator/POT.pod0000644000175000001440000000460512231427545022326 0ustar00markovusers00000000000000=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, which is much more efficient than L. See L. =head1 METHODS See L. =head2 Constructors See L. =over 4 =item Log::Report::Translator::POT-EB(OPTIONS) -Option --Defined in --Default charset Log::Report::Translator lexicons Log::Report::Translator =over 2 =item charset => STRING =item lexicons => DIRECTORY|ARRAY-of-DIRECTORYs =back =back =head2 Accessors See L. =over 4 =item $obj-EB() See L =item $obj-EB() See L =back =head2 Translating See L. =over 4 =item $obj-EB(DOMAIN, LOCALE) See L =item $obj-EB(MESSAGE, [LANGUAGE]) See L =back =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Translator/Gettext.pm0000644000175000001440000000170412231427545023137 0ustar00markovusers00000000000000# 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.998'; 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; Log-Report-0.998/lib/Log/Report/Win32Locale.pm0000644000175000001440000003671512231427545021416 0ustar00markovusers00000000000000# 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.998'; 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() { 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) Log-Report-0.998/lib/Log/Report/Dispatcher.pod0000644000175000001440000002664612231427545021632 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher - manage message dispatching, display or logging =head1 INHERITANCE Log::Report::Dispatcher is extended by Log::Report::Dispatcher::Callback Log::Report::Dispatcher::File Log::Report::Dispatcher::Log4perl Log::Report::Dispatcher::LogDispatch Log::Report::Dispatcher::Perl Log::Report::Dispatcher::Syslog Log::Report::Dispatcher::Try =head1 SYNOPSIS use Log::Report; # The following will be created for you automatically dispatcher 'PERL', 'default', accept => 'NOTICE-'; dispatcher close => 'default'; # after deamonize dispatcher 'FILE', 'log' , mode => 'DEBUG', to => '/var/log/mydir/myfile'; # Full package name is used, same as 'FILE' dispatcher Log::Report::Dispatch::File => 'stderr' , to => \*STDERR, accept => 'NOTICE-'; =head1 DESCRIPTION In L, dispatchers are used to handle (exception) messages which are created somewhere else. Those message were produced (thrown) by L and friends. This base-class handles the creation of dispatchers, plus the common filtering rules. See the L section, below. =head1 METHODS =head2 Constructors =over 4 =item $obj-EB() Terminate the dispatcher activities. The dispatcher gets disabled, to avoid the case that it is accidentally used. Returns C (false) if the dispatcher was already closed. =item Log::Report::Dispatcher-EB(TYPE, NAME, OPTIONS) Create a dispatcher. The TYPE of back-end to start is required, and listed in the L part of this manual-page. For various external back-ends, special wrappers are created. The NAME must be uniquely identifying this dispatcher. When a second dispatcher is created (via L) with the name of an existing dispatcher, the existing one will get replaced. All OPTIONS which are not consumed by this base constructor are passed to the wrapped back-end. Some of them will check whether all OPTIONS are understood, other ignore unknown OPTIONS. -Option --Default accept depend on mode charset format_reason 'LOWERCASE' locale mode 'NORMAL' =over 2 =item accept => REASONS See L for possible values. If the initial mode for this dispatcher does not need verbose or debug information, then those levels will not be accepted. When the mode equals C (the default) then C's default is C. In case of C it will be C, C results in C, and C in C. =item charset => CHARSET Convert the messages in the specified character-set (codeset). By default, no conversion will take place, because the right choice cannot be determined automatically. =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE How to show the reason text which is printed before the message. When a CODE is specified, it will be called with a translated text and the returned text is used. =item locale => LOCALE Overrules the global setting. Can be overruled by L. =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 Possible values are C (or C<0> or C), which will not show C or debug messages, C (C<1>; shows C not debug), C (C<2>; only ignores C messages), or C (C<3>) which shows everything. See section L. You are advised to use the symbolic mode names when the mode is changed within your program: the numerical values are available for smooth Getopt::Long integration. =back =back =head2 Accessors =over 4 =item $obj-EB() =item $obj-EB() Returns the mode in use for the dispatcher as number. See L and L. =item $obj-EB() Returns the unique name of this dispatcher. =item $obj-EB() Returns the list with all REASONS which are needed to fulfill this dispatcher's needs. When disabled, the list is empty, but not forgotten. =item $obj-EB() The dispatcher TYPE, which is usually the same as the class of this object, but not in case of wrappers like for Log::Dispatch. =back =head2 Logging =over 4 =item $obj-EB() =item Log::Report::Dispatcher-EB() 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-EB([MAXDEPTH]) =item Log::Report::Dispatcher-EB([MAXDEPTH]) Returns an ARRAY of ARRAYs with text, filename, line-number. =item $obj-EB(HASH-of-OPTIONS, REASON, MESSAGE) This method is called by L and should not be called directly. Internally, it will call L, which does most of the work. =item $obj-EB(OPTIONS) =item Log::Report::Dispatcher-EB(OPTIONS) -Option --Default abstract 1 call filename linenr max_line undef max_params 8 package params =over 2 =item abstract => INTEGER The higher the abstraction value, the less details are given about the caller. The minimum abstraction is specified, and then increased internally to make the line fit within the C margin. =item call => STRING =item filename => STRING =item linenr => INTEGER =item max_line => INTEGER =item max_params => INTEGER =item package => CLASS =item params => ARRAY =back =item $obj-EB(HASH-of-OPTIONS, REASON, MESSAGE) See L, which describes the actions taken by this method. A string is returned, which ends on a new-line, and may be multi-line (in case a stack trace is produced). =back =head1 DETAILS =head2 Available back-ends When a dispatcher is created (via L or L), you must specify the TYPE of the dispatcher. This can either be a class name, which extends a L, or a pre-defined abbreviation of a class name. Implemented are: =over 4 =item L (abbreviation 'PERL') Use Perl's own C, C and C to ventilate reports. This is the default dispatcher. =item L (abbreviation 'FILE') Logs the message into a file, which can either be opened by the class or be opened before the dispatcher is created. =item L (abbreviation 'SYSLOG') Send messages into the system's syslog infrastructure, using Sys::Syslog. =item L (abbreviation 'CALLBACK') Calls any CODE reference on receipt of each selected message, for instance to send important message as email or SMS. =item C All of the Log::Dispatch::Output extensions can be used directly. The L will wrap around that back-end. =item C Use the Log::Log4perl main object to write to dispatchers. This infrastructure uses a configuration file. =item L (abbreviation 'TRY') Used by function L. It collects the exceptions and can produce them on request. =back =head2 Processing the message =head3 Addition information The modules which use C will only specify the base of the message string. The base dispatcher and the back-ends will extend this message with additional information: =over 4 =item . the reason =item . the filename/line-number where the problem appeared =item . the filename/line-number where it problem was reported =item . the error text in C<$!> =item . a stack-trace =item . a trailing new-line =back When the message is a translatable object (L, for instance created with L), then the added components will get translated as well. Otherwise, all will be in English. Exactly what will be added depends on the actual mode of the dispatcher (change it with L, initiate it with L). mode mode mode mode REASON SOURCE TE! NORM VERB ASSE DEBUG trace program ... S assert program ... SL SL info program T.. S S S notice program T.. S S S S mistake user T.. S S S SL warning program T.. S S SL SL error user TE. S S SL SC fault system TE! S S SL SC alert system T.! S S SC SC failure system TE! S S SC SC panic program .E. SC SC SC SC T - usually translated E - exception (execution interrupted) ! - will include $! text at display L - include filename and linenumber S - show/print when accepted C - stack trace (like Carp::confess()) =head3 Filters With a filter, you can block or modify specific messages before translation. There may be a wish to change the REASON of a report or its content. It is not possible to avoid the exit which is related to the original message, because a module's flow depends on it to happen. When there are filters defined, they will be called in order of definition. For each of the dispatchers which are called for a certain REASON (which C that REASON), it is checked whether its name is listed for the filter (when no names where specified, then the filter is applied to all dispatchers). When selected, the filter's CODE reference is called with four arguments: the dispatcher object (a L), the HASH-of-OPTIONS passed as optional first argument to L, the REASON, and the MESSAGE. Returned is the new REASON and MESSAGE. When the returned REASON is C, then the message will be ignored for that dispatcher. Be warned about processing the MESSAGE: it is a L object which may have a C string and C string or object. When the call to L contained multiple comma-separated components, these will already have been joined together using concatenation (see L. =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Message.pm0000644000175000001440000001040512231427545020744 0ustar00markovusers00000000000000# 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::Message; use vars '$VERSION'; $VERSION = '0.998'; use Log::Report 'log-report'; use POSIX qw/locale_h/; use List::Util qw/first/; use overload '""' => 'toString' , '&{}' => sub { my $obj = shift; sub{$obj->clone(@_)} } , '.' => 'concat'; sub new($@) { my ($class, %s) = @_; if(ref $s{_count}) { my $c = $s{_count}; $s{_count} = ref $c eq 'ARRAY' ? @$c : keys %$c; } defined $s{_join} or $s{_join} = $"; if($s{_msgid}) { $s{_append} = defined $s{_append} ? $1.$s{_append} : $1 if $s{_msgid} =~ s/(\s+)$//; $s{_prepend}.= $1 if $s{_msgid} =~ s/^(\s+)//; } if($s{_plural}) { s/\s+$//, s/^\s+// for $s{_plural}; } bless \%s, $class; } sub clone(@) { my $self = shift; (ref $self)->new(%$self, @_); } sub fromTemplateToolkit($$;@) { my ($class, $domain, $msgid) = splice @_, 0, 3; my $plural = $msgid =~ s/\|(.*)// ? $1 : undef; my $args = @_ && ref $_[-1] eq 'HASH' ? pop : {}; my $count; if(defined $plural) { @_==1 or $msgid .= " (ERROR: missing count for plural)"; $count = shift || 0; $count = @$count if ref $count eq 'ARRAY'; } else { @_==0 or $msgid .= " (ERROR: only named parameters expected)"; } $class->new ( _msgid => $msgid, _plural => $plural, _count => $count , %$args, _expand => 1, _domain => $domain); } sub prepend() {shift->{_prepend}} sub msgid() {shift->{_msgid}} sub append() {shift->{_append}} sub domain() {shift->{_domain}} sub count() {shift->{_count}} sub classes() { my $class = $_[0]->{_class} || $_[0]->{_classes} || []; ref $class ? @$class : split(/[\s,]+/, $class); } sub to(;$) { my $self = shift; @_ ? $self->{_to} = shift : $self->{_to}; } sub valueOf($) { $_[0]->{$_[1]} } sub inClass($) { my @classes = shift->classes; ref $_[0] eq 'Regexp' ? (first { $_ =~ $_[0] } @classes) : (first { $_ eq $_[0] } @classes); } sub toString(;$) { my ($self, $locale) = @_; my $count = $self->{_count} || 0; $self->{_msgid} # no translation, constant string or return (defined $self->{_prepend} ? $self->{_prepend} : '') . (defined $self->{_append} ? $self->{_append} : ''); # create a translation my $text = Log::Report->translator($self->{_domain}) ->translate($self, $locale); defined $text or return (); my $oldloc; if(defined $locale) { $oldloc = setlocale(LC_ALL); setlocale(LC_ALL, $locale); } if($self->{_expand}) { my $re = join '|', map quotemeta, keys %$self; $text =~ s/\{($re)(\%[^}]*)?\}/$self->_expand($1,$2)/ge; } $text = "$self->{_prepend}$text" if defined $self->{_prepend}; $text .= "$self->{_append}" if defined $self->{_append}; setlocale(LC_ALL, $oldloc) if defined $oldloc && $oldloc ne $locale; $text; } sub _expand($$) { my ($self, $key, $format) = @_; my $value = $self->{$key}; $value = $value->($self) while ref $value eq 'CODE'; defined $value or return "undef"; use locale; if(ref $value eq 'ARRAY') { my @values = map {defined $_ ? $_ : 'undef'} @$value; @values or return '(none)'; return $format ? join($self->{_join}, map sprintf($format, $_), @values) : join($self->{_join}, @values); } $format ? sprintf($format, $value) : "$value"; # enforce stringification on objects } sub untranslated() { my $self = shift; (defined $self->{_prepend} ? $self->{_prepend} : '') . (defined $self->{_msgid} ? $self->{_msgid} : '') . (defined $self->{_append} ? $self->{_append} : ''); } sub concat($;$) { my ($self, $what, $reversed) = @_; if($reversed) { $what .= $self->{_prepend} if defined $self->{_prepend}; return ref($self)->new(%$self, _prepend => $what); } $what = $self->{_append} . $what if defined $self->{_append}; ref($self)->new(%$self, _append => $what); } 1; Log-Report-0.998/lib/Log/Report/Extract/0000755000175000001440000000000012231427551020431 5ustar00markovusers00000000000000Log-Report-0.998/lib/Log/Report/Extract/PerlPPI.pod0000644000175000001440000001067212231427545022421 0ustar00markovusers00000000000000=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'); # call for each .pm file $ppi->showStats; # optional $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 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<$lexicon/$domain.po> file will be created. If you want to start a translation, copy C<$lexicon/$domain.po> to C<$lexicon/$domain/$lang.po> and edit that file. You may use C to edit po-files. Do not forget to add the new po-file to your distribution (MANIFEST) See L. =head2 The extraction process All pm-files need to be processed in one go: no incremental processing! The Perl source is parsed using PPI, which does understand Perl syntax quite well, but does not support all features. Automatically, the textdomain of the translations is discovered, as first parameter of C. You may switch textdomain inside one pm-file. When all files have been processed, during the L, all existing po-files for all discovered textdomains will get updated. Not only the C<$lexicon/$domain.po> template, but also all C<$lexicon/$domain/$lang.po> will be replaced. When a msgid has disappeared, existing translations will get disabled, not removed. New msgids will be added and flagged "fuzzy". =head3 What is extracted? This script will extract the msgids used in C<__()>, C<__x()>, C<__xn()>, and C<__n()> (implemented by L) For instance __x"msgid", @more __x'msgid', @more <--- no! syntax error! __x("msgid", @more) __x('msgid', @more) __x(msgid => @more) Besides, there are some helpers which are no-ops in the code, only to fill the po-tables: C, C, C =head3 What is not extracted? B extracted are the usage of anything above, where the first parameter is not a simple string. Not extracted are __x($format, @more) __x$format, @more __x(+$format, _domain => 'other domain', @more) __x($first.$second, @more) In these cases, you have to use C functions to declare the possible values of C<$format>. =head1 METHODS See L. =head2 Constructors See L. =over 4 =item Log::Report::Extract::PerlPPI-EB(OPTIONS) See L =back =head2 Accessors See L. =over 4 =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB(DOMAIN) See L =back =head2 Processors See L. =over 4 =item $obj-EB(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-EB([DOMAINs]) See L =item $obj-EB(DOMAIN, FILENAME, LINENR, MSG, [MSG_PLURAL]) See L =item $obj-EB([DOMAIN]) See L =back =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Extract/PerlPPI.pm0000644000175000001440000001354112231427545022251 0ustar00markovusers00000000000000# 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.998'; 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] ); my $quote_mistake; { my @q = map quotemeta, keys %msgids; local $" = '|'; $quote_mistake = qr/^(?:@q)\'/; } 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 perl 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 $word = $node->content; if($word =~ $quote_mistake) { warning __x"use double quotes not single, in {string} on {file} line {line}" , string => $word, fn => $fn, line => $node->location->[0]; return 0; } my $def = $msgids{$word} # get __() description or return 0; my @msgids = $self->_get($node, $domain, $word, $def) or return 0; my ($nr_msgids, $has_count, $has_opts, $has_vars,$do_split) = @$def; 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($do_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, $domain, $function, $def) = @_; my ($nr_msgids, $has_count, $opts, $vars, $split) = @$def; my $list_only = ($nr_msgids > 1) || $has_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'); my $line; while(defined $first && $nr_msgids > @msgids) { my $msgid; my $next = $first->snext_sibling; my $sep = $next && $next->isa('PPI::Token::Operator') ? $next : ''; $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/(? $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/(?snext_sibling; } @msgids or return (); my $next = $first->snext_sibling; if($has_count && !$next) { error __x"count missing in {function} in line {line}" , function => $function, line => $line; } @msgids; } 1; Log-Report-0.998/lib/Log/Report/Extract/Template.pod0000644000175000001440000001316112231427545022715 0ustar00markovusers00000000000000=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 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. =head1 METHODS See L. =head2 Constructors See L. =over 4 =item Log::Report::Extract::Template-EB(OPTIONS) -Option --Defined in --Default charset Log::Report::Extract 'utf-8' domain lexicon Log::Report::Extract pattern =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. =over 4 =item $obj-EB() See L =item $obj-EB() =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() =item $obj-EB(DOMAIN) See L =back =head2 Processors See L. =over 4 =item $obj-EB(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 =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-EB([DOMAINs]) See L =item $obj-EB(DOMAIN, FILENAME, LINENR, MSG, [MSG_PLURAL]) See L =item $obj-EB([DOMAIN]) See L =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 (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-- 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.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Extract/Template.pm0000644000175000001440000000771612231427545022560 0ustar00markovusers00000000000000# 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.998'; 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 = ; 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; Log-Report-0.998/lib/Log/Report/Translator.pm0000644000175000001440000000271712231427545021520 0ustar00markovusers00000000000000# 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::Translator; use vars '$VERSION'; $VERSION = '0.998'; use warnings; use strict; use File::Spec (); use Log::Report 'log-report', syntax => 'SHORT'; use Log::Report::Lexicon::Index (); use Log::Report::Message; my %lexicons; sub _filename_to_lexicon($); sub new(@) { my $class = shift; (bless {}, $class)->init( {callerfn => (caller)[1], @_} ); } sub init($) { my ($self, $args) = @_; my $lex = delete $args->{lexicons} || delete $args->{lexicon} || _filename_to_lexicon $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); } $self->{lexicons} = \@lex; $self->{charset} = $args->{charset} || 'utf-8'; $self; } sub _filename_to_lexicon($) { my $fn = shift; $fn =~ s/\.pm$//; File::Spec->catdir($fn, 'messages'); } sub lexicons() { @{shift->{lexicons}} } sub charset() {shift->{charset}} # this is called as last resort: if a translator cannot find # any lexicon or has no matching language. sub translate($) { my $msg = $_[1]; defined $msg->{_count} && $msg->{_count} != 1 ? $msg->{_plural} : $msg->{_msgid}; } sub load($@) { undef } 1; Log-Report-0.998/lib/Log/Report/Lexicon/0000755000175000001440000000000012231427551020420 5ustar00markovusers00000000000000Log-Report-0.998/lib/Log/Report/Lexicon/PO.pod0000644000175000001440000001257012231427545021452 0ustar00markovusers00000000000000=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. =head1 METHODS =head2 Constructors =over 4 =item Log::Report::Lexicon::PO-EB(OPTIONS) -Option --Default automatic "" comment [] format [] fuzzy false msgctxt undef msgid msgid_plural undef msgstr "" or [] references [] =over 2 =item automatic => PARAGRAPH Automatically added comments. See L. =item comment => PARAGRAPH Translator added comments. See L. =item format => ARRAY-OF-PAIRS|HASH See L. =item fuzzy => BOOLEAN The string is not yet translated, some smart guesses may have been made. See L. =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, for instance C See L =back =back =head2 Attributes =over 4 =item $obj-EB(LIST|ARRAY|STRING) Add multiple lines to the translator's comment block. Returns an empty string if there are no comments. =item $obj-EB(LIST|ARRAY|STRING) Add multiple lines to the translator's comment block. Returns an empty string if there are no comments. =item $obj-EB(STRING) Parse a "flags" line. =item $obj-EB(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. Returns the internal HASH with references. =item $obj-EB([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-EB([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-EB(LANGUAGE|PAIRS|ARRAY-OF-PAIRS|HASH) When one LANGUAGE is specified, it looks whether a C or C 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 (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. 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-EB([BOOLEAN]) Returns whether the translation needs human inspection. =item $obj-EB() Returns whether the translation has any references, or is the header. =item $obj-EB() Returns the message context, if provided. =item $obj-EB() Returns the actual msgid, which cannot be C. =item $obj-EB([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-EB([STRING]) Returns the actual msgid_plural, which can be C. =item $obj-EB([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-EB(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-EB(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-EB(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-EB() The message-id has no references anymore and no translations. =back =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Lexicon/POTcompact.pod0000644000175000001440000000752112231427545023145 0ustar00markovusers00000000000000=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. See L. =head1 METHODS See L. =head2 Constructors See L. =over 4 =item Log::Report::Lexicon::POTcompact-EB(OPTIONS) See L =item Log::Report::Lexicon::POTcompact-EB(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 =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. =over 4 =item $obj-EB() Returns the name of the source file for this data. =item $obj-EB() Returns a HASH of all defined PO objects, organized by msgid. Please try to avoid using this: use L for lookup. =back =head2 Managing PO's See L. =head3 Translation See L. =over 4 =item $obj-EB(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 when the translation is not defined. =item $obj-EB(MSGID, [COUNT]) Returns the translated string for MSGID. When not specified, COUNT is 1 (the single form). =back =head3 Administration See L. =over 4 =item $obj-EB(PO) See L =item $obj-EB
(FIELD) See L =item $obj-EB() See L =item $obj-EB(COUNT) See L =item $obj-EB() See L =item $obj-EB([ACTIVE]) See L =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.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Lexicon/Table.pod0000644000175000001440000000466512231427545022171 0ustar00markovusers00000000000000=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-EB(OPTIONS) =back =head2 Attributes =head2 Managing PO's =head3 Translation =over 4 =item $obj-EB(STRING) Lookup the L with the STRING. Returns C when not defined. =item $obj-EB(MSGID, [COUNT]) Returns the translated string for MSGID. When not specified, COUNT is 1. =back =head3 Administration =over 4 =item $obj-EB(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-EB
(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-EB() Returns the number of plurals, when not known then '2'. =item $obj-EB(COUNT) Returns the msgstr index used to translate a value of COUNT. =item $obj-EB() 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 header field. =item $obj-EB([ACTIVE]) Returns a list with all defined L objects. When the string C 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.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Lexicon/Index.pod0000644000175000001440000001355712231427545022211 0ustar00markovusers00000000000000=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-EB(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 =item . [0.993] files with extension "mo", see L =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-EB() Returns the directory name. =back =head2 Search =over 4 =item $obj-EB(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-EB(TEXTDOMAIN, LOCALE) Lookup the best translation table, according to the rules described in chapter L, below. Returned is a filename, or C if nothing is defined for the LOCALE (there is no default on this level). =item $obj-EB() 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-EB(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 or only C 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 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 followed by C<.po> are added. This is exactly as C 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 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 and installed in some of perl's directories, say C<~perl5>. The module is defining textdomain C. The translation is made into C (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.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Lexicon/PO.pm0000644000175000001440000002142512231427545021303 0ustar00markovusers00000000000000# 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.998'; 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; Log-Report-0.998/lib/Log/Report/Lexicon/POTcompact.pm0000644000175000001440000000554212231427545023000 0ustar00markovusers00000000000000# 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.998'; 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; Log-Report-0.998/lib/Log/Report/Lexicon/POT.pm0000644000175000001440000001371512231427545021432 0ustar00markovusers00000000000000# 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.998'; 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; Log-Report-0.998/lib/Log/Report/Lexicon/POT.pod0000644000175000001440000001664412231427545021604 0ustar00markovusers00000000000000=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. The code is loosely based on Locale::PO, by Alan Schwartz. The coding style is a bit off the rest of C, and there was a need to sincere simplification. Each PO record will be represented by a L. See L. =head1 METHODS See L. =head2 Constructors See L. =over 4 =item Log::Report::Lexicon::POT-EB(OPTIONS) Create a new POT file. The initial header is generated for you, but it can be changed using the L method. -Option --Default charset date now filename undef index {} nr_plurals 2 plural_alg n!=1 plural_forms textdomain 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 is called. =item index => HASH A set of translations (L 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 and C. 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-EB(FILENAME, OPTIONS) Read the POT information from FILENAME. -Option --Default charset =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-EB([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 or the filename was explicitly set with L, then you may omit the first parameter. =back =head2 Attributes See L. =over 4 =item $obj-EB() 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-EB() Returns the FILENAME, as derived from L or specified during initiation with L. =item $obj-EB() Returns a HASH of all defined PO objects, organized by msgid. Please try to avoid using this: use L for lookup and L for adding translations. =back =head2 Managing PO's See L. =over 4 =item $obj-EB(FILENAME) Remove all the references to the indicate FILENAME from all defined translations. Returns the number of refs left. =item $obj-EB() Returns a HASH with some statistics about this POT table. =item $obj-EB([DATE]) Replace the "PO-Revision-Date" with the specified DATE, or the current moment. =back =head3 Translation See L. =over 4 =item $obj-EB(STRING) Lookup the L with the STRING. If you want to add a new translation, use L. Returns C when not defined. =item $obj-EB(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. =over 4 =item $obj-EB(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-EB
([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, the field will be removed. =item $obj-EB() See L =item $obj-EB(COUNT) See L =item $obj-EB() See L =item $obj-EB([ACTIVE]) Returns a list with all defined L objects. When the string C 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 method, or known because the write follows a L 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.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Lexicon/MOTcompact.pod0000644000175000001440000000752712231427545023150 0ustar00markovusers00000000000000=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. =head1 METHODS See L. =head2 Constructors See L. =over 4 =item Log::Report::Lexicon::MOTcompact-EB(OPTIONS) See L =item Log::Report::Lexicon::MOTcompact-EB(FILENAME, OPTIONS) Read the MOT table information from FILENAME. The msgctxt (context) is ignored. -Option --Default charset take_all =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. =over 4 =item $obj-EB() Returns the name of the source file for this data. =item $obj-EB() Returns a HASH of all defined PO objects, organized by msgid. Please try to avoid using this: use L for lookup. =back =head2 Managing PO's See L. =head3 Translation See L. =over 4 =item $obj-EB(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 when the translation is not defined. =item $obj-EB(MSGID, [COUNT]) Returns the translated string for MSGID. When not specified, COUNT is 1 (the singular form). =back =head3 Administration See L. =over 4 =item $obj-EB(PO) See L =item $obj-EB
(FIELD) See L =item $obj-EB() See L =item $obj-EB(COUNT) See L =item $obj-EB() See L =item $obj-EB([ACTIVE]) See L =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.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Lexicon/Index.pm0000644000175000001440000000714012231427545022032 0ustar00markovusers00000000000000# 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.998'; 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 = ''; # 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; Log-Report-0.998/lib/Log/Report/Lexicon/Table.pm0000644000175000001440000000300512231427545022006 0ustar00markovusers00000000000000# 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.998'; 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; Log-Report-0.998/lib/Log/Report/Lexicon/MOTcompact.pm0000644000175000001440000001344312231427545022774 0ustar00markovusers00000000000000# 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.998'; 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; Log-Report-0.998/lib/Log/Report/Exception.pod0000644000175000001440000000721312231427545021467 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Exception - a collected report =head1 SYNOPSIS # created within a try block try { error "help!" }; my $exception = $@->wasFatal; $exception->throw if $exception; $@->reportFatal; # combination of above two lines my $message = $exception->message; # the Log::Report::Message if($message->inClass('die')) ... if($exception->inClass('die')) ... # same if($@->wasFatal(class => 'die')) ... # same =head1 DESCRIPTION In Log::Report, exceptions are not as extended as available in languages as Java: you do not create classes for them. The only thing an exception object does, is capture some information about an (untranslated) report. =head1 METHODS =head2 Constructors =over 4 =item Log::Report::Exception-EB(OPTIONS) -Option --Default message reason report_opts {} =over 2 =item message => Log::Report::Message =item reason => REASON =item report_opts => HASH =back =back =head2 Accessors =over 4 =item $obj-EB() Returns whether this exception has a severity which makes it fatal when thrown. See L. example: if($ex->isFatal) { $ex->throw(reason => 'ALERT') } else { $ex->throw } =item $obj-EB([MESSAGE]) Change the MESSAGE of the exception, must be a L object. When you use a C object, you will get a new one returned. Therefore, if you want to modify the message in an exception, you have to re-assign the result of the modification. example: $e->message->concat('!!')); # will not work! $e->message($e->message->concat('!!')); $e->message(__x"some message {msg}", msg => $xyz); =item $obj-EB([REASON]) =item $obj-EB() =back =head2 Processing =over 4 =item $obj-EB(CLASS|REGEX) Check whether any of the classes listed in the message match CLASS (string) or the REGEX. This uses L. =item $obj-EB([FILEHANDLE]) The default filehandle is STDOUT. example: print $exception; # via overloading $exception->print; # OO style =item $obj-EB(OPTIONS) Insert the message contained in the exception into the currently defined dispatchers. The C name is commonly known exception related terminology for C. The OPTIONS overrule the captured options to L. This can be used to overrule a destination. Also, the reason can be changed. example: overrule defaults to report try { print {to => 'stderr'}, ERROR => 'oops!' }; $@->reportFatal(to => 'syslog'); $exception->throw(to => 'syslog'); $@->wasFatal->throw(reason => 'WARNING'); =item $obj-EB() Prints the reason and the message. Differently from L, this only represents the textual content: it does not re-cast the exceptions to higher levels. example: printing exceptions print $_->toString for $@->exceptions; print $_ for $@->exceptions; # via overloading =back =head1 OVERLOADING =over 4 =item overload: B() Produces "reason: message". =back =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Util.pm0000644000175000001440000000722212231427545020300 0ustar00markovusers00000000000000# 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.998'; 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; Log-Report-0.998/lib/Log/Report/Message.pod0000644000175000001440000003652512231427545021125 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Message - a piece of text to be translated =head1 SYNOPSIS # Created by Log::Report's __ functions # Full feature description in the DETAILS section # no interpolation __"Hello, World"; # with interpolation __x"age {years}", years => 12; # interpolation for one or many my $nr_files = @files; __nx"one file", "{_count} files", $nr_files; __nx"one file", "{_count} files", \@files; # interpolation of arrays __x"price-list: {prices%.2f}", prices => \@prices, _join => ', '; # white-spacing on msgid preserved print __"\tCongratulations,\n"; print "\t", __("Congratulations,"), "\n"; # same =head1 DESCRIPTION Any use of a translation function exported by L, like C<__()> (the function is named underscore-underscore) or C<__x()> (underscore-underscore-x) will result in this object. It will capture some environmental information, and delay the translation until it is needed. Creating an object first and translating it later, is slower than translating it immediately. However, on the location where the message is produced, we do not yet know in what language to translate it to: that depends on the front-end, the log dispatcher. =head1 METHODS =head2 Constructors =over 4 =item $obj-EB(OPTIONS, VARIABLES) Returns a new object which copies info from original, and updates it with the specified OPTIONS and VARIABLES. The advantage is that the cached translations are shared between the objects. example: use of clone() my $s = __x "found {nr} files", nr => 5; my $t = $s->clone(nr => 3); my $t = $s->(nr => 3); # equivalent print $s; # found 5 files print $t; # found 3 files =item Log::Report::Message-EB(DOMAIN, MSGID, PARAMS) See L on the details how to integrate Log::Report translations with Template::Toolkit (version 1 and 2) =item Log::Report::Message-EB(OPTIONS) B, but use L and friends. The OPTIONS is a mixed list of object initiation parameters (all with a leading underscore) and variables to be filled in into the translated C<_msgid> string. -Option --Default _append undef _category undef _class [] _classes [] _count undef _domain _expand false _join $" $LIST_SEPARATOR _msgid undef _plural undef _prepend undef _to =over 2 =item _append => STRING|MESSAGE Text as STRING or MESSAGE object to be displayed after the display of this message. =item _category => INTEGER The category when the real gettext library is used, for instance LC_MESSAGES. =item _class => STRING|ARRAY When messages are used for exception based programming, you add C<_class> parameters to the argument list. Later, with for instance L, you can check the category of the message. One message can be part of multiple classes. The STRING is used as comma- and/or blank separated list of class tokens (barewords), the ARRAY lists all tokens separately. See L. =item _classes => STRING|ARRAY Alternative for C<_class>, which cannot be used at the same time. =item _count => INTEGER|ARRAY|HASH When defined, the C<_plural> need to be defined as well. When an ARRAY is provided, the length of the ARRAY is taken. When a HASH is given, the number of keys in the HASH is used. =item _domain => STRING The text-domain (translation table) to which this C<_msgid> belongs. With this parameter, your can "borrow" translations from other textdomains. Be very careful with this (although there are good use-cases) The xgettext msgid extractor may add the used msgid to this namespace as well. To avoid that, add a harmless '+': print __x(+"errors", _domain => 'global'); The extractor will not take the msgid when it is an expression. The '+' has no effect on the string at runtime. =item _expand => BOOLEAN Indicates whether variables are to be filled-in. =item _join => STRING Which STRING to be used then an ARRAY is being filled-in. =item _msgid => MSGID The message label, which refers to some translation information. Usually a string which is close the English version of the message. This will also be used if there is no translation possible/known. Leading white-space C<\s> will be added to C<_prepend>. Trailing white-space will be added before C<_append>. =item _plural => MSGID Can be used together with C<_count>. This plural form of the C<_msgid> text is used to simplify the work of translators, and as fallback when no translation is possible: therefore, this can best resemble an English message. White-space at the beginning and end of the string are stripped off. The white-space provided by the C<_msgid> will be used. =item _prepend => STRING|MESSAGE Text as STRING or MESSAGE object to be displayed before the display of this message. =item _to => NAME Specify the NAME of a dispatcher as destination explicitly. Short for C<< report {to => NAME}, ... >> See L =back =back =head2 Accessors =over 4 =item $obj-EB() Returns the string or L object which is appended after this one. Usually C. =item $obj-EB() Returns the LIST of classes which are defined for this message; message group indicators, as often found in exception-based programming. =item $obj-EB() Returns the count, which is used to select the translation alternatives. =item $obj-EB() Returns the domain of the first translatable string in the structure. =item $obj-EB() Returns the msgid which will later be translated. =item $obj-EB() Returns the string which is prepended to this one. Usually C. =item $obj-EB([NAME]) Returns the NAME of a dispatcher if explicitly specified with the '_to' key. Can also be used to set it. Usually, this will return undef, because usually all dispatchers get all messages. =item $obj-EB(PARAMETER) Lookup the named PARAMETER for the message. All pre-defined names have their own method which should be used with preference. example: When the message was produced with my @files = qw/one two three/; my $msg = __xn "found one file: {file}" , "found {nrfiles} files: {files}" , scalar @files , file => $files[0] , files => \@files , nrfiles => @files+0 , _class => 'IO, files' , _join => ', '; then the values can be takes from the produced message as my $files = $msg->valueOf('files'); # returns ARRAY reference print @$files; # 3 my $count = $msg->count; # 3 my @class = $msg->classes; # 'IO', 'files' if($msg->inClass('files')) # true Simplified, the above example can also be written as: local $" = ', '; my $msg = __xn "found one file: {files}" , "found {_count} files: {files}" , @files # has scalar context , files => \@files , _class => 'IO, files'; =back =head2 Processing =over 4 =item $obj-EB(STRING|OBJECT, [PREPEND]) This method implements the overloading of concatenation, which is needed to delay translations even longer. When PREPEND is true, the STRING or OBJECT (other C) needs to prepended, otherwise it is appended. example: of concatenation print __"Hello" . ' ' . __"World!"; print __("Hello")->concat(' ')->concat(__"World!")->concat("\n"); =item $obj-EB(CLASS|REGEX) Returns true if the message is in the specified CLASS (string) or matches the REGEX. The trueth value is the (first matching) class. =item $obj-EB([LOCALE]) Translate a message. If not specified, the default locale is used. =item $obj-EB() Return the concatenation of the prepend, msgid, and append strings. Variable expansions within the msgid is not performed. =back =head1 DETAILS =head2 OPTIONS and VARIABLES The L functions which define translation request can all have OPTIONS. Some can have VARIABLES to be interpolated in the string as well. To distinguish between the OPTIONS and VARIABLES (both a list of key-value pairs), the keys of the OPTIONS start with an underscore C<_>. As result of this, please avoid the use of keys which start with an underscore in variable names. On the other hand, you are allowed to interpolate OPTION values in your strings. =head3 Interpolating With the C<__x()> or C<__nx()>, interpolation will take place on the translated MSGID string. The translation can contain the VARIABLE and OPTION names between curly brackets. Text between curly brackets which is not a known parameter will be left untouched. fault __x"cannot open open {filename}", filename => $fn; print __xn"directory {dir} contains one file" ,"directory {dir} contains {nr_files} files" , scalar(@files) # (1) (2) , nr_files => scalar @files # (3) , dir => $dir; (1) this required third parameter is used to switch between the different plural forms. English has only two forms, but some languages have many more. (2) the "scalar" keyword is not needed, because the third parameter is in SCALAR context. You may also pass C< \@files > there, because ARRAYs will be converted into their length. A HASH will be converted into the number of keys in the HASH. (3) the C keyword is required here, because it is LIST context: otherwise all filenames will be filled-in as parameters to C<__xn()>. See below for the available C<_count> valure, to see how the C parameter can disappear. =head3 Interpolation of VARIABLES There is no way of checking beforehand whether you have provided all required values, to be interpolated in the translated string. For interpolating, the following rules apply: =over 4 =item * Simple scalar values are interpolated "as is" =item * References to SCALARs will collect the value on the moment that the output is made. The C object which is created with the C<__xn> can be seen as a closure. The translation can be reused. See example below. =item * Code references can be used to create the data "under fly". The C object which is being handled is passed as only argument. This is a hash in which all OPTIONS and VARIABLES can be found. =item * When the value is an ARRAY, all members will be interpolated with C<$"> between the elements. Alternatively (maybe nicer), you can pass an interpolation parameter via the C<_join> OPTION. =back local $" = ', '; error __x"matching files: {files}", files => \@files; error __x"matching files: {files}", files => \@files, _join => ', '; =head3 Interpolating formatted Next to the name, you can specify a format code. With C, 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, 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 simplify your coding. The useful names are: =over 4 =item _msgid The MSGID as provided with L and L =item _plural, _count The PLURAL MSGIDs, respectively the COUNT as used with L and L =item _textdomain The label of the textdomain in which the translation takes place. =item _class or _classes Are to be used to group reports, and can be queried with L, L, or L. =back =head3 Handling white-spaces In above examples, the msgid and plural form have a trailing new-line. In general, it is much easier to write print __x"Hello, World!\n"; than print __x("Hello, World!") . "\n"; For the translation tables, however, that trailing new-line is "over information"; it is an layout issue, not a translation issue. Therefore, the first form will automatically be translated into the second. All leading and trailing white-space (blanks, new-lines, tabs, ...) are removed from the msgid befor the look-up, and then added to the translated string. Leading and trailing white-space on the plural form will also be removed. However, after translation the spacing of the msgid will be used. =head3 Avoiding repetative translations This way of translating is somewhat expensive, because an object to handle the C<__x()> is created each time. for my $i (1..100_000) { print __x "Hello World {i}\n", i => $i; } The suggestion that Locale::TextDomain makes to improve performance, is to get the translation outside the loop, which only works without interpolation: use Locale::TextDomain; my $i = 42; my $s = __x("Hello World {i}\n", i => $i); foreach $i (1..100_000) { print $s; } Oops, not what you mean. With Log::Report, you can do it. use Log::Report; my $i; my $s = __x("Hello World {i}\n", i => \$i); foreach $i (1..100_000) { print $s; } Mind you not to write: C in above case!!!! You can also write an incomplete translation: use Log::Report; my $s = __x "Hello World {i}\n"; foreach my $i (1..100_000) { print $s->(i => $i); } In either case, the translation will be looked-up only once. =head1 OVERLOADING =over 4 =item overload: B() When the object is used to call as function, a new object is created with the data from the original one but updated with the new parameters. Implemented in C. =item overload: B() An (accidental) use of concatenation (a dot where a comma should be used) would immediately stringify the object. This is avoided by overloading that operation. =item overload: B() When the object is used in string context, it will get translated. Implemented as L. =back =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/messages/0000755000175000001440000000000012231427551020626 5ustar00markovusers00000000000000Log-Report-0.998/lib/Log/Report/messages/log-report/0000755000175000001440000000000012231427551022720 5ustar00markovusers00000000000000Log-Report-0.998/lib/Log/Report/messages/log-report/nl_NL.po0000644000175000001440000003661112231427544024273 0ustar00markovusers00000000000000#. Header generated with Log::Report::Lexicon::POT 0.0 msgid "" msgstr "" "Project-Id-Version: log-report 0.01\n" "Report-Msgid-Bugs-To:\n" "POT-Creation-Date: 2007-05-14 17:14+0200\n" "PO-Revision-Date: 2013-08-22 16:17+0200\n" "Last-Translator: Mark Overmeer \n" "Language-Team:\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=utf-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n!=1);\n" #: lib/Log/Report/Util.pm:14 msgid "ALERT" msgstr "ALARM" #: lib/Log/Report/Util.pm:14 msgid "ASSERT" msgstr "CONDITIE" #: lib/Log/Report/Util.pm:14 msgid "ERROR" msgstr "ERROR" #: lib/Log/Report/Util.pm:14 msgid "FAILURE" msgstr "STORING" #: lib/Log/Report/Util.pm:14 msgid "FAULT" msgstr "PROBLEEM" #: lib/Log/Report/Util.pm:14 msgid "INFO" msgstr "INFO" #: lib/Log/Report/Dispatcher/LogDispatch.pm:105 msgid "Log::Dispatch level '{level}' not understood" msgstr "Log::Dispatch level '{level}' niet herkend" #: lib/Log/Report/Dispatcher/Log4perl.pm:100 msgid "Log::Log4perl back-end {name} requires a 'config' parameter" msgstr "Log::Log4perl back-end {name} verwacht een 'config' argument" #: lib/Log/Report/Dispatcher/Log4perl.pm:111 msgid "Log::Log4perl level '{level}' must be in 0-5" msgstr "Log::Log4perl level '{level}' is getal van 0 tot 5" #: lib/Log/Report/Util.pm:14 msgid "MISTAKE" msgstr "FOUT" #: lib/Log/Report/Util.pm:14 msgid "NOTICE" msgstr "OPGELET" #: lib/Log/Report/Dispatcher/Log4perl.pm:27 #: lib/Log/Report/Dispatcher/LogDispatch.pm:27 #: lib/Log/Report/Dispatcher/Syslog.pm:28 msgid "Not all reasons have a default translation" msgstr "Niet alle redenen hebben een default vertaling" #: lib/Log/Report/Util.pm:14 msgid "PANIC" msgstr "PANIEK" #: lib/Log/Report/Extract/PerlPPI.pm:66 msgid "PPI only supports iso-8859-1 (latin-1) on the moment" msgstr "PPI ondersteunt momenteel alleen iso-8859-1 (latin-1)" #: lib/Log/Report/Dispatcher.pm:152 msgid "Perl does not support charset {cs}" msgstr "Perl heeft geen support voor tekenset {cs}" #: lib/Log/Report/Util.pm:14 msgid "TRACE" msgstr "TRACE" #: lib/Log/Report/Util.pm:14 msgid "WARNING" msgstr "WAARSCHUWING" #: lib/Log/Report.pm:256 msgid "a message object is reported with more parameters" msgstr "een message object vergezeld van meer parameters" #: lib/Log/Report/Dispatcher.pm:299 lib/Log/Report/Dispatcher.pm:309 msgid "at {filename} line {line}" msgstr "in {filename} regel {line}" #: lib/Log/Report/Extract.pm:50 msgid "cannot create lexicon directory {dir}" msgstr "kan lexicon map {dir} niet aanmaken" #: bin/xgettext-perl:57 msgid "cannot create output directory {dir}" msgstr "uitvoer map {dir} kan niet worden aangemaakt" #: lib/Log/Report/Dispatcher/Log4perl.pm:121 msgid "cannot find logger '{name}' in configuration {config}" msgstr "kan logger '{name}' in configuratie {config} niet vinden" #: bin/xgettext-perl:65 msgid "cannot read filename list from {fn}" msgstr "lijst met filenamen {fn} kan niet worden gelezen" #: lib/Log/Report/Extract/PerlPPI.pm:69 msgid "cannot read from file {filename}" msgstr "kan bestand {filename} niet lezen" #: lib/Log/Report/Lexicon/MOTcompact.pm:70 lib/Log/Report/Lexicon/POT.pm:149 #: lib/Log/Report/Lexicon/POTcompact.pm:60 msgid "cannot read in {cs} from file {fn}" msgstr "kan bestand {fn} niet lezen in {cs}" #: lib/Log/Report/Lexicon/MOTcompact.pm:77 #, fuzzy msgid "cannot read magic from {fn}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:129 #, fuzzy msgid "cannot read msgids from {fn}, need {size} at {loc}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:101 #, fuzzy msgid "cannot read originals from {fn}, need {size} at {loc}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:87 #, fuzzy msgid "cannot read superblock from {fn}" msgstr "" #: lib/Log/Report/Extract/Template.pm:98 msgid "cannot read template from {fn}" msgstr "template {fn} kan niet worden gelezen" #: lib/Log/Report/Lexicon/MOTcompact.pm:208 #, fuzzy msgid "cannot read transl late from {fn}, need {size} at {loc}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:112 #: lib/Log/Report/Lexicon/MOTcompact.pm:140 #, fuzzy msgid "cannot read translations from {fn}, need {size} at {loc}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:123 #, fuzzy msgid "cannot seek to {loc} in {fn} for msgid strings" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:97 #, fuzzy msgid "cannot seek to {loc} in {fn} for originals" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:134 #, fuzzy msgid "cannot seek to {loc} in {fn} for transl strings" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:108 #, fuzzy msgid "cannot seek to {loc} in {fn} for translations" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:203 #, fuzzy msgid "cannot seek to {loc} late in {fn} for transl strings" msgstr "" #: lib/Log/Report/Dispatcher/File.pm:96 msgid "cannot write log into {file} with {binmode}" msgstr "kan log niet naar bestand {file} schrijven in {binmode}" #: lib/Log/Report/Lexicon/POT.pm:203 msgid "cannot write to file {fn} in {layers}" msgstr "kan bestand {fn} niet schrijven in {layers}" #: lib/Log/Report/Lexicon/POT.pm:106 lib/Log/Report/Lexicon/POT.pm:146 msgid "charset parameter is required for {fn}" msgstr "charset argument is verplicht voor {fn}" #: lib/Log/Report/Lexicon/MOTcompact.pm:57 #: lib/Log/Report/Lexicon/POTcompact.pm:57 msgid "charset parameter required for {fn}" msgstr "" #: lib/Log/Report/Dispatcher/Callback.pm:62 msgid "dispatcher {name} needs a 'callback'" msgstr "dispatcher {name} verlangt een 'callback'" #: lib/Log/Report/Dispatcher/File.pm:85 msgid "dispatcher {name} needs parameter 'to'" msgstr "dispatcher {name} verlangt argument 'to'" #: bin/xgettext-perl:62 msgid "do not combine command-line filenames with --files-from" msgstr "combineer filenamen op de commando-regel niet met --files-from" #: lib/Log/Report/Extract/PerlPPI.pm:170 msgid "do not interpolate in msgid (found '{var}' in line {line})" msgstr "gebruik geen variabelen in een msgid (vond '{var}' op regel {line'})" #: lib/Log/Report/Lexicon/PO.pm:374 msgid "do not understand command '{cmd}' at {where}" msgstr "commando '{cmd}' op plaats {where} niet begrepen" #: lib/Log/Report/Lexicon/PO.pm:391 msgid "" "do not understand line at {where}:\n" " {line}" msgstr "" "de regel op {where} wordt niet begrepen:\n" " {line}" #: lib/Log/Report.pm:656 msgid "even length parameter list for __x at {where}" msgstr "een even-lengte lijst van parameters bij __x bij {where}" #: bin/xgettext-perl:54 msgid "explicit output directory (-p) required" msgstr "expliciete uitvoer map (met -p) verplicht" #: lib/Log/Report/Extract.pm:47 msgid "extractions require an explicit lexicon directory" msgstr "een expliciete lexicon directory is nodig voor de uittreksels" #: lib/Log/Report/Lexicon/MOTcompact.pm:162 lib/Log/Report/Lexicon/POT.pm:169 #: lib/Log/Report/Lexicon/POTcompact.pm:100 msgid "failed reading from file {fn}" msgstr "lezen uit bestand {fn} mislukt" #: lib/Log/Report/Extract.pm:199 msgid "found one pot file for domain {domain}" msgid_plural "found {_count} pot files for domain {domain}" msgstr[0] "één pot bestand voor domein {domain} gevonden" msgstr[1] "{_count} pot bestanden voor domain {domain} gevonden" #: lib/Log/Report/Dispatcher.pm:146 msgid "illegal format_reason '{format}' for dispatcher" msgstr "onbekende format_reason '{format}' voor dispatcher" #: lib/Log/Report/Lexicon/Table.pm:98 msgid "invalid plural-form algorithm '{alg}'" msgstr "incorrect meervoudsvorm algoritme '{alg}'" #: lib/Log/Report/Exception.pm:102 msgid "message() of exception expects Log::Report::Message" msgstr "message() van een exception verwacht een Log::Report::Message" #: lib/Log/Report/Extract/Template.pm:93 msgid "need pattern to scan for, either via new() or process()" msgstr "een scan pattern is nodig, via new() of process()" #: lib/Log/Report/Extract/PerlPPI.pm:188 msgid "new-line is added automatically (found in line {line})" msgstr "een regel-overgang wordt automatisch toegevoegd (gevonden op regel {line})" #: lib/Log/Report/Extract/PerlPPI.pm:73 #, fuzzy msgid "no Perl in file {filename}" msgstr "" #: lib/Log/Report/Lexicon/POT.pm:194 msgid "no filename or file-handle specified for PO" msgstr "geen bestandsnaam of -handle meegegeven voor PO" #: lib/Log/Report/Lexicon/POT.pm:317 msgid "no header defined in POT for file {fn}" msgstr "geen kop opgegeven in POT in bestand {fn}" #: lib/Log/Report/Lexicon/PO.pm:397 msgid "no msgid in block {where}" msgstr "geen msgid in blok {where}" #: lib/Log/Report/Lexicon/PO.pm:476 msgid "no plurals for '{msgid}'" msgstr "geen meervoudsvormen voor '{msgid}'" #: lib/Log/Report/Extract/PerlPPI.pm:121 msgid "no text-domain for translatable at {fn} line {line}" msgstr "geen text-domain voor vertaalbare string in {fn} regel {line}" #: lib/Log/Report.pm:506 msgid "odd length parameter list for try(): forgot the terminating ';'?" msgstr "oneven lengte van parameterlijst voor try(): afsluitende ';' vergeten?" #: lib/Log/Report.pm:264 msgid "odd length parameter list with '{msg}'" msgstr "parameter-lijst van oneven lengte bij '{msg}'" #: lib/Log/Report.pm:421 msgid "only one dispatcher name accepted in SCALAR context" msgstr "dispatcher gebruik in SCALAR context accepteert slechts één naam" #: lib/Log/Report.pm:954 msgid "only one package can contain configuration; for {domain} already in {pkg} in file {fn} line {line}" msgstr "slechts één package mag configuratie informatie bevatten; voor {domain} is dit al gevonden in {pkg}, bestand {fn} regel {line}" #: lib/Log/Report/Extract/PerlPPI.pm:77 lib/Log/Report/Extract/Template.pm:90 msgid "processing file {fn} in {charset}" msgstr "verwerk bestand {fn} in {charset}" #: bin/xgettext-perl:51 msgid "programming language {lang} not supported" msgstr "programmeertaal {lang} wordt niet ondersteund" #: lib/Log/Report/Lexicon/PO.pm:386 msgid "quoted line is not a continuation at {where}" msgstr "regel met quotes is geen voortzetting in {where}" #~ msgid "read pot-file {filename} for {domain} in {locale}" #~ msgstr "lees pot bestand {filename} voor {domain} in {locale}" #: lib/Log/Report/Translator/POT.pm:90 #, fuzzy msgid "read table {filename} as {class} for {domain} in {locale}" msgstr "" #: lib/Log/Report/Util.pm:136 msgid "reason '{begin}' more serious than '{end}' in '{reasons}" msgstr "reden '{begin}' is serieuzer dan '{end}' in '{reasons}'" #~ msgid "scan pattern `{pattern}' not recognized" #~ msgstr "scan patroon `{pattern}' wordt niet herkend" #: bin/xgettext-perl:83 #, fuzzy msgid "specify a text-domain (-d) for the templates" msgstr "" #: lib/Log/Report/Extract.pm:208 msgid "starting new textdomain {domain}, template in {filename}" msgstr "begin van nieuw textdomain {domain}, sjabloon in {filename}" #: lib/Log/Report/Lexicon/POTcompact.pm:154 msgid "string '{text}' not between quotes at {location}" msgstr "tekst '{text}' niet tussen quotes in {location}" #: lib/Log/Report/Extract/PerlPPI.pm:178 msgid "string is incorrect at line {line}: {error}" msgstr "foutieve string in regel {regel}: {error}" #: lib/Log/Report/Dispatcher.pm:211 msgid "switching to run mode {mode}, accept {accept}" msgstr "verwerkingsmode {mode}, accepteert {accept}" #: lib/Log/Report.pm:882 msgid "syntax flag must be either SHORT or REPORT, not `{syntax}'" msgstr "syntax parameter moet zijn SHORT of REPORT, niet `{syntax}'" #: lib/Log/Report/Dispatcher/Syslog.pm:122 msgid "syslog level '{level}' not understood" msgstr "syslog level '{level}' niet herkend" #: lib/Log/Report/Extract/Template.pm:145 #, fuzzy msgid "template syntax error, no END in {fn} line {line}" msgstr "" #: lib/Log/Report.pm:922 msgid "textdomain for translator not defined" msgstr "tekstdomein voor vertaler niet gedefinieerd" #: lib/Log/Report/Lexicon/POT.pm:111 msgid "textdomain parameter is required" msgstr "tekstdomain argument is verplicht" #: lib/Log/Report.pm:406 msgid "the 'filter' sub-command needs a CODE reference" msgstr "het 'filter' sub-commando verwacht een CODE referentie" #: lib/Log/Report.pm:393 msgid "the 'list' sub-command doesn't expect additional parameters" msgstr "het 'list' sub-commando verwacht geen aanvullende argumenten" #: lib/Log/Report.pm:399 msgid "the 'needs' sub-command parameter '{reason}' is not a reason" msgstr "het 'needs' sub-commando argument '{reason}' is geen reden" #: lib/Log/Report/Lexicon/POT.pm:296 msgid "the only acceptable parameter is 'ACTIVE', not '{p}'" msgstr "het enige geaccepteerde argument is 'ACTIVE', niet '{p}'" #: lib/Log/Report/Lexicon/Table.pm:93 #, fuzzy msgid "there is no Plural-Forms field in the header" msgstr "" #: lib/Log/Report.pm:233 msgid "token '{token}' not recognized as reason" msgstr "token '{token}' niet herkend als reden" #: lib/Log/Report/Lexicon/PO.pm:465 msgid "too many plurals for '{msgid}'" msgstr "te veel meervouden voor '{msgid}'" #: lib/Log/Report/Lexicon/POT.pm:279 msgid "translation already exists for '{msgid}'" msgstr "er bestaat al een vertaling voor '{msgid}'" #: lib/Log/Report.pm:929 msgid "translator must be a Log::Report::Translator object" msgstr "vertaler moet een Log::Report::Translator object zijn" #: lib/Log/Report/Dispatcher/Try.pm:220 msgid "try-block stopped with {reason}: {text}" msgstr "try-blok gestopt met {reason}: {text}" #: lib/Log/Report/Lexicon/PO.pm:348 msgid "unknown comment type '{cmd}' at {where}" msgstr "onbekend commentaar type '{cmd}' in {where}" #: lib/Log/Report/Lexicon/PO.pm:316 msgid "unknown flag {flag} ignored" msgstr "onbekende vlag {flag} wordt genegeerd" #: lib/Log/Report/Util.pm:84 msgid "unknown locale language in locale `{locale}'" msgstr "onbekende locale taal in locale `{locale}'" #: lib/Log/Report/Extract/Template.pm:114 #, fuzzy msgid "unknown pattern {pattern}" msgstr "" #: lib/Log/Report/Util.pm:133 lib/Log/Report/Util.pm:148 msgid "unknown reason {which} in '{reasons}'" msgstr "onbekende reden {which} is '{reasons}'" #~ msgid "unknown run mode '{mode}'" #~ msgstr "onbekende verwerkingsmode '{mode}'" #: lib/Log/Report/Translator/POT.pm:87 #, fuzzy msgid "unknown translation table extension '{ext}' in {filename}" msgstr "" #: lib/Log/Report/Lexicon/POT.pm:107 msgid "unnamed file" msgstr "naamloze file" #: lib/Log/Report/Lexicon/MOTcompact.pm:82 #, fuzzy msgid "unsupported file type (magic number is {magic%x})" msgstr "" #: lib/Log/Report.pm:959 msgid "value for {name} specified twice" msgstr "twee keer een waarde voor {name}" #: lib/Log/Report/Lexicon/POT.pm:219 msgid "write errors for file {fn}" msgstr "schrijfproblemen bij bestand {fn}" #: lib/Log/Report/Extract.pm:146 msgid "{domain}: one file with {ids} msgids" msgid_plural "{domain}: {_count} files with each {ids} msgids" msgstr[0] "{domain}: één bestand met {ids} mgsids" msgstr[1] "{domain}: {_count} bestanden met elk {ids} msgids" #: lib/Log/Report/Extract.pm:139 msgid "{domain}: one file with {ids} msgids, {f} fuzzy and {i} inactive translations" msgid_plural "{domain}: {_count} files each {ids} msgids, {f} fuzzy and {i} inactive translations in total" msgstr[0] "{domain}: één bestand met {ids} mgsids, {f} fuzzy en {i} op non-actief" msgstr[1] "{domain}: {_count} bestanden met elk {ids} msgids, {f} fuzzy en {i} op non-actief in het totaal" #: lib/Log/Report/Extract.pm:129 msgid "{domain}: {fuzzy%3d} fuzzy, {inact%3d} inactive in {filename}" msgstr "{domain}: {fuzzy%3d} fuzzy, {inact%3d} op non-actief in {filename}" #: lib/Log/Report/Dispatcher.pm:285 msgid "{message}; {error}" msgstr "{message}; {error}" #: lib/Log/Report/Dispatcher.pm:284 msgid "{reason}: {message}" msgstr "{reason}: {message}" #: lib/Log/Report/Dispatcher.pm:283 msgid "{reason}: {message}; {error}" msgstr "{reason}: {message}; {error}" Log-Report-0.998/lib/Log/Report/messages/log-report.utf-8.po0000644000175000001440000003013412231427544024225 0ustar00markovusers00000000000000#. Header generated with Log::Report::Lexicon::POT 0.0 msgid "" msgstr "" "Project-Id-Version: log-report 0.01\n" "Report-Msgid-Bugs-To:\n" "POT-Creation-Date: 2007-05-14 17:14+0200\n" "PO-Revision-Date: 2013-08-22 16:17+0200\n" "Last-Translator:\n" "Language-Team:\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=utf-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n!=1);\n" #: lib/Log/Report/Util.pm:14 #, fuzzy msgid "ALERT" msgstr "" #: lib/Log/Report/Util.pm:14 #, fuzzy msgid "ASSERT" msgstr "" #: lib/Log/Report/Util.pm:14 #, fuzzy msgid "ERROR" msgstr "" #: lib/Log/Report/Util.pm:14 #, fuzzy msgid "FAILURE" msgstr "" #: lib/Log/Report/Util.pm:14 #, fuzzy msgid "FAULT" msgstr "" #: lib/Log/Report/Util.pm:14 #, fuzzy msgid "INFO" msgstr "" #: lib/Log/Report/Dispatcher/LogDispatch.pm:105 #, fuzzy msgid "Log::Dispatch level '{level}' not understood" msgid_plural "level" msgstr[0] "" msgstr[1] "" #: lib/Log/Report/Dispatcher/Log4perl.pm:100 #, fuzzy msgid "Log::Log4perl back-end {name} requires a 'config' parameter" msgstr "" #: lib/Log/Report/Dispatcher/Log4perl.pm:111 #, fuzzy msgid "Log::Log4perl level '{level}' must be in 0-5" msgstr "" #: lib/Log/Report/Util.pm:14 #, fuzzy msgid "MISTAKE" msgstr "" #: lib/Log/Report/Util.pm:14 #, fuzzy msgid "NOTICE" msgstr "" #: lib/Log/Report/Dispatcher/Log4perl.pm:27 #: lib/Log/Report/Dispatcher/LogDispatch.pm:27 #: lib/Log/Report/Dispatcher/Syslog.pm:28 #, fuzzy msgid "Not all reasons have a default translation" msgstr "" #: lib/Log/Report/Util.pm:14 #, fuzzy msgid "PANIC" msgstr "" #: lib/Log/Report/Extract/PerlPPI.pm:66 #, fuzzy msgid "PPI only supports iso-8859-1 (latin-1) on the moment" msgstr "" #: lib/Log/Report/Dispatcher.pm:152 #, fuzzy msgid "Perl does not support charset {cs}" msgstr "" #: lib/Log/Report/Util.pm:14 #, fuzzy msgid "TRACE" msgstr "" #: lib/Log/Report/Util.pm:14 #, fuzzy msgid "WARNING" msgstr "" #: lib/Log/Report.pm:256 #, fuzzy msgid "a message object is reported with more parameters" msgstr "" #: lib/Log/Report/Dispatcher.pm:299 lib/Log/Report/Dispatcher.pm:309 #, fuzzy msgid "at {filename} line {line}" msgstr "" #: lib/Log/Report/Extract.pm:50 #, fuzzy msgid "cannot create lexicon directory {dir}" msgstr "" #: bin/xgettext-perl:57 #, fuzzy msgid "cannot create output directory {dir}" msgstr "" #: lib/Log/Report/Dispatcher/Log4perl.pm:121 #, fuzzy msgid "cannot find logger '{name}' in configuration {config}" msgstr "" #: bin/xgettext-perl:65 #, fuzzy msgid "cannot read filename list from {fn}" msgstr "" #: lib/Log/Report/Extract/PerlPPI.pm:69 #, fuzzy msgid "cannot read from file {filename}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:70 lib/Log/Report/Lexicon/POT.pm:149 #: lib/Log/Report/Lexicon/POTcompact.pm:60 #, fuzzy msgid "cannot read in {cs} from file {fn}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:77 #, fuzzy msgid "cannot read magic from {fn}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:129 #, fuzzy msgid "cannot read msgids from {fn}, need {size} at {loc}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:101 #, fuzzy msgid "cannot read originals from {fn}, need {size} at {loc}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:87 #, fuzzy msgid "cannot read superblock from {fn}" msgstr "" #: lib/Log/Report/Extract/Template.pm:98 #, fuzzy msgid "cannot read template from {fn}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:208 #, fuzzy msgid "cannot read transl late from {fn}, need {size} at {loc}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:112 #: lib/Log/Report/Lexicon/MOTcompact.pm:140 #, fuzzy msgid "cannot read translations from {fn}, need {size} at {loc}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:123 #, fuzzy msgid "cannot seek to {loc} in {fn} for msgid strings" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:97 #, fuzzy msgid "cannot seek to {loc} in {fn} for originals" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:134 #, fuzzy msgid "cannot seek to {loc} in {fn} for transl strings" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:108 #, fuzzy msgid "cannot seek to {loc} in {fn} for translations" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:203 #, fuzzy msgid "cannot seek to {loc} late in {fn} for transl strings" msgstr "" #: lib/Log/Report/Dispatcher/File.pm:96 #, fuzzy msgid "cannot write log into {file} with {binmode}" msgstr "" #: lib/Log/Report/Lexicon/POT.pm:203 #, fuzzy msgid "cannot write to file {fn} in {layers}" msgstr "" #: lib/Log/Report/Lexicon/POT.pm:106 lib/Log/Report/Lexicon/POT.pm:146 #, fuzzy msgid "charset parameter is required for {fn}" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:57 #: lib/Log/Report/Lexicon/POTcompact.pm:57 #, fuzzy msgid "charset parameter required for {fn}" msgstr "" #: lib/Log/Report/Dispatcher/Callback.pm:62 #, fuzzy msgid "dispatcher {name} needs a 'callback'" msgstr "" #: lib/Log/Report/Dispatcher/File.pm:85 #, fuzzy msgid "dispatcher {name} needs parameter 'to'" msgstr "" #: bin/xgettext-perl:62 #, fuzzy msgid "do not combine command-line filenames with --files-from" msgstr "" #: lib/Log/Report/Extract/PerlPPI.pm:170 #, fuzzy msgid "do not interpolate in msgid (found '{var}' in line {line})" msgstr "" #: lib/Log/Report/Lexicon/PO.pm:374 #, fuzzy msgid "do not understand command '{cmd}' at {where}" msgstr "" #: lib/Log/Report/Lexicon/PO.pm:391 #, fuzzy msgid "" "do not understand line at {where}:\n" " {line}" msgstr "" #: lib/Log/Report.pm:656 #, fuzzy msgid "even length parameter list for __x at {where}" msgstr "" #: bin/xgettext-perl:54 #, fuzzy msgid "explicit output directory (-p) required" msgstr "" #: lib/Log/Report/Extract.pm:47 #, fuzzy msgid "extractions require an explicit lexicon directory" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:162 lib/Log/Report/Lexicon/POT.pm:169 #: lib/Log/Report/Lexicon/POTcompact.pm:100 #, fuzzy msgid "failed reading from file {fn}" msgstr "" #: lib/Log/Report/Extract.pm:199 #, fuzzy msgid "found one pot file for domain {domain}" msgid_plural "found {_count} pot files for domain {domain}" msgstr[0] "" msgstr[1] "" #: lib/Log/Report/Dispatcher.pm:146 #, fuzzy msgid "illegal format_reason '{format}' for dispatcher" msgstr "" #: lib/Log/Report/Lexicon/Table.pm:98 #, fuzzy msgid "invalid plural-form algorithm '{alg}'" msgstr "" #: lib/Log/Report/Exception.pm:102 #, fuzzy msgid "message() of exception expects Log::Report::Message" msgstr "" #: lib/Log/Report/Extract/Template.pm:93 #, fuzzy msgid "need pattern to scan for, either via new() or process()" msgstr "" #: lib/Log/Report/Extract/PerlPPI.pm:188 #, fuzzy msgid "new-line is added automatically (found in line {line})" msgstr "" #: lib/Log/Report/Extract/PerlPPI.pm:73 #, fuzzy msgid "no Perl in file {filename}" msgstr "" #: lib/Log/Report/Lexicon/POT.pm:194 #, fuzzy msgid "no filename or file-handle specified for PO" msgstr "" #: lib/Log/Report/Lexicon/POT.pm:317 #, fuzzy msgid "no header defined in POT for file {fn}" msgstr "" #: lib/Log/Report/Lexicon/PO.pm:397 #, fuzzy msgid "no msgid in block {where}" msgstr "" #: lib/Log/Report/Lexicon/PO.pm:476 #, fuzzy msgid "no plurals for '{msgid}'" msgstr "" #: lib/Log/Report/Extract/PerlPPI.pm:121 #, fuzzy msgid "no text-domain for translatable at {fn} line {line}" msgstr "" #: lib/Log/Report.pm:506 #, fuzzy msgid "odd length parameter list for try(): forgot the terminating ';'?" msgstr "" #: lib/Log/Report.pm:264 #, fuzzy msgid "odd length parameter list with '{msg}'" msgstr "" #: lib/Log/Report.pm:421 #, fuzzy msgid "only one dispatcher name accepted in SCALAR context" msgstr "" #: lib/Log/Report.pm:954 #, fuzzy msgid "only one package can contain configuration; for {domain} already in {pkg} in file {fn} line {line}" msgstr "" #: lib/Log/Report/Extract/PerlPPI.pm:77 lib/Log/Report/Extract/Template.pm:90 #, fuzzy msgid "processing file {fn} in {charset}" msgstr "" #: bin/xgettext-perl:51 #, fuzzy msgid "programming language {lang} not supported" msgstr "" #: lib/Log/Report/Lexicon/PO.pm:386 #, fuzzy msgid "quoted line is not a continuation at {where}" msgstr "" #: lib/Log/Report/Translator/POT.pm:90 #, fuzzy msgid "read table {filename} as {class} for {domain} in {locale}" msgstr "" #: lib/Log/Report/Util.pm:136 #, fuzzy msgid "reason '{begin}' more serious than '{end}' in '{reasons}" msgstr "" #: bin/xgettext-perl:83 #, fuzzy msgid "specify a text-domain (-d) for the templates" msgstr "" #: lib/Log/Report/Extract.pm:208 #, fuzzy msgid "starting new textdomain {domain}, template in {filename}" msgstr "" #: lib/Log/Report/Lexicon/POTcompact.pm:154 #, fuzzy msgid "string '{text}' not between quotes at {location}" msgstr "" #: lib/Log/Report/Extract/PerlPPI.pm:178 #, fuzzy msgid "string is incorrect at line {line}: {error}" msgstr "" #: lib/Log/Report/Dispatcher.pm:211 #, fuzzy msgid "switching to run mode {mode}, accept {accept}" msgstr "" #: lib/Log/Report.pm:882 #, fuzzy msgid "syntax flag must be either SHORT or REPORT, not `{syntax}'" msgstr "" #: lib/Log/Report/Dispatcher/Syslog.pm:122 #, fuzzy msgid "syslog level '{level}' not understood" msgstr "" #: lib/Log/Report/Extract/Template.pm:145 #, fuzzy msgid "template syntax error, no END in {fn} line {line}" msgstr "" #: lib/Log/Report.pm:922 #, fuzzy msgid "textdomain for translator not defined" msgstr "" #: lib/Log/Report/Lexicon/POT.pm:111 #, fuzzy msgid "textdomain parameter is required" msgstr "" #: lib/Log/Report.pm:406 #, fuzzy msgid "the 'filter' sub-command needs a CODE reference" msgstr "" #: lib/Log/Report.pm:393 #, fuzzy msgid "the 'list' sub-command doesn't expect additional parameters" msgstr "" #: lib/Log/Report.pm:399 #, fuzzy msgid "the 'needs' sub-command parameter '{reason}' is not a reason" msgstr "" #: lib/Log/Report/Lexicon/POT.pm:296 #, fuzzy msgid "the only acceptable parameter is 'ACTIVE', not '{p}'" msgstr "" #: lib/Log/Report/Lexicon/Table.pm:93 #, fuzzy msgid "there is no Plural-Forms field in the header" msgstr "" #: lib/Log/Report.pm:233 #, fuzzy msgid "token '{token}' not recognized as reason" msgstr "" #: lib/Log/Report/Lexicon/PO.pm:465 #, fuzzy msgid "too many plurals for '{msgid}'" msgstr "" #: lib/Log/Report/Lexicon/POT.pm:279 #, fuzzy msgid "translation already exists for '{msgid}'" msgstr "" #: lib/Log/Report.pm:929 #, fuzzy msgid "translator must be a Log::Report::Translator object" msgstr "" #: lib/Log/Report/Dispatcher/Try.pm:220 #, fuzzy msgid "try-block stopped with {reason}: {text}" msgstr "" #: lib/Log/Report/Lexicon/PO.pm:348 #, fuzzy msgid "unknown comment type '{cmd}' at {where}" msgstr "" #: lib/Log/Report/Lexicon/PO.pm:316 #, fuzzy msgid "unknown flag {flag} ignored" msgstr "" #: lib/Log/Report/Util.pm:84 #, fuzzy msgid "unknown locale language in locale `{locale}'" msgstr "" #: lib/Log/Report/Extract/Template.pm:114 #, fuzzy msgid "unknown pattern {pattern}" msgstr "" #: lib/Log/Report/Util.pm:133 lib/Log/Report/Util.pm:148 #, fuzzy msgid "unknown reason {which} in '{reasons}'" msgstr "" #: lib/Log/Report/Translator/POT.pm:87 #, fuzzy msgid "unknown translation table extension '{ext}' in {filename}" msgstr "" #: lib/Log/Report/Lexicon/POT.pm:107 #, fuzzy msgid "unnamed file" msgstr "" #: lib/Log/Report/Lexicon/MOTcompact.pm:82 #, fuzzy msgid "unsupported file type (magic number is {magic%x})" msgstr "" #: lib/Log/Report.pm:959 #, fuzzy msgid "value for {name} specified twice" msgstr "" #: lib/Log/Report/Lexicon/POT.pm:219 #, fuzzy msgid "write errors for file {fn}" msgstr "" #: lib/Log/Report/Extract.pm:146 #, fuzzy msgid "{domain}: one file with {ids} msgids" msgid_plural "{domain}: {_count} files with each {ids} msgids" msgstr[0] "" msgstr[1] "" #: lib/Log/Report/Extract.pm:139 #, fuzzy msgid "{domain}: one file with {ids} msgids, {f} fuzzy and {i} inactive translations" msgid_plural "{domain}: {_count} files each {ids} msgids, {f} fuzzy and {i} inactive translations in total" msgstr[0] "" msgstr[1] "" #: lib/Log/Report/Extract.pm:129 #, fuzzy msgid "{domain}: {fuzzy%3d} fuzzy, {inact%3d} inactive in {filename}" msgstr "" #: lib/Log/Report/Dispatcher.pm:285 #, fuzzy msgid "{message}; {error}" msgstr "" #: lib/Log/Report/Dispatcher.pm:284 #, fuzzy msgid "{reason}: {message}" msgstr "" #: lib/Log/Report/Dispatcher.pm:283 #, fuzzy msgid "{reason}: {message}; {error}" msgstr "" Log-Report-0.998/lib/Log/Report/Dispatcher/0000755000175000001440000000000012231427551021105 5ustar00markovusers00000000000000Log-Report-0.998/lib/Log/Report/Dispatcher/Try.pm0000644000175000001440000000371412231427545022231 0ustar00markovusers00000000000000# 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::Dispatcher::Try; use vars '$VERSION'; $VERSION = '0.998'; use base 'Log::Report::Dispatcher'; use Log::Report 'log-report', syntax => 'SHORT'; use Log::Report::Exception; use overload bool => 'failed' , '""' => 'showStatus'; sub init($) { my ($self, $args) = @_; defined $self->SUPER::init($args) or return; $self->{exceptions} = delete $args->{exceptions} || []; $self->{died} = delete $args->{died}; $self; } sub close() { my $self = shift; $self->SUPER::close or return; $self; } sub died(;$) { my $self = shift; @_ ? ($self->{died} = shift) : $self->{died}; } sub exceptions() { @{shift->{exceptions}} } sub log($$$) { my ($self, $opts, $reason, $message) = @_; # 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 ); # later changed into nice message $self->{died} ||= $opts->{is_fatal}; $self; } sub reportAll(@) { $_->throw(@_) for shift->exceptions } sub reportFatal(@) { $_->throw(@_) for shift->wasFatal } #----------------- sub failed() { shift->{died}} sub success() { ! shift->{died}} sub wasFatal(@) { my ($self, %args) = @_; $self->{died} or return (); my $ex = $self->{exceptions}[-1]; (!$args{class} || $ex->inClass($args{class})) ? $ex : (); } sub showStatus() { my $self = shift; my $fatal = $self->wasFatal or return ''; __x"try-block stopped with {reason}: {text}" , reason => $fatal->reason , text => $self->died; } 1; Log-Report-0.998/lib/Log/Report/Dispatcher/Perl.pm0000644000175000001440000000127112231427545022351 0ustar00markovusers00000000000000# 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::Dispatcher::Perl; use vars '$VERSION'; $VERSION = '0.998'; use base 'Log::Report::Dispatcher'; use Log::Report 'log-report', syntax => 'SHORT'; 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); if($opts->{is_fatal}) { $! = $opts->{errno}; die $text; } else { warn $text; } } 1; Log-Report-0.998/lib/Log/Report/Dispatcher/File.pm0000644000175000001440000000314612231427545022331 0ustar00markovusers00000000000000# 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::Dispatcher::File; use vars '$VERSION'; $VERSION = '0.998'; use base 'Log::Report::Dispatcher'; use Log::Report 'log-report', syntax => 'SHORT'; use IO::File (); use Encode qw/find_encoding/; sub init($) { my ($self, $args) = @_; if(!$args->{charset}) { my $lc = $ENV{LC_CTYPE} || $ENV{LC_ALL} || $ENV{LANG} || ''; my $cs = $lc =~ m/\.([\w-]+)/ ? $1 : ''; $args->{charset} = length $cs && find_encoding $cs ? $cs : undef; } $self->SUPER::init($args); my $name = $self->name; my $to = delete $args->{to} or error __x"dispatcher {name} needs parameter 'to'", name => $name; if(ref $to) { $self->{output} = $to; trace "opened dispatcher $name to a ".ref($to); } else { $self->{filename} = $to; 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; $f->autoflush; trace "opened dispatcher $name to $to with $binmode"; } $self; } sub close() { my $self = shift; $self->SUPER::close or return; $self->{output}->close if $self->{filename}; $self; } sub filename() {shift->{filename}} sub log($$$) { my $self = shift; $self->{output}->print($self->SUPER::translate(@_)); } 1; Log-Report-0.998/lib/Log/Report/Dispatcher/Callback.pm0000644000175000001440000000126412231427545023145 0ustar00markovusers00000000000000# 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::Dispatcher::Callback; use vars '$VERSION'; $VERSION = '0.998'; use base 'Log::Report::Dispatcher'; use Log::Report 'log-report'; sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $self->{callback} = $args->{callback} or error __x"dispatcher {name} needs a 'callback'", name => $self->name; $self; } sub callback() {shift->{callback}} sub log($$$) { my $self = shift; $self->{callback}->($self, @_); } 1; Log-Report-0.998/lib/Log/Report/Dispatcher/File.pod0000644000175000001440000001124212231427545022473 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::File - send messages to a file or file-handle =head1 INHERITANCE Log::Report::Dispatcher::File is a Log::Report::Dispatcher =head1 SYNOPSIS dispatcher Log::Report::Dispatcher::File => 'stderr' , to => \*STDERR, accept => 'NOTICE-'; # close a dispatcher dispatcher close => 'stderr'; # let dispatcher open and close the file dispatcher FILE => 'mylog', to => '/var/log/mylog' , charset => 'utf-8'; ... dispatcher close => 'mylog'; # will close file # open yourself, then also close yourself open OUT, ">:encoding('iso-8859-1')", '/var/log/mylog' or fault "..."; dispatcher FILE => 'mylog', to => \*OUT; ... dispatcher close => 'mylog'; close OUT; # dispatch into a scalar my $output = ''; open $outfile, '>', \$output; dispatcher FILE => 'into-scalar', to => \$outfile; ... dispatcher close => 'into-scalar'; print $output; =head1 DESCRIPTION This basic file logger accepts an file-handle or filename as destination. See L. =head1 METHODS See L. =head2 Constructors See L. =over 4 =item $obj-EB() Only when initiated with a FILENAME, the file will be closed. In any other case, nothing will be done. =item Log::Report::Dispatcher::File-EB(TYPE, NAME, OPTIONS) -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode charset Log::Report::Dispatcher LOCALE format_reason Log::Report::Dispatcher 'LOWERCASE' locale Log::Report::Dispatcher mode Log::Report::Dispatcher 'NORMAL' replace false to =over 2 =item accept => REASONS =item charset => CHARSET =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item locale => LOCALE =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item replace => BOOLEAN Only used in combination with a FILENAME: throw away the old file if it exists. Probably you wish to append to existing information. Use the LOCALE setting by default, which is LC_CTYPE or LC_ALL or LANG (in that order). If these contain a character-set which Perl understands, then that is used, otherwise silently ignored. =item to => FILENAME|FILEHANDLE|OBJECT You can either specify a FILENAME, which is opened in append mode with autoflush on. Or pass any kind of FILE-HANDLE or some OBJECT which implements a C method. You probably want to have autoflush enabled on your FILE-HANDLES. When cleaning-up the dispatcher, the file will only be closed in case of a FILENAME. =back =back =head2 Accessors See L. =over 4 =item $obj-EB() Returns the name of the opened file, or C in case this dispatcher was started from a file-handle or file-object. =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =back =head2 Logging See L. =over 4 =item $obj-EB() =item Log::Report::Dispatcher::File-EB() See L =item $obj-EB([MAXDEPTH]) =item Log::Report::Dispatcher::File-EB([MAXDEPTH]) See L =item $obj-EB(HASH-of-OPTIONS, REASON, MESSAGE) See L =item $obj-EB(OPTIONS) =item Log::Report::Dispatcher::File-EB(OPTIONS) See L =item $obj-EB(HASH-of-OPTIONS, REASON, MESSAGE) See L =back =head1 DETAILS See L. =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Dispatcher/Log4perl.pod0000644000175000001440000001273212231427545023311 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Log4perl - send messages to Log::Log4perl back-end =head1 INHERITANCE Log::Report::Dispatcher::Log4perl is a Log::Report::Dispatcher =head1 SYNOPSIS dispatcher Log::Log4perl => 'logger', accept => 'NOTICE-' , config => "$ENV{HOME}/.log.conf" , to_level => [ 'ALERT-' => $ERROR ]; # disable default dispatcher dispatcher close => 'logger'; # configuration inline, not in file: adapted from the Log4perl manpage my $name = 'logger'; my $outfile = '/tmp/a.log'; my $config = <<__CONFIG; log4perl.category.$name = INFO, Logfile log4perl.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 __CONFIG dispatcher 'Log::Log4perl' => $name, config => \$config; =head1 DESCRIPTION This dispatchers produces output tot syslog, based on the C module (which will not be automatically installed for you). The REASON for a message often uses names which are quite similar to the log-levels used by Log::Dispatch. However: they have a different approach. The REASON of Log::Report limits the responsibility of the programmer to indicate the cause of the message: whether it was able to handle a certain situation. The Log::Dispatch levels are there for the user's of the program. However: the programmer does not known anything about the application (in the general case). This is cause of much of the trickery in Perl programs. The default translation table is list below. You can change the mapping using L. See example in SYNOPSIS. TRACE => $DEBUG ERROR => $ERROR ASSERT => $DEBUG FAULT => $ERROR INFO => $INFO ALERT => $FATAL NOTICE => $INFO FAILURE => $FATAL WARNING => $WARN PANIC => $FATAL MISTAKE => $WARN See L. =head1 METHODS See L. =head2 Constructors See L. =over 4 =item $obj-EB() See L =item Log::Report::Dispatcher::Log4perl-EB(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. -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode charset Log::Report::Dispatcher config format_reason Log::Report::Dispatcher 'LOWERCASE' locale Log::Report::Dispatcher mode Log::Report::Dispatcher 'NORMAL' to_level [] =over 2 =item accept => REASONS =item charset => CHARSET =item config => FILENAME|SCALAR When a SCALAR reference is passed in, that must refer to a string which contains the configuration text. Otherwise, specify an existing FILENAME. =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item locale => LOCALE =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item to_level => ARRAY-of-PAIRS See L. =back =back =head2 Accessors See L. =over 4 =item $obj-EB() Returns the Log::Log4perl::Logger object which is used for logging. =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =back =head2 Logging See L. =over 4 =item $obj-EB() =item Log::Report::Dispatcher::Log4perl-EB() See L =item $obj-EB([MAXDEPTH]) =item Log::Report::Dispatcher::Log4perl-EB([MAXDEPTH]) See L =item $obj-EB(HASH-of-OPTIONS, REASON, MESSAGE) See L =item $obj-EB(REASON) Returns a level which is understood by Log::Dispatch, based on a translation table. This can be changed with L. =item $obj-EB(OPTIONS) =item Log::Report::Dispatcher::Log4perl-EB(OPTIONS) See L =item $obj-EB(HASH-of-OPTIONS, REASON, MESSAGE) See L =back =head1 DETAILS See L. =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Dispatcher/Perl.pod0000644000175000001440000000266012231427545022522 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Perl - send messages to die and warn =head1 INHERITANCE Log::Report::Dispatcher::Perl is a Log::Report::Dispatcher =head1 SYNOPSIS dispatcher Log::Report::Dispatcher::Perl => 'default' , accept => 'NOTICE-'; # close the default dispatcher dispatcher close => 'default'; =head1 DESCRIPTION Ventilate the problem reports via the standard Perl error mechanisms: C, C, and C. There can be only one such dispatcher (per thread), because once C is called, we are not able to return. Therefore, this dispatcher will always be called last. In the early releases of Log::Report, it tried to simulate the behavior of warn and die using STDERR and exit; however: that is not possible. See L. =head1 METHODS See L. =head1 DETAILS See L. =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Dispatcher/LogDispatch.pod0000644000175000001440000001253212231427545024020 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::LogDispatch - send messages to Log::Dispatch back-end =head1 INHERITANCE Log::Report::Dispatcher::LogDispatch is a Log::Report::Dispatcher =head1 SYNOPSIS use Log::Dispatch::File; dispatcher Log::Dispatch::File => 'logger', accept => 'NOTICE-' , filename => 'logfile', to_level => [ 'ALERT-' => 'err' ]; # disable default dispatcher dispatcher close => 'logger'; =head1 DESCRIPTION This dispatchers produces output to and C back-end. (which will NOT be automatically installed for you). The REASON for a message often uses names which are quite similar to the log-levels used by Log::Dispatch. However: they have a different approach. The REASON of Log::Report limits the responsibility of the programmer to indicate the cause of the message: whether it was able to handle a certain situation. The Log::Dispatch levels are there for the user's of the program. However: the programmer does not known anything about the application (in the general case). This is cause of much of the trickery in Perl programs. The default translation table is list below. You can change the mapping using L. See example in SYNOPSIS. See L. =head1 METHODS See L. =head2 Constructors See L. =over 4 =item $obj-EB() See L =item Log::Report::Dispatcher::LogDispatch-EB(TYPE, NAME, OPTIONS) The Log::Dispatch infrastructure has quite a large number of output TYPEs, each extending the Log::Dispatch::Output base-class. You do not create these objects yourself: Log::Report is doing it for you. The Log::Dispatch back-ends are very careful with validating their parameters, so you will need to restrict the options to what is supported for the specific back-end. See their respective manual-pages. The errors produced by the back-ends quite horrible and untranslated, sorry. -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode callbacks [] charset Log::Report::Dispatcher format_reason Log::Report::Dispatcher 'LOWERCASE' locale Log::Report::Dispatcher max_level undef min_level debug mode Log::Report::Dispatcher 'NORMAL' to_level [] =over 2 =item accept => REASONS =item callbacks => CODE|ARRAY-of-CODE See Log::Dispatch::Output. =item charset => CHARSET =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item locale => LOCALE =item max_level => LEVEL Like C. =item min_level => LEVEL Restrict the messages which are passed through based on the LEVEL, so after the reason got translated into a Log::Dispatch compatible LEVEL. The default will use Log::Report restrictions only. =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item to_level => ARRAY-of-PAIRS See L. =back =back =head2 Accessors See L. =over 4 =item $obj-EB() Returns the Log::Dispatch::Output object which is used for logging. =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =back =head2 Logging See L. =over 4 =item $obj-EB() =item Log::Report::Dispatcher::LogDispatch-EB() See L =item $obj-EB([MAXDEPTH]) =item Log::Report::Dispatcher::LogDispatch-EB([MAXDEPTH]) See L =item $obj-EB(HASH-of-OPTIONS, REASON, MESSAGE) See L =item $obj-EB(REASON) Returns a level which is understood by Log::Dispatch, based on a translation table. This can be changed with L. =item $obj-EB(OPTIONS) =item Log::Report::Dispatcher::LogDispatch-EB(OPTIONS) See L =item $obj-EB(HASH-of-OPTIONS, REASON, MESSAGE) See L =back =head1 DETAILS See L. =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Dispatcher/Log4perl.pm0000644000175000001440000000435412231427545023144 0ustar00markovusers00000000000000# 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::Dispatcher::Log4perl; use vars '$VERSION'; $VERSION = '0.998'; use base 'Log::Report::Dispatcher'; use Log::Report 'log-report', syntax => 'SHORT'; use Log::Report::Util qw/@reasons expand_reasons/; use Log::Log4perl qw/:levels/; my %default_reasonToLevel = ( TRACE => $DEBUG , ASSERT => $DEBUG , INFO => $INFO , NOTICE => $INFO , WARNING => $WARN , MISTAKE => $WARN , ERROR => $ERROR , FAULT => $ERROR , ALERT => $FATAL , FAILURE => $FATAL , PANIC => $FATAL ); @reasons != keys %default_reasonToLevel and panic __"Not all reasons have a default translation"; sub init($) { my ($self, $args) = @_; $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" , name => $name; $self->{level} = { %default_reasonToLevel }; if(my $to_level = delete $args->{to_level}) { my @to = @$to_level; while(@to) { my ($reasons, $level) = splice @to, 0, 2; my @reasons = expand_reasons $reasons; $level =~ m/^[0-5]$/ or error __x "Log::Log4perl level '{level}' must be in 0-5" , level => $level; $self->{level}{$_} = $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; $self; } sub close() { my $self = shift; $self->SUPER::close or return; delete $self->{backend}; $self; } sub appender() {shift->{appender}} sub log($$$$) { my $self = shift; my $text = $self->SUPER::translate(@_) or return; my $level = $self->reasonToLevel($_[1]); local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 3; $self->appender->log($level, $text); $self; } sub reasonToLevel($) { $_[0]->{level}{$_[1]} } 1; Log-Report-0.998/lib/Log/Report/Dispatcher/Syslog.pod0000644000175000001440000001263612231427545023104 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Syslog - send messages to syslog =head1 INHERITANCE Log::Report::Dispatcher::Syslog is a Log::Report::Dispatcher =head1 SYNOPSIS # add syslog dispatcher dispatcher SYSLOG => 'syslog', accept => 'NOTICE-' , format_reason => 'IGNORE' , to_prio => [ 'ALERT-' => 'err' ]; # disable default dispatcher, when daemon dispatcher close => 'default'; =head1 DESCRIPTION This dispatchers produces output to syslog, based on the Sys::Syslog module (which will NOT be automatically installed for you, because some systems have a problem with this dependency). The REASON for a message often uses names which are quite similar to the log-levels used by syslog. However: they have a different purpose. The REASON is used by the programmer to indicate the cause of the message: whether it was able to handle a certain situation. The syslog levels are there for the user's of the program (with syslog usually the system administrators). It is not unusual to see a "normal" error or mistake as a very serious situation in a production environment. So, you may wish to translate any message above reason MISTAKE into a LOG_CRIT. The default translation table is list below. You can change the mapping using L. See example in SYNOPSIS. TRACE => LOG_DEBUG ERROR => LOG_ERR ASSERT => LOG_DEBUG FAULT => LOG_ERR INFO => LOG_INFO ALERT => LOG_ALERT NOTICE => LOG_NOTICE FAILURE => LOG_EMERG WARNING => LOG_WARNING PANIC => LOG_CRIT MISTAKE => LOG_WARNING See L. =head1 METHODS See L. =head2 Constructors See L. =over 4 =item $obj-EB() See L =item Log::Report::Dispatcher::Syslog-EB(TYPE, NAME, OPTIONS) With syslog, people tend not to include the REASON of the message in the logs, because that is already used to determine the destination of the message. -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode charset Log::Report::Dispatcher facility 'user' flags 'pid,nowait' format_reason Log::Report::Dispatcher 'IGNORE' identity locale Log::Report::Dispatcher logsocket undef mode Log::Report::Dispatcher 'NORMAL' to_prio [] =over 2 =item accept => REASONS =item charset => CHARSET =item facility => STRING The possible values for this depend (a little) on the system. POSIX only defines 'user' and 'local0' upto 'local7'. =item flags => STRING Any combination of flags as defined by Sys::Syslog, for instance C, C, and C. =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item identity => STRING =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. =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item to_prio => ARRAY-of-PAIRS See L. =back =back =head2 Accessors See L. =over 4 =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =back =head2 Logging See L. =over 4 =item $obj-EB() =item Log::Report::Dispatcher::Syslog-EB() See L =item $obj-EB([MAXDEPTH]) =item Log::Report::Dispatcher::Syslog-EB([MAXDEPTH]) See L =item $obj-EB(HASH-of-OPTIONS, REASON, MESSAGE) See L =item $obj-EB(REASON) Returns a level which is understood by syslog(3), based on a translation table. This can be changed with L. =item $obj-EB(OPTIONS) =item Log::Report::Dispatcher::Syslog-EB(OPTIONS) See L =item $obj-EB(HASH-of-OPTIONS, REASON, MESSAGE) See L =back =head1 DETAILS See L. =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Dispatcher/Try.pod0000644000175000001440000001665012231427545022402 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Try - capture all reports as exceptions =head1 INHERITANCE Log::Report::Dispatcher::Try is a Log::Report::Dispatcher =head1 SYNOPSIS try { ... }; # mind the ';' !! if($@) { # signals something went wrong if(try {...}) { # block ended normally my $x = try { read_temperature() }; my @x = try { read_lines_from_file() }; try { ... } # no comma!! mode => 'DEBUG', accept => 'ERROR-'; try sub { ... }, # with comma mode => 'DEBUG', accept => 'ALL'; try \&myhandler, accept => 'ERROR-'; print ref $@; # Log::Report::Dispatcher::Try $@->reportFatal; # re-dispatch result of try block $@->reportAll; # ... also warnings etc if($@) {...} # if errors if($@->failed) { # same # } if($@->success) { # no errors # } try { # something causes an error report, which is caught report {to => 'stderr'}, FAILURE => 'no network'; }; $@->reportFatal(to => 'syslog'); # overrule destination print $@->exceptions; # no re-cast, just print =head1 DESCRIPTION The L catches errors in the block (CODE reference) which is just following the function name. All dispatchers are temporarily disabled by C, and messages which are reported are collected within a temporary dispatcher named C. When the CODE has run, that C dispatcher is returned in C<$@>, and all original dispatchers reinstated. Then, after the C has finished, the routine which used the "try" should decide what to do with the collected reports. These reports are collected as L objects. They can be ignored, or thrown to a higher level try... causing an exit of the program if there is none. See L. =head1 METHODS See L. =head2 Constructors See L. =over 4 =item $obj-EB() Only when initiated with a FILENAME, the file will be closed. In any other case, nothing will be done. =item Log::Report::Dispatcher::Try-EB(TYPE, NAME, OPTIONS) -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode charset Log::Report::Dispatcher died undef exceptions [] format_reason Log::Report::Dispatcher 'LOWERCASE' locale Log::Report::Dispatcher mode Log::Report::Dispatcher 'NORMAL' =over 2 =item accept => REASONS =item charset => CHARSET =item died => STRING The exit string ($@) of the eval'ed block. =item exceptions => ARRAY-of-EXCEPTIONS =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item locale => LOCALE =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =back =back =head2 Accessors See L. =over 4 =item $obj-EB([STRING]) The message which was reported by C, which is used internally to catch problems in the try block. =item $obj-EB() Returns all collected C. The last of them may be a fatal one. The other are non-fatal. =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =back =head2 Logging See L. =over 4 =item $obj-EB() =item Log::Report::Dispatcher::Try-EB() See L =item $obj-EB([MAXDEPTH]) =item Log::Report::Dispatcher::Try-EB([MAXDEPTH]) See L =item $obj-EB(OPTS, REASON, MESSAGE) Other dispatchers translate the message here, and make it leave the program. However, messages in a "try" block are only captured in an intermediate layer: they may never be presented to an end-users. And for sure, we do not know the language yet. The MESSAGE is either a STRING or a L. =item $obj-EB(OPTIONS) Re-cast the messages in all collect exceptions into the defined dispatchers, which were disabled during the try block. The OPTIONS will end-up as HASH-of-OPTIONS to L; see L which does the job. =item $obj-EB() Re-cast only the fatal message to the defined dispatchers. If the block was left without problems, then nothing will be done. The OPTIONS will end-up as HASH-of-OPTIONS to L; see L which does the job. =item $obj-EB(OPTIONS) =item Log::Report::Dispatcher::Try-EB(OPTIONS) See L =item $obj-EB(HASH-of-OPTIONS, REASON, MESSAGE) See L =back =head2 Status =over 4 =item $obj-EB() Returns true if the block was left with an fatal message. =item $obj-EB() If this object is kept in C<$@>, and someone uses this as string, we want to show the fatal error message. The message is not very informative for the good cause: we do not want people to simply print the C<$@>, but wish for a re-cast of the message using L or L. =item $obj-EB() Returns true if the block exited normally. =item $obj-EB(OPTIONS) Returns the L which caused the "try" block to die, otherwise an empty LIST (undef). -Option--Default class undef =over 2 =item class => CLASS|REGEX Only return the exception if it was fatal, and in the same time in the specified CLASS (as string) or matches the REGEX. See L =back =back =head1 DETAILS See L. =head1 OVERLOADING =over 4 =item overload: B() Returns true if the previous try block did produce a terminal error. This "try" object is assigned to C<$@>, and the usual perl syntax is C. =item overload: B() When C<$@> is used the traditional way, it is checked to have a string content. In this case, stringify into the fatal error or nothing. =back =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Dispatcher/LogDispatch.pm0000644000175000001440000000366012231427545023654 0ustar00markovusers00000000000000# 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::Dispatcher::LogDispatch; use vars '$VERSION'; $VERSION = '0.998'; use base 'Log::Report::Dispatcher'; use Log::Report 'log-report', syntax => 'SHORT'; use Log::Report::Util qw/@reasons expand_reasons/; use Log::Dispatch 2.00; my %default_reasonToLevel = ( TRACE => 'debug' , ASSERT => 'debug' , INFO => 'info' , NOTICE => 'notice' , WARNING => 'warning' , MISTAKE => 'warning' , ERROR => 'error' , FAULT => 'error' , ALERT => 'alert' , FAILURE => 'emergency' , PANIC => 'critical' ); @reasons != keys %default_reasonToLevel and panic __"Not all reasons have a default translation"; sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $args->{name} = $self->name; $args->{min_level} ||= 'debug'; $self->{level} = { %default_reasonToLevel }; if(my $to_level = delete $args->{to_level}) { my @to = @$to_level; while(@to) { my ($reasons, $level) = splice @to, 0, 2; my @reasons = expand_reasons $reasons; Log::Dispatch->level_is_valid($level) or error __x"Log::Dispatch level '{level}' not understood" , level => $level; $self->{level}{$_} = $level for @reasons; } } $self->{backend} = $self->type->new(%$args); $self; } sub close() { my $self = shift; $self->SUPER::close or return; delete $self->{backend}; $self; } sub backend() {shift->{backend}} sub log($$$$) { my $self = shift; my $text = $self->SUPER::translate(@_) or return; my $level = $self->reasonToLevel($_[1]); $self->backend->log(level => $level, message => $text); $self; } sub reasonToLevel($) { $_[0]->{level}{$_[1]} } 1; Log-Report-0.998/lib/Log/Report/Dispatcher/Callback.pod0000644000175000001440000000762712231427545023324 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Callback - call a code-ref for each log-line =head1 INHERITANCE Log::Report::Dispatcher::Callback is a Log::Report::Dispatcher =head1 SYNOPSIS sub cb($$$) { my ($disp, $options, $reason, $message) = @_; ... } dispatcher Log::Report::Dispatcher::Callback => 'cb' , callback => \&cb; dispatcher CALLBACK => 'cb' # same , callback => \&cb; =head1 DESCRIPTION This basic file logger accepts a callback, which is called for each message which is to be logged. When you need complex things, you may best make your own extension to L, but for simple things this will do. See L. =head1 METHODS See L. =head2 Constructors See L. =over 4 =item $obj-EB() See L =item Log::Report::Dispatcher::Callback-EB(TYPE, NAME, OPTIONS) -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode callback charset Log::Report::Dispatcher format_reason Log::Report::Dispatcher 'LOWERCASE' locale Log::Report::Dispatcher mode Log::Report::Dispatcher 'NORMAL' =over 2 =item accept => REASONS =item callback => CODE Your C is called with four parameters: this dispatcher object, the options, a reason and a message. The C are the first parameter of L (read over there). The C is a capitized string like C. Finally, the C is a L. =item charset => CHARSET =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item locale => LOCALE =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =back =back =head2 Accessors See L. =over 4 =item $obj-EB() Returns the code reference which will handle each logged message. =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =item $obj-EB() See L =back =head2 Logging See L. =over 4 =item $obj-EB() =item Log::Report::Dispatcher::Callback-EB() See L =item $obj-EB([MAXDEPTH]) =item Log::Report::Dispatcher::Callback-EB([MAXDEPTH]) See L =item $obj-EB(HASH-of-OPTIONS, REASON, MESSAGE) See L =item $obj-EB(OPTIONS) =item Log::Report::Dispatcher::Callback-EB(OPTIONS) See L =item $obj-EB(HASH-of-OPTIONS, REASON, MESSAGE) See L =back =head1 DETAILS See L. =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Dispatcher/Syslog.pm0000644000175000001440000000422312231427545022727 0ustar00markovusers00000000000000# 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::Dispatcher::Syslog; use vars '$VERSION'; $VERSION = '0.998'; use base 'Log::Report::Dispatcher'; use Sys::Syslog qw/:standard :extended :macros/; use Log::Report 'log-report', syntax => 'SHORT'; use Log::Report::Util qw/@reasons expand_reasons/; use File::Basename qw/basename/; my %default_reasonToPrio = ( TRACE => LOG_DEBUG , ASSERT => LOG_DEBUG , INFO => LOG_INFO , NOTICE => LOG_NOTICE , WARNING => LOG_WARNING , MISTAKE => LOG_WARNING , ERROR => LOG_ERR , FAULT => LOG_ERR , ALERT => LOG_ALERT , FAILURE => LOG_EMERG , PANIC => LOG_CRIT ); @reasons != keys %default_reasonToPrio and panic __"Not all reasons have a default translation"; sub init($) { my ($self, $args) = @_; $args->{format_reason} ||= 'IGNORE'; $self->SUPER::init($args); setlogsock(delete $args->{logsocket}) if $args->{logsocket}; my $ident = delete $args->{identity} || basename $0; my $flags = delete $args->{flags} || 'pid,nowait'; my $fac = delete $args->{facility} || 'user'; openlog $ident, $flags, $fac; # doesn't produce error. $self->{prio} = { %default_reasonToPrio }; if(my $to_prio = delete $args->{to_prio}) { my @to = @$to_prio; while(@to) { my ($reasons, $level) = splice @to, 0, 2; my @reasons = expand_reasons $reasons; my $prio = Sys::Syslog::xlate($level); error __x"syslog level '{level}' not understood", level => $level if $prio eq -1; $self->{prio}{$_} = $prio for @reasons; } } $self; } sub close() { my $self = shift; closelog; $self->SUPER::close; } sub log($$$$) { my $self = shift; my $text = $self->SUPER::translate(@_) or return; my $prio = $self->reasonToPrio($_[1]); # handle each line in message separately syslog $prio, "%s", $_ for split /\n/, $text; } sub reasonToPrio($) { $_[0]->{prio}{$_[1]} } 1; Log-Report-0.998/lib/Log/Report/Die.pm0000644000175000001440000000267712231427545020075 0ustar00markovusers00000000000000# 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::Die; use vars '$VERSION'; $VERSION = '0.998'; use base 'Exporter'; our @EXPORT = qw/die_decode/; use Log::Report 'log-report'; use POSIX qw/locale_h/; sub die_decode($) { my @text = split /\n/, $_[0]; @text or return (); $text[0] =~ s/\.$//; # inconsequently used chomp $text[-1]; my %opt = (errno => $! + 0); my $err = "$!"; my $dietxt = $text[0]; if($text[0] =~ s/ at (.+) line (\d+)$// ) { $opt{location} = [undef, $1, $2, undef]; } elsif(@text > 1 && $text[1] =~ m/^\s*at (.+) line (\d+)\.?$/ ) { $opt{location} = [undef, $1, $2, undef]; splice @text, 1, 1; } $text[0] =~ s/\s*[.:;]?\s*$err\s*$// or delete $opt{errno}; my $msg = shift @text; length $msg or $msg = 'stopped'; my @stack; foreach (@text) { push @stack, [ $1, $2, $3 ] if m/^\s*(.*?)\s+called at (.*?) line (\d+)\s*$/; } $opt{stack} = \@stack; $opt{classes} = [ 'perl', (@stack ? 'confess' : 'die') ]; my $reason = @{$opt{stack}} ? ($opt{errno} ? 'ALERT' : 'PANIC') : ($opt{errno} ? 'FAULT' : 'ERROR'); ($dietxt, \%opt, $reason, $msg); } "to die or not to die, that's the question"; Log-Report-0.998/lib/Log/Report/Exception.pm0000644000175000001440000000336112231427545021321 0ustar00markovusers00000000000000# 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::Exception; use vars '$VERSION'; $VERSION = '0.998'; use Log::Report 'log-report'; use POSIX qw/locale_h/; use overload '""' => 'toString'; sub new($@) { my ($class, %args) = @_; $args{report_opts} ||= {}; bless \%args, $class; } sub report_opts() {shift->{report_opts}} sub reason(;$) { my $self = shift; @_ ? $self->{reason} = uc(shift) : $self->{reason}; } sub isFatal() { Log::Report->isFatal(shift->{reason}) } sub message(;$) { my $self = shift; @_ or return $self->{message}; my $msg = shift; UNIVERSAL::isa($msg, 'Log::Report::Message') or panic __x"message() of exception expects Log::Report::Message"; $self->{message} = $msg; } sub inClass($) { $_[0]->message->inClass($_[1]) } sub throw(@) { my $self = shift; my $opts = @_ ? { %{$self->{report_opts}}, @_ } : $self->{report_opts}; my $reason; if($reason = delete $opts->{reason}) { $opts->{is_fatal} = Log::Report->isFatal($reason) unless exists $opts->{is_fatal}; } else { $reason = $self->{reason}; } $opts->{stack} = Log::Report::Dispatcher->collectStack if $opts->{stack} && @{$opts->{stack}}; report $opts, $reason, $self; } # where the throw is handled is not interesting sub PROPAGATE($$) {shift} sub toString() { my $self = shift; my $msg = $self->message; lc($self->{reason}) . ': ' . (ref $msg ? $msg->toString : $msg) . "\n"; } sub print(;$) { my $self = shift; (shift || *STDERR)->print($self->toString); } 1; Log-Report-0.998/lib/Log/Report/Util.pod0000644000175000001440000000542712231427545020453 0ustar00markovusers00000000000000=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 infrastructure. =head1 FUNCTIONS =over 4 =item B(STRING) Replace all escape characters into their readable counterpart. For instance, a new-line is replaced by backslash-n. =item B(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(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. It may also return C and C. 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(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.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Die.pod0000644000175000001440000000374412231427545020237 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Die - compatibility routines with Perl's die/croak/confess =head1 INHERITANCE Log::Report::Die is a Exporter =head1 SYNOPSIS =head1 DESCRIPTION =head1 OVERLOADING =head1 Functions =over 4 =item B(STRING) The STRING is the content of C<$@> after an eval() caught a die(). croak(), or confess(). This routine tries to convert this into parameters for L. This is done in a very smart way, even trying to find the stringifications of C<$!>. Return are four elements: the error string which is used to trigger a C compatible C, and the options, reason, and text message. The options is a HASH which, amongst other things, may contain a stack trace and location. Translated components will have exception classes C, and C or C. On the moment, the C cannot be distiguished from the C (when used in package main) or C (otherwise). The returned reason depends on whether the translation of the current C<$!> is found in the STRING, and the presence of a stack trace. The following table is used: errstr stack => reason no no ERROR (die) application internal problem yes no FAULT (die) external problem, think open() no yes PANIC (confess) implementation error yes yes ALERT (confess) external problem, caught = @{$opt{stack}} ? ($opt{errno} ? 'ALERT' : 'PANIC') : ($opt{errno} ? 'FAULT' : 'ERROR'); =back =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Translator.pod0000644000175000001440000000624712231427545021670 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Translator - base implementation for translating messages =head1 INHERITANCE Log::Report::Translator is extended by Log::Report::Translator::Gettext Log::Report::Translator::POT =head1 SYNOPSIS # internal infrastructure my $msg = Log::Report::Message->new(_msgid => "Hello World\n"); print Log::Report::Translator->new(...)->translate($msg); # normal use use Log::Report 'my-domain'; print __"Hello World\n"; =head1 DESCRIPTION A module (or distribution) has a certain way of translating messages, usually C. The translator is based on some C for the message, which can be specified as option per text element, but usually is package scoped. This base class does not translate at all: it will use the MSGID (and MSGID_PLURAL if available). It's a nice fallback if the language packs are not installed. =head1 METHODS =head2 Constructors =over 4 =item Log::Report::Translator-EB(OPTIONS) -Option --Default charset lexicons =over 2 =item charset => STRING When the locale contains a codeset in its name, then that will be used. Otherwise, the default is C. =item lexicons => DIRECTORY|ARRAY-of-DIRECTORYs The DIRECTORY where the translations can be found. See L for the expected structure of such DIRECTORY. The default is based on the location of the module which instantiates this translator. The filename of the module is stripped from its C<.pm> extension, and used as directory name. Within that directory, there must be a directory named C, which will be the root directory of a L. =back example: default lexicon directory # file xxx/perl5.8.8/My/Module.pm use Log::Report 'my-domain' , translator => Log::Report::Translator::POT->new; # lexicon now in xxx/perl5.8.8/My/Module/messages/ =back =head2 Accessors =over 4 =item $obj-EB() Returns the default charset, which can be overrule by the locale. =item $obj-EB() Returns a list of L objects, where the translation files may be located. =back =head2 Translating =over 4 =item $obj-EB(DOMAIN, LOCALE) Load the translation information in the text DOMAIN for the indicated LOCALE. Multiple calls to L should not cost significant performance: the data must be cached. =item $obj-EB(MESSAGE, [LANGUAGE]) Returns the translation of the MESSAGE, a C object, based on the current locale. Translators are permitted to peek into the internal HASH of the message object, for performance reasons. =back =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Extract.pm0000644000175000001440000001106512231427545020775 0ustar00markovusers00000000000000# 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.998'; 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; Log-Report-0.998/lib/Log/Report/Extract.pod0000644000175000001440000000600612231427545021142 0ustar00markovusers00000000000000=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 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 file will be created. =head1 METHODS =head2 Constructors =over 4 =item Log::Report::Extract-EB(OPTIONS) -Option --Default charset 'utf-8' lexicon =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 file will be created. =back =back =head2 Accessors =over 4 =item $obj-EB() Returns the character-set used inside the POT files. =item $obj-EB() Returns a sorted list of all known domain names. =item $obj-EB() Returns the L object, which is listing the files in the lexicon directory tree. =item $obj-EB(DOMAIN) Returns the list of L objects which contain the tables for DOMAIN. =back =head2 Processors =over 4 =item $obj-EB(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-EB([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-EB(DOMAIN, FILENAME, LINENR, MSG, [MSG_PLURAL]) Register the existence of a (MSG, MSG_PLURAL) in all POTs of the DOMAIN. =item $obj-EB([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.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report/Dispatcher.pm0000644000175000001440000002161012231427545021446 0ustar00markovusers00000000000000# 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::Dispatcher; use vars '$VERSION'; $VERSION = '0.998'; use Log::Report 'log-report', syntax => 'SHORT'; use Log::Report::Util qw/parse_locale expand_reasons %reason_code escape_chars/; use POSIX qw/strerror/; use List::Util qw/sum/; use Encode qw/find_encoding FB_DEFAULT/; use Devel::GlobalDestruction qw/in_global_destruction/; eval { POSIX->import('locale_h') }; if($@) { no strict 'refs'; *setlocale = sub { $_[1] }; *LC_ALL = sub { undef }; } my %modes = (NORMAL => 0, VERBOSE => 1, ASSERT => 2, DEBUG => 3 , 0 => 0, 1 => 1, 2 => 2, 3 => 3); my @default_accept = ('NOTICE-', 'INFO-', 'ASSERT-', 'ALL'); my %predef_dispatchers = map { (uc($_) => __PACKAGE__.'::'.$_) } qw/File Perl Syslog Try Callback/; sub new(@) { my ($class, $type, $name, %args) = @_; 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"; $@ and alert "cannot use class $backend:\n$@"; (bless {name => $name, type => $type, filters => []}, $backend) ->init(\%args); } my %format_reason = ( LOWERCASE => sub { lc $_[0] } , UPPERCASE => sub { uc $_[0] } , UCFIRST => sub { ucfirst lc $_[0] } , IGNORE => sub { '' } ); my $default_mode = 'NORMAL'; sub init($) { my ($self, $args) = @_; my $mode = $self->_set_mode(delete $args->{mode} || $default_mode); $self->{locale} = delete $args->{locale}; my $accept = delete $args->{accept} || $default_accept[$mode]; $self->{needs} = [ expand_reasons $accept ]; my $f = delete $args->{format_reason} || 'LOWERCASE'; $self->{format_reason} = ref $f eq 'CODE' ? $f : $format_reason{$f} or error __x"illegal format_reason '{format}' for dispatcher", format => $f; my $csenc; if(my $cs = delete $args->{charset}) { my $enc = find_encoding $cs or error __x"Perl does not support charset {cs}", cs => $cs; $csenc = sub { no warnings 'utf8'; $enc->encode($_[0]) }; } $self->{charset_enc} = $csenc || sub { $_[0] }; $self; } sub close() { my $self = shift; $self->{closed}++ and return undef; $self->{disabled}++; $self; } sub DESTROY { in_global_destruction or shift->close } #---------------------------- sub name {shift->{name}} sub type() {shift->{type}} sub mode() {shift->{mode}} #Please use C $MODE;> sub defaultMode($) {$default_mode = $_[1]} # only to be used via Log::Report::dispatcher(mode => ...) # because requires re-investigating collective dispatcher needs sub _set_mode($) { my $self = shift; my $mode = $self->{mode} = $modes{$_[0]}; defined $mode or panic "unknown run mode $_[0]"; $self->{needs} = [ expand_reasons $default_accept[$mode] ]; info __x"switching to run mode {mode}, accept {accept}" , mode => $mode, accept => $default_accept[$mode]; $mode; } # only to be called from Log::Report::dispatcher()!! # because requires re-investigating needs sub _disabled($) { my $self = shift; @_ ? ($self->{disabled} = shift) : $self->{disabled}; } sub isDisabled() {shift->{disabled}} sub needs() { $_[0]->{disabled} ? () : @{$_[0]->{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) = @_; my $mode = $self->{mode}; my $code = $reason_code{$reason} or panic "unknown reason '$reason'"; my $show_loc = $always_loc{$reason} || ($mode==2 && $code >= $reason_code{WARNING}) || ($mode==3 && $code >= $reason_code{MISTAKE}); my $show_stack = $reason eq 'PANIC' || ($mode==2 && $code >= $reason_code{ALERT}) || ($mode==3 && $code >= $reason_code{ERROR}); my $locale = defined $msg->msgid ? ($opts->{locale} || $self->{locale}) # translate whole : Log::Report->_setting($msg->domain, 'native_language'); # 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 $r = $self->{format_reason}->((__$reason)->toString); my $e = $opts->{errno} ? strerror($opts->{errno}) : undef; my $format = $r && $e ? N__"{reason}: {message}; {error}" : $r ? N__"{reason}: {message}" : $e ? N__"{message}; {error}" : undef; my $text = defined $format ? __x($format, message => $msg->toString, reason => $r, error => $e )->toString : $msg->toString; $text .= "\n"; if($show_loc) { if(my $loc = $opts->{location} || $self->collectLocation) { my ($pkg, $fn, $line, $sub) = @$loc; # pkg and sub are missing when decoded by ::Die $text .= " " . __x( 'at {filename} line {line}' , filename => $fn, line => $line)->toString . "\n"; } } if($show_stack) { my $stack = $opts->{stack} ||= $self->collectStack; foreach (@$stack) { $text .= $_->[0] . " " . __x( 'at {filename} line {line}' , filename => $_->[1], line => $_->[2] )->toString . "\n"; } } setlocale(&LC_ALL, $oldloc) if defined $oldloc; $self->{charset_enc}->($text); } sub collectStack($) { my ($thing, $max) = @_; my ($nest, $sub) = (1, undef); do { $sub = (caller $nest++)[3] } while(defined $sub && $sub ne 'Log::Report::report'); defined $sub or $nest = 1; # not found # skip syntax==SHORT routine entries # $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 my @stack; while(!defined $max || $max--) { my ($pkg, $fn, $linenr, $sub) = caller $nest++; defined $pkg or last; my $line = $thing->stackTraceLine(call => $sub, params => \@DB::args); push @stack, [$line, $fn, $linenr]; } \@stack; } } sub collectLocation() { my $thing = shift; my $nest = 1; my @args; do {@args = caller $nest++} until $args[3] eq 'Log::Report::report'; # common entry point # skip syntax==SHORT routine entries @args = caller $nest++ if +(caller $nest)[3] =~ m/^Log\:\:Report\:\:[^:]*$/; @args ? \@args : undef; } sub stackTraceLine(@) { my ($thing, %args) = @_; my $max = $args{max_line} ||= 500; my $abstract = $args{abstract} || 1; my $maxparams = $args{max_params} || 8; my @params = @{$args{params}}; my $call = $args{call}; my $obj = ref $params[0] && $call =~ m/^(.*\:\:)/ && UNIVERSAL::isa($params[0], $1) ? shift @params : undef; my $listtail = ''; if(@params > $maxparams) { $listtail = ', [' . (@params-$maxparams) . ' more]'; $#params = $maxparams -1; } $max -= @params * 2 - length($listtail); # \( ( \,[ ] ){n-1} \) my $calling = $thing->stackTraceCall(\%args, $abstract, $call, $obj); my @out = map {$thing->stackTraceParam(\%args, $abstract, $_)} @params; my $total = sum map {length $_} $calling, @out; ATTEMPT: while($total <= $max) { $abstract++; last if $abstract > 2; # later more levels foreach my $p (reverse 0..$#out) { my $old = $out[$p]; $out[$p] = $thing->stackTraceParam(\%args, $abstract, $params[$p]); $total -= length($old) - length($out[$p]); last ATTEMPT if $total <= $max; } my $old = $calling; $calling = $thing->stackTraceCall(\%args, $abstract, $call, $obj); $total -= length($old) - length($calling); } $calling .'(' . join(', ',@out) . $listtail . ')'; } # 1: My::Object(0x123141, "my string") # 2: My::Object=HASH(0x1231451) # 3: My::Object("my string") # 4: My::Object() # sub stackTraceCall($$$;$) { my ($thing, $args, $abstract, $call, $obj) = @_; if(defined $obj) # object oriented { my ($pkg, $method) = $call =~ m/^(.*\:\:)(.*)/; return overload::StrVal($obj) . '->' . $call; } else # imperative { return $call; } } sub stackTraceParam($$$) { my ($thing, $args, $abstract, $param) = @_; defined $param or return 'undef'; $param = overload::StrVal($param) if ref $param; return $param # int or float if $param =~ /^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[eE][+-]?\d+)?$/; '"' . escape_chars($param) . '"'; } 1; Log-Report-0.998/lib/Log/Report/Win32Locale.pod0000644000175000001440000000511412231427545021551 0ustar00markovusers00000000000000=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() Returns the encoding name (usable with module Encode) based on the current codepage. For example, C for iso-8859-1 (latin-1) or C for Shift-JIS Japanese. Returns undef if the encoding cannot be identified. =item B(CODEPAGE) Translate windows CODEPAGE into ISO code. The CODEPAGE is numeric or a hex string like '0x0304'. =item B([CODEPAGE]) Returns the ISO string for the Microsoft codepage locale. Might return C/false. By default, the actual codepage is used. =item B(ISO) Returns the numeric value of the codepage. The ISO may look like this: C. Then, first the C is looked-up. If that does not exist, C is tried. =item B() Returns the numeric language ID for the current codepage language. For example, the numeric value for C<0x0409> for C, and C<0x0411> for C. Returns false if the codepage cannot be identified. =item B() Returns the numeric language ID for the installed codepage language. This is like L, but refers to the codepage that was the default when Windows was first installed. =item B() 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.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report.pod0000644000175000001440000011513412231427545017533 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report - report a problem, with exceptions and translation support =head1 INHERITANCE Log::Report is a Exporter =head1 SYNOPSIS # Invocation with mode helps debugging use Log::Report mode => 'DEBUG'; error "oops"; # like die(), no translation -f $config or panic "Help!"; # alert/error/fault/info/...more # 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; 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 # Produce an error, long syntax (rarely used) report ERROR => __x('gettext string', param => $param, ...) if $condition; # When syntax=SHORT (default since 0.26) error __x('gettext string', param => $param, ...) if $condition; # 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; # Avoid messages without report level for daemons print __"Hello World", "\n"; # only translation, no exception # 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 # translation depends on count print __xn("found one file", "found {_count} files", @files), "\n"; # borrow from an other textdomain (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 # Language translations at the IO/layer 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')) ... =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. Log::Report combines =over 4 =item . exceptions (like error and info), with =item . logging (like Log::Log4Perl and syslog), and =item . translations (like gettext and 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 section, below. Especially, you should B. Also, you can study this module swiftly via the article published in the German Perl $foo-magazine. English version: F =head1 FUNCTIONS =head2 Report Production and Configuration =over 4 =item B((TYPE, NAME, OPTIONS)|(COMMAND => NAME, [NAMEs])) The C function controls access to dispatchers: the back-ends which process messages, do the logging. Dispatchers are global entities, addressed by a symbolic NAME. Please read L as well. The C suite has its own dispatcher TYPES, but also connects to external dispatching frameworks. Each need some (minor) conversions, especially with respect to translation of REASONS of the reports into log-levels as the back-end understands. The OPTIONS are a mixture of parameters needed for the Log::Report dispatcher wrapper and the settings of the back-end. See L, the documentation for the back-end specific wrappers, and the back-ends for more details. Implemented COMMANDs are C, C, C, C, C, C, C, and C. Most commands are followed by a LIST of dispatcher NAMEs to be address. For C see section L; it requires a MODE argument before the LIST of NAMEs. Non-existing names will be ignored. When C is specified, then all existing dispatchers will get addressed. For C see L; it requires a CODE reference before the NAMEs of the dispatchers which will have the it applied (defaults to all). With C, you only provide a REASON: it will return the list of dispatchers which need to be called in case of a message with the REASON is triggered. For both the creation as COMMANDs version of this method, all objects involved are returned as LIST, non-existing ones skipped. In SCALAR context with only one name, the one object is returned. example: play with dispatchers dispatcher Log::Dispatcher::File => mylog => , accept => 'MISTAKE-' # for wrapper , locale => 'pt_BR' # other language , filename => 'logfile'; # for back-end dispatcher close => 'mylog'; # cleanup my $obj = dispatcher find => 'mylog'; my @obj = dispatcher 'list'; dispatcher disable => 'syslog'; dispatcher enable => 'mylog', 'syslog'; # more at a time dispatcher mode => 'DEBUG', 'mylog'; dispatcher mode => 'DEBUG', 'ALL'; my @need_info = dispatcher needs => 'INFO'; if(dispatcher needs => 'INFO') ... # anyone needs INFO # Getopt::Long integration: see Log::Report::Dispatcher::mode() dispatcher PERL => 'default', mode => 'DEBUG', accept => 'ALL' if $debug; =item B([HASH-of-OPTIONS], REASON, MESSAGE|(STRING,PARAMS),) 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, L etc functions which are nicer names for this exception throwing: better use those short names. The REASON is a string like 'ERROR'. The MESSAGE is a L 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 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. 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. -Option --Default errno $! or 1 is_fatal locale undef location undef stack undef to undef =over 2 =item errno => INTEGER When the REASON includes the error text (See L), you can overrule the error code kept in C<$!>. In other cases, the return code default 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. =item is_fatal => BOOLEAN Some logged exceptions are fatal, other aren't. The default usually is correct. However, you may want an error to be caught (usually with L), redispatch it to syslog, but without it killing the main program. =item locale => LOCALE Use this specific locale, in stead of the user's preference. =item location => STRING When defined, this location is used in the display. Otherwise, it is determined automatically if needed. An empty string will disable any attempt to display this line. =item stack => ARRAY When defined, that data is used to display the call stack. Otherwise, it is collected via C if needed. =item to => NAME|ARRAY-of-NAMEs Sent the MESSAGE only to the NAMEd dispatchers. Ignore unknown NAMEs. Still, the dispatcher needs to be enabled and accept the REASONs. =back example: for use of L # long syntax example report TRACE => "start processing now"; report INFO => '500: ' . __'Internal Server Error'; # explicit dispatcher, no translation report {to => 'syslog'}, NOTICE => "started process $$"; notice "started process $$", _to => 'syslog'; # same # short syntax examples trace "start processing now"; warning __x'Disk {percent%.2f}% full', percent => $p if $p > 97; # error message, overruled to be printed in Brazilian report {locale => 'pt_BR'} , WARNING => "do this at home!"; =item B(CODE, OPTIONS) Execute the CODE while blocking all dispatchers as long as it is running. The exceptions which occur while running the CODE are caught until it has finished. When there where no fatal errors, the result of the CODE execution is returned. After the CODE was tried, the C<$@> will contain a L object, which contains the collected messages. Run-time errors from Perl and die's, croak's and confess's within the program (which shouldn't appear, but you never know) are collected into an L object, using L. The OPTIONS are passed to the constructor of the try-dispatcher, see L. For instance, you may like to add C<< mode => 'DEBUG' >>, or C<< accept => 'ERROR-' >>. B that the parameter to C is a CODE reference. This means that you shall not use a comma after the block when there are OPTIONS specified. On the other hand, you shall use a semi-colon after the block if there are no arguments. B that the {} are interpreted as subroutine, which means that, for instance, it has its own C<@_>. The manual-page of Try::Tiny lists a few more side-effects of this. example: my $x = try { 3/$x }; # mind the ';' !! if($@) { # signals something went wrong if(try {...}) { # block ended normally, returns bool try { ... } # no comma!! mode => 'DEBUG', accept => 'ERROR-'; try sub { ... }, # with comma, also \&function mode => 'DEBUG', accept => 'ALL'; my $response = try { $ua->request($request) }; if(my $e = $@->wasFatal) ... =back =head2 Abbreviations for report() The following functions are all wrappers for calls to L, and available when "syntax is SHORT" (by default, see L). You cannot specify additional options to influence the behavior of C, which are usually not needed anyway. =over 4 =item B(MESSAGE) Short for C<< report ALERT => MESSAGE >> =item B(MESSAGE) Short for C<< report ASSERT => MESSAGE >> =item B(MESSAGE) Short for C<< report ERROR => MESSAGE >> =item B(MESSAGE) Short for C<< report FAILURE => MESSAGE >> =item B(MESSAGE) Short for C<< report FAULT => MESSAGE >> =item B(MESSAGE) Short for C<< report INFO => MESSAGE >> =item B(MESSAGE) Short for C<< report MISTAKE => MESSAGE >> =item B(MESSAGE) Short for C<< report NOTICE => MESSAGE >> =item B(MESSAGE) Short for C<< report PANIC => MESSAGE >> =item B(MESSAGE) Short for C<< report TRACE => MESSAGE >> =item B(MESSAGE) Short for C<< report WARNING => MESSAGE >> =back =head2 Language Translations The language translations are initiate by limited set of functions which contain B (C<__>) in their name. Most of them return a L object. B that -in general- its considered very bad practice to combine multiple translations into one message: translating may also affect the order of the translated components. Besides, when the person which translates only sees smaller parts of the text, his (or her) job becomes more complex. So: print __"Hello" . ', ' . __"World!"; # works, but to be avoided print __"Hello, World!"; # preferred, complete sentence The the former case, tricks with overloading used by the L objects will still make delayed translations work. In normal situations, it is not a problem to translate interpolated values: print __"the color is {c}", c => __"red"; B that using C<< __'Hello' >> will produce a syntax error like "String found where operator expected at .... Can't find string terminator "'" anywhere before EOF". The first quote is the cause of the complaint, but the second generates the error. In the early days of Perl, the single quote was used to separate package name from function name, a role which was later replaced by a double-colon. So C<< __'Hello' >> gets interpreted as C<< __::Hello ' >>. Then, there is a trailing single quote which has no counterpart. =over 4 =item B(MSGID) Label to indicate that the string is a text which will be translated later. The function itself does nothing. See also L. This no-op function is used as label to the xgettext program to build the translation tables. example: how to use N__() # add three msgids to the translation table my @colors = (N__"red", N__"green", N__"blue"); my @colors = N__w "red green blue"; # same print __ $colors[1]; # translate green # using __(), would work as well my @colors = (__"red", __"green", __"blue"); print $colors[1]; # however: this will always create all Log::Report::Message objects, # where maybe only one is used. =item B(SINGLE_MSGID, PLURAL_MSGID) Label to indicate that the two MSGIDs are related, the first as single, the seconds as its plural. Only used to find the text fragments to be translated. The function itself does nothing. example: how to use L my @save = N__n "save file", "save files"; my @save = (N__n "save file", "save files"); my @save = N__n("save file", "save files"); # be warned about SCALARs in prototype! print __n @save, $nr_files; # wrong! print __n $save[0], $save[1], @files, %vars; =item B(STRING) This extension to the Locale::TextDomain syntax, is a combined C (list of quoted words) and L into a list of translatable words. example: of L my @colors = (N__"red", N__"green", N__"blue"); my @colors = N__w"red green blue"; # same print __ $colors[1]; =item B<__>(MSGID) This function (name is B under-score characters) will cause the MSGID to be replaced by the translations when doing the actual output. Returned is a L object, which will be used in translation later. Translating is invoked when the object gets stringified. When you have no translation tables, the MSGID will be shown untranslated. If you need options for L then use L<__x()|Log::Report/"Language Translations">; the prototype of this function does not permit parameters: it is a prefix operator! example: how to use __() print __"Hello World"; # translated into user's language print __'Hello World'; # syntax error! print __('Hello World'); # ok, translated print __"Hello", " World"; # World not translated my $s = __"Hello World"; # creates object, not yet translated print ref $s; # Log::Report::Message print $s; # ok, translated print $s->toString('fr'); # ok, forced into French =item B<__n>(MSGID, PLURAL_MSGID, COUNT, PAIRS) It depends on the value of COUNT (and the selected language) which text will be displayed. When translations can not be performed, then MSGID will be used when COUNT is 1, and PLURAL_MSGSID in other cases. However, some languages have more complex schemes than English. The PAIRS are options for L and variables to be filled in. example: how to use __n() print __n "one", "more", $a; print __n("one", "more", $a), "\n"; print +(__n "one", "more", $a), "\n"; # new-lines are ignore at lookup, but printed. print __n "one\n", "more\n", $a; # count is in scalar context # the value is also available as _count print __n "found one\n", "found {_count}\n", @r; # ARRAYs and HASHes are counted print __n "one", "more", \@r; =item B<__nx>(MSGID, PLURAL_MSGID, COUNT, PAIRS) It depends on the value of COUNT (and the selected language) which text will be displayed. See details in L<__n()|Log::Report/"Language Translations">. After translation, the VARIABLES will be filled-in. The PAIRS are options for L and variables to be filled in. example: how to use __nx() print __nx "one file", "{_count} files", $nr_files; print __nx "one file", "{_count} files", @files; local $" = ', '; print __nx "one file: {f}", "{_count} files: {f}", @files, f => \@files; =item B<__x>(MSGID, PAIRS) Translate the MSGID and then interpolate the VARIABLES in that string. Of course, translation and interpolation is delayed as long as possible. Both OPTIONS and VARIABLES are key-value pairs. The PAIRS are options for L and variables to be filled in. =item B<__xn>(SINGLE_MSGID, PLURAL_MSGID, COUNT, PAURS) Same as L<__nx()|Log::Report/"Language Translations">, because we have no preferred order for 'x' and 'n'. =back =head2 Configuration =over 4 =item $obj-EB([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. -Option --Default import undef mode 'NORMAL' native_language 'en_US' syntax 'SHORT' translator =over 2 =item import => FUNCTION|ARRAY [0.998] When not specified, the C option determines the list of functions which are being exported. With this option, the C option is ignored and only the specified FUNCTION(s) are imported. =item 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 L) to your name-space. Otherwise, each message must be produced with L. C is an alternative to C: 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 'my-domain'; # in each package producing messages use Log::Report 'my-domain' # in one package, top of distr , mode => 'VERBOSE' , translator => Log::Report::Translator::POT->new ( lexicon => '/home/mine/locale' # bindtextdomain , charset => 'UTF-8' # codeset ) , native_language => 'nl_NL' # untranslated msgs are Dutch , syntax => 'REPORT';# report ERROR, not error() use Log::Report import => 'try'; # or ARRAY of functions =item Log::Report-EB(TEXTDOMAIN, [TRANSLATOR]) Returns the translator configured for the TEXTDOMAIN. By default, a translator is configured which does not translate but directly uses the gettext message-ids. When a TRANSLATOR is specified, it will be set to be used for the TEXTDOMAIN. When it is C, the configuration is removed. You can only specify one TRANSLATOR per TEXTDOMAIN. example: use if L # 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(...); =back =head2 Reasons =over 4 =item $obj-EB(REASON) =item Log::Report-EB(REASON) Returns true if the REASON is severe enough to cause an exception (or program termination). =item $obj-EB(STRING) =item Log::Report-EB(STRING) Returns true if the STRING is one of the predefined REASONS. =item $obj-EB(REASON, [REASONS]) =item Log::Report-EB(REASON, [REASONS]) Returns true when the reporter needs any of the REASONS, when any of the active dispatchers is collecting messages in the specified level. This is useful when the processing of data for the message is relatively expensive, but for instance only required in debug mode. example: if(Log::Report->needs('TRACE')) { my @args = ...expensive calculation...; trace "your options are: @args"; } =back =head1 DETAILS =head2 Introduction 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, C, C, C, or C, which have no way of configuring the way of delivery to the user. Therefore, they are replaced with a single new command: C (with various abbreviations) Besides, the C/C/C 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. The REASON argument to C replace them all. The 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. =head2 Background ideas The following ideas are the base of this implementation: =over 4 =item . simplification Handling errors and warnings is probably the most labor-intensive task for a programmer: when programs are written correctly, up-to three-quarters of the code is related to testing, reporting, and handling (problem) conditions. Simplifying the way to create reports, simplifies programming and maintenance. =item . multiple dispatchers It is not the location where the (for instance) error occurs 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)) =item . delayed translations The background ideas are that of Locale::TextDomain, based on C. However, the C 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. =back =head2 Error handling models There are two approaches to handling errors and warnings. In the first approach, as produced by C, C and the C family of commands, the program handles the problem immediately on the location where the problem appears. In the second approach, an I is thrown on the spot where the problem is created, and then somewhere else in the program the condition is handled. The implementation of exceptions in Perl5 is done with a eval-die pair: on the spot where the problem occurs, C is called. But, because of the execution of that routine is placed within an C, the program as a whole will not die, just the execution of a part of the program will seize. However, what if the condition which caused the routine to die is solvable on a higher level? Or what if the user of the code doesn't bother that a part fails, because it has implemented alternatives for that situation? Exception handling is quite clumsy in Perl5. The C set of distributions let modules concentrate on the program flow, and let the main program decide on the report handling model. The infrastructure to translate messages into multiple languages, whether to create exceptions or carp/die, to collect longer explanations with the messages, to log to mail or syslog, and so on, is decided in pluggable back-ends. =head3 The Reason for the report Traditionally, perl has a very simple view on error reports: you either have a warning or an error. However, it would be much clearer for user's and module-using applications, when a distinction is made between various causes. For instance, a configuration error is quite different from a disk-full situation. In C, the produced reports in the code tell I is wrong. The main application defines loggers, which interpret the cause into (syslog) levels. Defined by C are =over 4 =item . trace (debug, program) The message will be used when some logger has debugging enabled. The messages show steps taken by the program, which are of interest by the developers and maintainers of the code, but not for end-users. =item . assert (program) Shows an unexpected condition, but continues to run. When you want the program to abort in such situation, that use C. =item . info (verbose, program) These messages show larger steps in the execution of the program. Experienced users of the program usually do not want to see all these intermediate steps. Most programs will display info messages (and higher) when some C flag is given on the command-line. =item . notice (program) An user may need to be aware of the program's accidental smart behavior, for instance, that it initializes a lasting C directory in your home directory. Notices should be sparse. =item . warning (program) The program encountered some problems, but was able to work around it by smart behavior. For instance, the program does not understand a line from a log-file, but simply skips the line. =item . mistake (user) When a user does something wrong, but what is correctable by smart behavior of the program. For instance, in some configuration file, you can fill-in "yes" or "no", but the user wrote "yeah". The program interprets this as "yes", producing a mistake message as warning. It is much nicer to tell someone that he/she made a mistake, than to call that an error. =item . error (user) The user did something wrong, which is not automatically correctable or the program is not willing to correct it automatically for reasons of code quality. For instance, an unknown option flag is given on the command-line. These are configuration issues, and have no useful value in C<$!>. The program will be stopped, usually before taken off. =item . fault (system) The program encountered a situation where it has no work-around. For instance, a file cannot be opened to be written. The cause of that problem can be some user error (i.e. wrong filename), or external (you accidentally removed a directory yesterday). In any case, the C<$!> (C<$ERRNO>) variable is set here. =item . alert (system) Some external cause disturbs the execution of the program, but the program stays alive and will try to continue operation. For instance, the connection to the database is lost. After a few attempts, the database can be reached and the program continues as if nothing happened. The cause is external, so C<$!> is set. Usually, a system administrator needs to be informed about the problem. =item . failure (system) Some external cause makes it impossible for this program to continue. C<$!> is set, and usually the system administrator wants to be informed. The program will die. The difference with C is subtile and not always clear. A fault reports an error returned by an operating system call, where the failure would report an operational problem, like a failing mount. =item . panic (program) All above report classes are expected: some predictable situation is encountered, and therefore a message is produced. However, programs often do some internal checking. Of course, these conditions should never be triggered, but if they do... then we can only stop. For instance, in an OO perl module, the base class requires all sub-classes to implement a certain method. The base class will produce a stub method with triggers a panic when called. The non-dieing version of this test C. =back I or being C are run-time behaviors, and have nothing directly to do with the type of message which is produced. These two are B which can be set on the dispatchers: one dispatcher may be more verbose that some other. On purpose, we do not use the terms C or C, because the dispatcher can be configured what to do in cause of which condition. For instance, it may decide to stop execution on warnings as well. The terms C and C are avoided, because the program cause versus user cause distinction (warn vs carp) is reflected in the use of different reasons. There is no need for C and C either, because the dispatcher can be configured to produce stack-trace information (for a limited sub-set of dispatchers) =head3 Report levels Various frameworks used with perl programs define different labels to indicate the reason for the message to be produced. Perl5 Log::Dispatch Syslog Log4Perl Log::Report print 0,debug debug debug trace print 0,debug debug debug assert print 1,info info info info warn\n 2,notice notice info notice warn 3,warning warn warn mistake carp 3,warning warn warn warning die\n 4,error err error error die 5,critical crit fatal fault croak 6,alert alert fatal alert croak 7,emergency emerg fatal failure confess 7,emergency emerg fatal panic =head3 Run modes The run-mode change which messages are passed to a dispatcher, but from a different angle than the dispatch filters; the mode changes behavioral aspects of the messages, which are described in detail in L. However, it should behave as you expect: the DEBUG mode shows more than the VERBOSE mode, and both show more than the NORMAL mode. =head3 Exceptions The simple view on live says: you 're dead when you die. However, more complex situations try to revive the dead. Typically, the "die" is considered a terminating exception, but not terminating the whole program, but only some logical block. Of course, a wrapper round that block must decide what to do with these emerging problems. Java-like languages do not "die" but throw exceptions which contain the information about what went wrong. Perl modules like C simulate this. It's a hassle to create exception class objects for each emerging problem, and the same amount of work to walk through all the options. Log::Report follows a simpler scheme. Fatal messages will "die", which is caught with "eval", just the Perl way (used invisible to you). However, the wrapper gets its hands on the message as the user has specified it: untranslated, with all unprocessed parameters still at hand. try { fault __x "cannot open file {file}", file => $fn }; if($@) # is Log::Report::Dispatcher::Try { my $cause = $@->wasFatal; # is Log::Report::Exception $cause->throw if $cause->message->msgid =~ m/ open /; # all other problems ignored } See L and L. =head2 Comparison =head3 die/warn/Carp A typical perl5 program can look like this my $dir = '/etc'; File::Spec->file_name is_absolute($dir) or die "ERROR: directory name must be absolute.\n"; -d $dir or die "ERROR: what platform are you on?"; until(opendir DIR, $dir) { warn "ERROR: cannot read system directory $dir: $!"; sleep 60; } print "Processing directory $dir\n" if $verbose; while(defined(my $file = readdir DIR)) { if($file =~ m/\.bak$/) { warn "WARNING: found backup file $dir/$f\n"; next; } die "ERROR: file $dir/$file is binary" if $debug && -B "$dir/$file"; print "DEBUG: processing file $dir/$file\n" if $debug; open FILE, "<", "$dir/$file" or die "ERROR: cannot read from $dir/$f: $!"; close FILE or croak "ERROR: read errors in $dir/$file: $!"; } Where C, C, and C are used for various tasks. With C, you would write use Log::Report syntax => 'SHORT'; # can be left-out when there is no debug/verbose dispatcher PERL => 'default', mode => 'DEBUG'; my $dir = '/etc'; File::Spec->file_name is_absolute($dir) or mistake "directory name must be absolute"; -d $dir or panic "what platform are you on?"; until(opendir DIR, $dir) { alert "cannot read system directory $dir"; sleep 60; } info "Processing directory $dir"; while(defined(my $file = readdir DIR)) { if($file =~ m/\.bak$/) { notice "found backup file $dir/$f"; next; } assert "file $dir/$file is binary" if -B "$dir/$file"; trace "processing file $dir/$file"; unless(open FILE, "<", "$dir/$file") { error "no permission to read from $dir/$f" if $!==ENOPERM; fault "unable to read from $dir/$f"; } close FILE or failure "read errors in $dir/$file"; } A lot of things are quite visibly different, and there are a few smaller changes. There is no need for a new-line after the text of the message. When applicable (error about system problem), then the C<$!> is added automatically. The distinction between C and C 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. A CPAN module like C 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 Log::Log4perl; both provide a pluggable logging interface. Both frameworks do not have (gettext or maketext) language translation support, which has various consequences. When you wish for to report in some other language, it must be translated before the logging function is called. This may mean that an error message is produced in Chinese, and therefore also ends-up in the syslog file in Chinese. When this is not your language, you have a problem. Log::Report translates only in the back-end, which means that the user may get the message in Chinese, but you get your report in your beloved Dutch. When no dispatcher needs to report the message, then no time is lost in translating. With both logging frameworks, you use terminology comparable to syslog: the module programmer determines the seriousness of the error message, not the application which integrates multiple modules. This is the way perl programs usually work, but often the cause for inconsequent user interaction. =head3 Locale::gettext and Locate::TextDomain Both on GNU gettext based implementations can be used as translation frameworks. Locale::TextDomain syntax is supported, with quite some extensions. Read the excellent documentation of Locale::Textdomain. Only the tried access via C<$__> and C<%__> are not supported. The main difference with these modules is the moment when the translation takes place. In Locale::TextDomain, an C<__x()> will result in an immediate translation request via C. C's version of C<__x()> will only capture what needs to be translated in an object. When the object is used in a print statement, only then the translation will take place. This is needed to offer ways to send different translations of the message to different destinations. To be able to postpone translation, objects are returned which stringify into the translated text. =head1 DIAGNOSTICS =over 4 =item Error: in SCALAR context, only one dispatcher name accepted The L method returns the L objects which it has accessed. When multiple names where given, it wishes to return a LIST of objects, not the count of them. =back =head1 SEE ALSO This module is part of Log-Report distribution version 0.998, built on October 22, 2013. Website: F =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 Log-Report-0.998/lib/Log/Report.pm0000644000175000001440000003247512231427545017373 0ustar00markovusers00000000000000# 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; use vars '$VERSION'; $VERSION = '0.998'; use base 'Exporter'; use List::Util qw/first/; # domain 'log-report' via work-arounds: # Log::Report cannot do "use Log::Report" my @make_msg = qw/__ __x __n __nx __xn N__ N__n N__w/; my @functions = qw/report dispatcher try/; 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 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')); __PACKAGE__->_setting('rescue', translator => Log::Report::Translator->new); 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 $reason = shift; my $stop = exists $opts->{is_fatal} ? $opts->{is_fatal} :$is_fatal{$reason}; # return when no-one needs it: skip unused trace() fast! my $disp = $reporter->{needs}{$reason}; $disp || $stop or return; $is_reason{$reason} or error __x"token '{token}' not recognized as reason", token=>$reason; $opts->{errno} ||= $!+0 || $? || 1 if $use_errno{$reason} && !defined $opts->{errno}; 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} ]; } else { $disp = [ grep $_->name eq $to, @$disp ]; } @$disp || $stop or return; } $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"; } elsif(UNIVERSAL::isa($message, 'Log::Report::Exception')) { $exception = $message; $message = $exception->message; } else { # untranslated message into object @_%2 and error __x"odd length parameter list with '{msg}'", msg => $message; $message = Log::Report::Message->new(_prepend => $message, @_); } if(my $to = $message->to) { $disp = [ grep $_->name eq $to, @$disp ]; @$disp or return; } my @last_call; # call Perl dispatcher always last if($reporter->{filters}) { DISPATCHER: foreach my $d (@$disp) { my ($r, $m) = ($reason, $message); foreach my $filter ( @{$reporter->{filters}} ) { next if keys %{$filter->[1]} && !$filter->[1]{$d->name}; ($r, $m) = $filter->[0]->($d, $opts, $r, $m); $r or next DISPATCHER; } if($d->isa('Log::Report::Dispatcher::Perl')) { @last_call = ($d, { %$opts }, $r, $m) } else { $d->log($opts, $r, $m) } } } else { foreach my $d (@$disp) { if($d->isa('Log::Report::Dispatcher::Perl')) { @last_call = ($d, { %$opts }, $reason, $message) } else { $d->log($opts, $reason, $message) } } } 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); $! = $opts->{errno} || 0; $@ = $exception || Log::Report::Exception->new(report_opts => $opts , reason => $reason, message => $message); die; # $@->PROPAGATE() will be called, some eval will catch this } @$disp; } sub dispatcher($@) { if($_[0] !~ m/^(?:close|find|list|disable|enable|mode|needs|filter)$/) { my ($type, $name) = (shift, shift); my $disp = Log::Report::Dispatcher->new($type, $name , mode => $default_mode, @_); defined $disp or return; # use defined, because $disp is overloaded # old dispatcher with same name will be closed in DESTROY $reporter->{dispatchers}{$name} = $disp; _whats_needed; return ($disp); } my $command = shift; if($command eq 'list') { mistake __"the 'list' sub-command doesn't expect additional parameters" if @_; return values %{$reporter->{dispatchers}}; } if($command eq 'needs') { my $reason = shift || 'undef'; error __"the 'needs' sub-command parameter '{reason}' is not a reason" unless $is_reason{$reason}; my $disp = $reporter->{needs}{$reason}; return $disp ? @$disp : (); } if($command eq 'filter') { my $code = shift; error __"the 'filter' sub-command needs a CODE reference" unless ref $code eq 'CODE'; my %names = map { ($_ => 1) } @_; push @{$reporter->{filters}}, [ $code, \%names ]; return (); } my $mode = $command eq 'mode' ? shift : undef; my $all_disp = @_==1 && $_[0] eq 'ALL'; my @disps = $all_disp ? keys %{$reporter->{dispatchers}} : @_; my @dispatchers = grep defined, @{$reporter->{dispatchers}}{@disps}; @dispatchers or return; error __"only one dispatcher name accepted in SCALAR context" if @dispatchers > 1 && !wantarray && defined wantarray; if($command eq 'close') { delete @{$reporter->{dispatchers}}{@disps}; $_->close for @dispatchers; } elsif($command eq 'enable') { $_->_disabled(0) for @dispatchers } elsif($command eq 'disable') { $_->_disabled(1) for @dispatchers } elsif($command eq 'mode') { Log::Report::Dispatcher->defaultMode($mode) if $all_disp; $_->_set_mode($mode) for @dispatchers; } # find does require reinventarization _whats_needed unless $command eq 'find'; wantarray ? @dispatchers : $dispatchers[0]; } END { $_->close for grep defined, values %{$reporter->{dispatchers}} } # _whats_needed # Investigate from all dispatchers which reasons will need to be # passed on. After dispatchers are added, enabled, or disabled, # this method shall be called to re-investigate the back-ends. sub _whats_needed() { my %needs; foreach my $disp (values %{$reporter->{dispatchers}}) { push @{$needs{$_}}, $disp for $disp->needs; } $reporter->{needs} = \%needs; } sub try(&@) { my $code = shift; @_ % 2 and report {location => [caller 0]}, PANIC => __x"odd length parameter list for try(): forgot the terminating ';'?"; local $reporter->{dispatchers} = undef; local $reporter->{needs}; my $disp = dispatcher TRY => 'try', @_; 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); $disp->log($opts, $reason, __$text); } $disp->died($err); $@ = $disp; wantarray ? @ret : $ret; } sub trace(@) {report TRACE => @_} sub assert(@) {report ASSERT => @_} sub info(@) {report INFO => @_} sub notice(@) {report NOTICE => @_} sub warning(@) {report WARNING => @_} sub mistake(@) {report MISTAKE => @_} sub error(@) {report ERROR => @_} sub fault(@) {report FAULT => @_} sub alert(@) {report ALERT => @_} sub failure(@) {report FAILURE => @_} sub panic(@) {report PANIC => @_} sub _default_domain(@) { my $f = $domain_start{$_[1]} or return undef; my $domain; do { $domain = $_->[1] if $_->[0] < $_[2] } for @$f; $domain; } sub __($) { Log::Report::Message->new ( _msgid => shift , _domain => _default_domain(caller) ); } # label "msgid" added before first argument 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 , _expand => 1 , _domain => _default_domain(caller) , @_ ); } sub __n($$$@) { my ($single, $plural, $count) = (shift, shift, shift); Log::Report::Message->new ( _msgid => $single , _plural => $plural , _count => $count , _domain => _default_domain(caller) , @_ ); } sub __nx($$$@) { my ($single, $plural, $count) = (shift, shift, shift); Log::Report::Message->new ( _msgid => $single , _plural => $plural , _count => $count , _expand => 1 , _domain => _default_domain(caller) , @_ ); } sub __xn($$$@) # repeated for prototype { my ($single, $plural, $count) = (shift, shift, shift); Log::Report::Message->new ( _msgid => $single , _plural => $plural , _count => $count , _expand => 1 , _domain => _default_domain(caller) , @_ ); } sub N__($) { $_[0] } sub N__n($$) {@_} sub N__w(@) {split " ", $_[0]} sub import(@) { my $class = shift; my $textdomain = @_%2 ? shift : undef; my %opts = @_; my ($pkg, $fn, $linenr) = caller; if(my $trans = delete $opts{translator}) { $class->translator($textdomain, $trans, $pkg, $fn, $linenr); } if(my $native = delete $opts{native_language}) { my ($lang) = parse_locale $native; error "the specified native_language '{locale}' is not a valid locale" , locale => $native unless defined $lang; $class->_setting($textdomain, native_language => $native , $pkg, $fn, $linenr); } 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; if(my $in = $opts{import}) { push @export, ref $in eq 'ARRAY' ? @$in : $in; } else { push @export, @functions, @make_msg; my $syntax = delete $opts{syntax} || 'SHORT'; if($syntax eq 'SHORT') { push @export, @reason_functions } elsif($syntax ne 'REPORT' && $syntax ne 'LONG') { error __x"syntax flag must be either SHORT or REPORT, not `{flag}'" , flag => $syntax; } } $class->export_to_level(1, undef, @export); } sub translator($;$$$$) { my ($class, $domain) = (shift, shift); @_ or return $class->_setting($domain => 'translator') || $class->_setting(rescue => 'translator'); defined $domain or error __"textdomain for translator not defined"; 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"; $class->_setting($domain, translator => $translator, $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} ? $settings{$domain}{$name} : undef); # 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; error __x"value for {name} specified twice", name => $name if exists $s->{$name}; $s->{$name} = $value; } sub isValidReason($) { $is_reason{$_[1]} } sub isFatal($) { $is_fatal{$_[1]} } sub needs(@) { my $thing = shift; my $self = ref $thing ? $thing : $reporter; first {$self->{needs}{$_}} @_; } 1; Log-Report-0.998/MANIFEST0000644000175000001440000000431612231427551015412 0ustar00markovusers00000000000000ChangeLog MANIFEST Makefile.PL README bin/xgettext-perl lib/Log/Report.pm lib/Log/Report.pod lib/Log/Report/Die.pm lib/Log/Report/Die.pod lib/Log/Report/Dispatcher.pm lib/Log/Report/Dispatcher.pod lib/Log/Report/Dispatcher/Callback.pm lib/Log/Report/Dispatcher/Callback.pod lib/Log/Report/Dispatcher/File.pm lib/Log/Report/Dispatcher/File.pod lib/Log/Report/Dispatcher/Log4perl.pm lib/Log/Report/Dispatcher/Log4perl.pod lib/Log/Report/Dispatcher/LogDispatch.pm lib/Log/Report/Dispatcher/LogDispatch.pod lib/Log/Report/Dispatcher/Perl.pm lib/Log/Report/Dispatcher/Perl.pod lib/Log/Report/Dispatcher/Syslog.pm lib/Log/Report/Dispatcher/Syslog.pod lib/Log/Report/Dispatcher/Try.pm lib/Log/Report/Dispatcher/Try.pod lib/Log/Report/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 t/00use.t t/04locale.t t/05util.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/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) Log-Report-0.998/t/0000755000175000001440000000000012231427551014520 5ustar00markovusers00000000000000Log-Report-0.998/t/20pot_read.t0000644000175000001440000000535112231427544016652 0ustar00markovusers00000000000000#!/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'); Log-Report-0.998/t/53log4perl.t0000644000175000001440000000335012231427544016610 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test Log::Log4perl (only very simple tests) use warnings; use strict; use File::Temp qw/tempfile/; use Test::More; use Log::Report undef, syntax => 'SHORT'; BEGIN { eval "require Log::Log4perl"; plan skip_all => 'Log::Log4perl not installed' if $@; my $sv = Log::Log4perl->VERSION; eval { Log::Log4perl->VERSION(1.00) }; plan skip_all => "Log::Log4perl too old (is $sv, requires 1.00)" if $@; plan tests => 5; } my ($out, $outfn) = tempfile; my $name = 'logger'; # adapted from the docs my $conf = <<__CONFIG; log4perl.category.$name = INFO, Logfile log4perl.appender.Logfile = Log::Log4perl::Appender::File log4perl.appender.Logfile.filename = $outfn log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout log4perl.appender.Logfile.layout.ConversionPattern = %d %F{2} %L> %m __CONFIG dispatcher 'Log::Log4perl' => $name, config => \$conf , to_level => ['ALERT-' => 3]; dispatcher close => 'default'; cmp_ok(-s $outfn, '==', 0); my $date_qr = qr!\d{4}/\d{2}/\d{2} \d{2}:\d{2}:\d{2}!; my ($line_number, $log_line, $expected_msg); notice "this is a test"; $line_number = __LINE__; my $s1 = -s $outfn; cmp_ok($s1, '>', 0); $log_line = <$out>; $log_line =~ s!\\!/!g; # windows $expected_msg = "$line_number> notice: this is a test"; # do not anchor at the end: $ does not match on Windows like($log_line, qr!^$date_qr t[/\\]53log4perl\.t \Q$expected_msg\E!); warning "some more"; $line_number = __LINE__; my $s2 = -s $outfn; cmp_ok($s2, '>', $s1); $log_line = do { <$out> }; $log_line =~ s!\\!/!g; # windows $expected_msg = "$line_number> warning: some more"; like($log_line, qr!^$date_qr t[/\\]53log4perl\.t \Q$expected_msg\E!); unlink $outfn; Log-Report-0.998/t/DieTests.pm0000644000175000001440000001071412231427545016610 0ustar00markovusers00000000000000# 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 DieTests; use vars '$VERSION'; $VERSION = '0.998'; use warnings; use strict; use Log::Report::Die qw/die_decode/; use Log::Report qw/log-report/; use Carp; use Test::More tests => 27; use DieTests; $! = 3; my $errno = $!+0; my $errstr = "$!"; sub process($) { my ($err, $opt, $reason, $message) = die_decode shift; $err =~ s/\d+\.?$/XX/; my $errno = $opt->{errno} || 'no errno'; my $loc = $opt->{location}; my $loca = $loc ? "$loc->[1]#XX" : 'no location'; my $stack = join "\n", map { join '#', $_->[0], $_->[1], 'XX' } @{$opt->{stack}}; <<__RESULT $reason: $message ($errno) $err $loca $stack __RESULT } sub run_tests() { ### #### Testing die_decode itself ### ok(1, "err $errno is '$errstr'"); # die eval { die "ouch" }; my $die_text1 = $@; is(process($die_text1), <<__OUT, "die"); ERROR: ouch (no errno) ouch at t/DieTests.pm line XX t/DieTests.pm#XX __OUT eval { die "ouch\n" }; my $die_text2 = $@; is(process($die_text2), <<__OUT, "die"); ERROR: ouch (no errno) ouch no location __OUT eval { $! = $errno; die "ouch $!" }; my $die_text3 = $@; is(process($die_text3), <<__OUT, "die"); FAULT: ouch (3) ouch No such process at t/DieTests.pm line XX t/DieTests.pm#XX __OUT eval { $! = $errno; die "ouch $!\n" }; my $die_text4 = $@; is(process($die_text4), <<__OUT, "die"); FAULT: ouch (3) ouch No such process no location __OUT # croak eval { croak "ouch" }; my $croak_text1 = $@; is(process($croak_text1), <<__OUT, "croak"); ERROR: ouch (no errno) ouch at t/41die.t line XX t/41die.t#XX __OUT eval { croak "ouch\n" }; my $croak_text2 = $@; is(process($croak_text2), <<__OUT, "croak"); ERROR: ouch (no errno) ouch t/41die.t#XX __OUT eval { $! = $errno; croak "ouch $!" }; my $croak_text3 = $@; is(process($croak_text3), <<__OUT, "croak"); FAULT: ouch (3) ouch No such process at t/41die.t line XX t/41die.t#XX __OUT eval { $! = $errno; croak "ouch $!\n" }; my $croak_text4 = $@; is(process($croak_text4), <<__OUT, "croak"); FAULT: ouch (3) ouch No such process t/41die.t#XX __OUT # confess eval { confess "ouch" }; my $confess_text1 = $@; is(process($confess_text1), <<__OUT, "confess"); PANIC: ouch (no errno) ouch at t/DieTests.pm line XX t/DieTests.pm#XX eval {...}#t/DieTests.pm#XX DieTests::run_tests()#t/41die.t#XX main::simple_wrapper()#t/41die.t#XX __OUT eval { confess "ouch\n" }; my $confess_text2 = $@; is(process($confess_text2), <<__OUT, "confess"); PANIC: ouch (no errno) ouch t/DieTests.pm#XX eval {...}#t/DieTests.pm#XX DieTests::run_tests()#t/41die.t#XX main::simple_wrapper()#t/41die.t#XX __OUT eval { $! = $errno; confess "ouch $!" }; my $confess_text3 = $@; is(process($confess_text3), <<__OUT, "confess"); ALERT: ouch (3) ouch No such process at t/DieTests.pm line XX t/DieTests.pm#XX eval {...}#t/DieTests.pm#XX DieTests::run_tests()#t/41die.t#XX main::simple_wrapper()#t/41die.t#XX __OUT if($^O eq 'MSWin32') { # perl bug http://rt.perl.org/rt3/Ticket/Display.html?id=81586 pass 'Win32/confess bug #81586'; } else { eval { $! = $errno; confess "ouch $!\n" }; my $confess_text4 = $@; is(process($confess_text4), <<__OUT, "confess"); ALERT: ouch (3) ouch No such process t/DieTests.pm#XX eval {...}#t/DieTests.pm#XX DieTests::run_tests()#t/41die.t#XX main::simple_wrapper()#t/41die.t#XX __OUT } ### #### Testing try{} with various die's ## my $r = try { die "Arggghh!"; 1 }; ok(defined $@, "try before you die"); ok(!$r, "no value returned"); isa_ok($@, 'Log::Report::Dispatcher::Try'); my $fatal1 = $@->wasFatal; isa_ok($fatal1, 'Log::Report::Exception'); my $msg1 = $fatal1->message; isa_ok($msg1, 'Log::Report::Message'); is("$msg1", 'Arggghh!'); try { eval "program not perl"; die $@ if $@ }; ok(defined $@, "parse not perl"); my $fatal2 = $@->wasFatal; isa_ok($fatal2, 'Log::Report::Exception'); my $msg2 = $fatal2->message; isa_ok($msg2, 'Log::Report::Message'); like("$msg2", qr/^syntax error at \(eval \d+\) line 1, near \"program not \"/); eval <<'__TEST' try { require "Does::Not::Exist"; }; ok(defined $@, "perl error"); my $fatal3 = $@->wasFatal; isa_ok($fatal3, 'Log::Report::Exception'); my $msg3 = $fatal3->message; isa_ok($msg3, 'Log::Report::Message'); like("$msg3", qr/^Can\'t locate Does\:\:Not\:\:Exist in \@INC /); __TEST } # run_tests() 1; Log-Report-0.998/t/31stack.t0000644000175000001440000000110012231427544016150 0ustar00markovusers00000000000000#!/usr/bin/env perl # test the lexicon index. use warnings; use strict; use lib 'lib', '../lib'; use Test::More tests => 1; use Log::Report; use Log::Report::Dispatcher; my $stack; my $start = __LINE__; sub hhh(@) { $stack = Log::Report::Dispatcher->collectStack(3) } sub ggg(@) { shift; hhh(@_) } sub fff(@) { ggg(reverse @_) } fff(42, 3.2, "this is a text"); is_deeply($stack, [ [ 'main::hhh(3.2, 42)', $0, $start+2 ] , [ 'main::ggg("this is a text", 3.2, 42)', $0, $start+3 ] , [ 'main::fff(42, 3.2, "this is a text")', $0, $start+5 ] ] ); Log-Report-0.998/t/52logdisp.t0000644000175000001440000000165012231427544016521 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test Log::Dispatch (only very simple tests) use warnings; use strict; use lib 'lib', '../lib'; use File::Temp qw/tempfile/; use Test::More; use Log::Report undef, syntax => 'SHORT'; BEGIN { eval "require Log::Dispatch"; plan skip_all => 'Log::Dispatch not installed' if $@; my $sv = Log::Dispatch->VERSION; eval { Log::Dispatch->VERSION(2.00) }; plan skip_all => "Log::Dispatch too old (is $sv, requires 2.00)" if $@; plan tests => 5; use_ok('Log::Report::Dispatcher::LogDispatch'); } use_ok('Log::Dispatch::File'); my ($out, $outfn) = tempfile; dispatcher 'Log::Dispatch::File' => 'logger' , filename => $outfn , to_level => ['ALERT-' => 'err']; dispatcher close => 'default'; cmp_ok(-s $outfn, '==', 0); notice "this is a test"; my $s1 = -s $outfn; cmp_ok($s1, '>', 0); warning "some more"; my $s2 = -s $outfn; cmp_ok($s2, '>', $s1); unlink $outfn; Log-Report-0.998/t/00use.t0000644000175000001440000000320412231427544015642 0ustar00markovusers00000000000000#!/usr/bin/env perl use warnings; use strict; use Test::More tests => 18; # The versions of the following packages are reported to help understanding # the environment in which the tests are run. This is certainly not a # full list of all installed modules. my @show_versions = qw/PPI POSIX Test::Pod Log::Log4perl Sys::Syslog Log::Dispatch /; warn "Perl $]\n"; foreach my $package (sort @show_versions) { eval "require $package"; my $report = !$@ ? "version ". ($package->VERSION || 'unknown') : $@ =~ m/^Can't locate/ ? "not installed" : "reports error"; warn "$package $report\n"; } use_ok('Log::Report'); use_ok('Log::Report::Die'); use_ok('Log::Report::Dispatcher'); use_ok('Log::Report::Dispatcher::File'); use_ok('Log::Report::Dispatcher::Try'); use_ok('Log::Report::Dispatcher::Perl'); use_ok('Log::Report::Dispatcher::Callback'); use_ok('Log::Report::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 Log-Report-0.998/t/22compact.t0000644000175000001440000000320412231427544016500 0ustar00markovusers00000000000000#!/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"); Log-Report-0.998/t/hello-world-slovak.po0000644000175000001440000000266312231427544020616 0ustar00markovusers00000000000000# -*- mode: po; coding: utf-8; -*- Slovenian message catalog for GNU gettext-example # Copyright (C) 2005 Yoyodyne, Inc. # Primož Peterlin , 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 \n" "Language-Team: Slovenian \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" Log-Report-0.998/t/11concat.t0000644000175000001440000000174212231427544016324 0ustar00markovusers00000000000000#!/usr/bin/env perl # Try concatenation use warnings; use strict; use lib 'lib', '../lib'; use Test::More tests => 15; use Log::Report; # no domains, no translator use Scalar::Util qw/refaddr/; ### examples from Log::Report::Message and more my $a = __"Hello"; isa_ok($a, 'Log::Report::Message'); my $b = $a . " World!\n"; isa_ok($b, 'Log::Report::Message'); cmp_ok(refaddr $a, '!=', refaddr $b); # must clone is("$b", "Hello World!\n"); my $c = 'a' . 'b' . __("c") . __("d") . "e" . __("f"); isa_ok($c, 'Log::Report::Message'); is("$c", "abcdef"); is($c->prepend, 'ab'); isa_ok($c->append, 'Log::Report::Message'); is($c->msgid, 'c'); is($c->untranslated->toString, 'abcdef'); my $d = __("Hello")->concat(' ')->concat(__"World!")->concat("\n"); isa_ok($d, 'Log::Report::Message'); is("$d", "Hello World!\n"); is($d->untranslated->toString, "Hello World!\n"); my $h = __"Hello"; my $w = __"World!"; my $e = "$h $w\n"; isa_ok($e, 'Log::Report::Message'); is("$e", "Hello World!\n"); Log-Report-0.998/t/50file.t0000644000175000001440000000563712231427544016006 0ustar00markovusers00000000000000#!/usr/bin/env perl # test the file back-end, without translations use warnings; use strict; use Test::More tests => 38; use Log::Report undef, syntax => 'SHORT'; use POSIX 'locale_h'; setlocale(LC_ALL, 'en_US'); my @disp = dispatcher 'list'; cmp_ok(scalar(@disp), '==', 1); isa_ok($disp[0], 'Log::Report::Dispatcher'); # start new dispatcher to file my $file1 = ''; open my($fh1), ">", \$file1 or die $!; my $d = dispatcher FILE => 'file1', to => $fh1; @disp = dispatcher 'list'; cmp_ok(scalar(@disp), '==', 2); ok(defined $d, 'created file dispatcher'); isa_ok($d, 'Log::Report::Dispatcher::File'); ok($d==$disp[0] || $d==$disp[1], 'in disp list'); ok(!$d->isDisabled); is($d->name, 'file1'); my @needs = $d->needs; cmp_ok(scalar(@needs), '>', 7, 'needs'); is($needs[0], 'NOTICE'); is($needs[-1], 'PANIC'); # start a second dispatcher to a file, which does accept everything # trace-info. my $file2 = ''; open my($fh2), ">", \$file2 or die $!; my $e = dispatcher FILE => 'file2' , format_reason => 'UPPERCASE' , to => $fh2, accept => '-INFO'; ok(defined $e, 'created second disp'); isa_ok($e, 'Log::Report::Dispatcher::File'); @disp = dispatcher 'list'; cmp_ok(scalar(@disp), '==', 3); @needs = $e->needs; cmp_ok(scalar(@needs), '>=', 3, 'needs'); is($needs[0], 'TRACE'); is($needs[-1], 'INFO'); # silence default dispatcher for tests dispatcher close => 'default'; @disp = dispatcher 'list'; cmp_ok(scalar(@disp), '==', 2); # # Start producing messages # cmp_ok(length $file1, '==', 0); cmp_ok(length $file2, '==', 0); trace "trace"; cmp_ok(length $file1, '==', 0, 'disp1 ignores trace'); my $t = length $file2; cmp_ok($t, '>', 0, 'disp2 take trace'); is($file2, "TRACE: trace\n"); my $linenr = __LINE__ +1; assert "assertive"; cmp_ok(length $file1, '==', 0, 'disp1 ignores assert'); my $t2 = length $file2; cmp_ok($t2, '>', $t, 'disp2 take assert'); is(substr($file2, $t), "ASSERT: assertive\n at $0 line $linenr\n"); info "just to inform you"; cmp_ok(length $file1, '==', 0, 'disp1 ignores info'); my $t3 = length $file2; cmp_ok($t3, '>', $t2, 'disp2 take info'); is(substr($file2, $t2), "INFO: just to inform you\n"); notice "note this!"; my $s = length $file1; cmp_ok($s, '>', 0, 'disp1 take notice'); is($file1, "notice: note this!\n"); # format_reason LOWERCASE my $t4 = length $file2; cmp_ok($t4, '==', $t3, 'disp2 ignores notice'); warning "oops, be warned!"; my $s2 = length $file1; cmp_ok($s2, '>', $s, 'disp1 take warning'); like(substr($file1, $s), qr/^warning: oops, be warned!/); my $t5 = length $file2; cmp_ok($t5, '==', $t4, 'disp2 ignores warnings'); # # test filters # my (@messages, @messages2); dispatcher filter => sub { push @messages, $_[3]; @_[2,3] }, 'file1'; dispatcher filter => sub { push @messages2, $_[3]; @_[2,3] }, 'file2'; notice "here we are"; cmp_ok(scalar(@messages), '==', 1, 'capture message'); is($messages[0]->toString, 'here we are'); cmp_ok(scalar(@messages2), '==', 0, 'do not capture message'); Log-Report-0.998/t/04locale.t0000644000175000001440000000321512231427544016313 0ustar00markovusers00000000000000#!/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 => 10; } 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"); 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); Log-Report-0.998/t/54try.t0000644000175000001440000000704012231427544015677 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test try() use warnings; use strict; use Test::More tests => 49; use Log::Report undef, syntax => 'SHORT'; use Carp; # required for tests eval { use POSIX ':locale_h', 'setlocale'; # avoid user's environment setlocale(LC_ALL, 'POSIX'); }; # start a new logger my $text = ''; open my($fh), '>', \$text; dispatcher close => 'default'; dispatcher FILE => 'out', to => $fh, accept => 'ALL'; cmp_ok(length $text, '==', 0, 'created normal file logger'); my $text_l1 = length $text; info "test"; my $text_l2 = length $text; cmp_ok($text_l2, '>', $text_l1); my @l1 = dispatcher 'list'; cmp_ok(scalar(@l1), '==', 1); is($l1[0]->name, 'out'); try { my @l2 = dispatcher 'list'; cmp_ok(scalar(@l2), '==', 1); is($l2[0]->name, 'try', 'only try dispatcher'); error "this is an error" }; my $caught = $@; # be careful with this... Test::More may spoil it. my @l3 = dispatcher 'list'; cmp_ok(scalar(@l3), '==', 1); is($l3[0]->name, 'out', 'original dispatcher restored'); isa_ok($caught, 'Log::Report::Dispatcher::Try'); ok($caught->failed); ok($caught ? 1 : 0); my @r1 = $caught->exceptions; cmp_ok(scalar(@r1), '==', 1); isa_ok($r1[0], 'Log::Report::Exception'); my @r2 = $caught->wasFatal; cmp_ok(scalar(@r2), '==', 1); isa_ok($r2[0], 'Log::Report::Exception'); 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; }; $@->reportAll; }; like($@, qr[^failure: oops]i); ### context my $context; my $scalar = try { $context = !wantarray && defined wantarray ? 'SCALAR' : 'OTHER'; my @x = 1..10; @x; }; is($context, 'SCALAR', 'try in SCALAR context'); cmp_ok($scalar, '==', 10); try { $context = !defined wantarray ? 'VOID' : 'OTHER'; 3; }; is($context, 'VOID', 'try in VOID context'); my @list = try { $context = wantarray ? 'LIST' : 'OTHER'; 1..5; }; is($context, 'LIST', 'try in LIST context'); cmp_ok(scalar @list, '==', 5); ### convert die/croak/confess # conversions by Log::Report::Die, see t/*die.t my $die = try { die "oops" }; ok(ref $@, 'caught die'); isa_ok($@, 'Log::Report::Dispatcher::Try'); my $die_ex = $@->wasFatal; isa_ok($die_ex, 'Log::Report::Exception'); is($die_ex->reason, 'ERROR'); like("$@", qr[^try-block stopped with ERROR: oops at ] ); my $croak = try { croak "oops" }; 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 ] ); my $confess = try { confess "oops" }; 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 ] ); Log-Report-0.998/t/51syslog.t0000644000175000001440000000111612231427544016374 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test syslog, but only mildly use warnings; use strict; use Test::More; use Log::Report undef, syntax => 'SHORT'; BEGIN { eval "require Sys::Syslog"; plan skip_all => 'Sys::Syslog not installed' if $@; my $sv = Sys::Syslog->VERSION; eval { Sys::Syslog->VERSION(0.11) }; plan skip_all => "Sys::Syslog too old (is $sv, requires 0.11)" if $@; plan tests => 1; use_ok('Log::Report::Dispatcher::Syslog'); } dispatcher SYSLOG => 'syslog', to_prio => ['ALERT-' => 'err']; dispatcher close => 'default'; notice "this is a test"; Log-Report-0.998/t/10interp.t0000644000175000001440000001077612231427544016364 0ustar00markovusers00000000000000#!/usr/bin/env perl # Try __ use warnings; use strict; use lib 'lib', '../lib'; use Test::More tests => 69; use Log::Report; # no domains, no translator use Scalar::Util qw/reftype/; ### examples from Log::Report::Message and more # Check overloading sub ol_is($$;$) { # since Test::More 0.95_01, is() does not stringify its arguments. # This means that overloading does not quick in. How to test # overloading now? my ($f, $s, $comment) = @_; overload::Overloaded($f) || overload::Overloaded($s) or die "both not overloaded, in '$f' and '$s'"; is("$f", "$s", $comment); } my $a = __"Hello"; ok(defined $a); is(ref $a, 'Log::Report::Message'); is(reftype $a, 'HASH'); ol_is(__"Hello World", 'Hello World'); ol_is(__"Hello World {a}", 'Hello World {a}'); ol_is(__('Hello World {a}'), 'Hello World {a}'); my $c = __x"Hello"; ok(defined $c); is(ref $c, 'Log::Report::Message'); is(reftype $c, 'HASH'); ol_is(__x("Hello World", a => 42), 'Hello World'); ol_is(__x("Hello World {a}", a => 42), 'Hello World 42'); ol_is((__x"Hello World {a}", a => 42), 'Hello World 42'); ol_is((__x "Hello World {a}", a => 42), 'Hello World 42'); ol_is((__x "{a}{a}{a}", a => 42), '424242'); my $d = __n"Hello","World",3; ok(defined $d); is(ref $d, 'Log::Report::Message'); is(reftype $d, 'HASH'); ol_is(__n("Hello", "World", 1), 'Hello'); ol_is(__n("Hello", "World", 0), 'World'); ol_is(__n("Hello", "World", 2), 'World'); my $e = __nx"Hello","World",3,a=>42; ok(defined $e); is(ref $e, 'Log::Report::Message'); is(reftype $e, 'HASH'); ol_is(__nx("Hel{a}lo", "Wor{a}ld", 1,a=>42), 'Hel42lo'); ol_is(__nx("Hel{a}lo", "Wor{a}ld", 0,a=>42), 'Wor42ld'); ol_is(__nx("Hel{a}lo", "Wor{a}ld", 2,a=>42), 'Wor42ld'); ol_is(__xn("Hel{a}lo", "Wor{a}ld", 2,a=>42), 'Wor42ld'); my $e1 = 1; ol_is((__nx "one", "more", $e1++), "one"); ol_is((__nx "one", "more", $e1), "more"); my @files = 'monkey'; my $nr_files = @files; ol_is((__nx "one file", "{_count} files", $nr_files), 'one file'); ol_is((__nx "one file", "{_count} files", @files), 'one file'); push @files, 'donkey'; $nr_files = @files; ol_is((__nx "one file", "{_count} files", $nr_files), '2 files'); ol_is((__nx "one file", "{_count} files", @files), '2 files'); my $f = N__"Hi"; ok(defined $f); is(ref $f, ''); is(N__"Hi", "Hi"); is((N__"Hi"), "Hi"); is(N__("Hi"), "Hi"); my @g = N__n "Hi", "bye"; cmp_ok(scalar @g, '==', 2); is($g[0], 'Hi'); is($g[1], 'bye'); # # Use _count directly # ol_is(__nx("single {_count}", "multi {_count}", 0), 'multi 0'); ol_is(__nx("single {_count}", "multi {_count}", 1), 'single 1'); ol_is(__nx("single {_count}", "multi {_count}", 2), 'multi 2'); # # Expand arrays # { local $" = ', '; my @one = 'rabbit'; ol_is((__x "files: {f}", f => \@files), "files: monkey, donkey", 'check join on $"'); ol_is((__xn "one file: {f}", "{_count} files: {f}", @files, f => \@files), "2 files: monkey, donkey"); ol_is((__x "files: {f}", f => \@one), "files: rabbit"); ol_is((__xn "one file: {f}", "{_count} files: {f}", @one, f => \@one), "one file: rabbit"); } { local $" = '#'; ol_is((__x "files: {f}", f => \@files), "files: monkey#donkey"); ol_is((__x "files: {f}", f => \@files, _join => ', ') , "files: monkey, donkey", 'check _join'); } # # clone # my $s2 = __x "found {nr} files", nr => 5; my $t2 = $s2->(nr => 3); isa_ok($t2, 'Log::Report::Message'); ol_is($s2, 'found 5 files'); ol_is($t2, 'found 3 files'); # clone by overload my $s = __x "A={a};B={b}", a=>11, b=>12; isa_ok($s, 'Log::Report::Message'); is(reftype $s, 'HASH'); is($s->toString, "A=11;B=12"); my $t = $s->(b=>13); isa_ok($t, 'Log::Report::Message'); is(reftype $t, 'HASH'); isnt("$s", "$t"); is($t->toString, "A=11;B=13"); is($s->toString, "A=11;B=12"); # unchanged # # format # use constant PI => 4 * atan2(1, 1); my $approx = 'approx pi: 3.141593'; is((sprintf "approx pi: %.6f", PI), $approx); ol_is((__x "approx pi: {approx}", approx => sprintf("%.6f", PI)), $approx); ol_is((__x "approx pi: {pi%.6f}", pi => PI), $approx); ol_is((__x "{perms} {links%2d} {user%-8s} {size%8d} {fn}" , perms => '-rw-r--r--', links => 1, user => 'superman' , size => '1234567', fn => '/etc/profile') , '-rw-r--r-- 1 superman 1234567 /etc/profile'); # # trailing newline # my $msg1 = __x"who am i\n \n "; is($msg1->msgid, 'who am i', 'ignore white-space at the end'); is($msg1->append, "\n \n "); my $msg2 = __x"\n \t who am i"; is($msg2->msgid, 'who am i', 'ignore white-space before '); is($msg2->prepend, "\n \t "); Log-Report-0.998/t/41die.t0000644000175000001440000000051612231427544015617 0ustar00markovusers00000000000000#!/usr/bin/env perl # Convert die into report use warnings; use strict; use lib 't'; use POSIX; eval { setlocale(LC_ALL, 'POSIX') }; $! = 3; my $errno = $!+0; my $errstr = "$!"; #### Carp only works in package != main use DieTests; # we need a short stack trace sub simple_wrapper() { DieTests::run_tests() } simple_wrapper(); Log-Report-0.998/t/21pot_modif.t0000644000175000001440000001027712231427544017041 0ustar00markovusers00000000000000#!/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 Log-Report-0.998/t/42templ.t0000644000175000001440000000431112231427544016175 0ustar00markovusers00000000000000#!/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%] Log-Report-0.998/t/05util.t0000644000175000001440000000250112231427544016027 0ustar00markovusers00000000000000#!/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'); Log-Report-0.998/t/40ppi.t0000644000175000001440000000520612231427544015646 0ustar00markovusers00000000000000#!/usr/bin/env perl # Try Extract PPI use warnings; use strict; use File::Temp qw/tempdir/; use Test::More; use constant MSGIDS => 25; use constant PLURAL_MSGIDS => 4; BEGIN { eval "require PPI"; plan skip_all => 'PPI not installed' if $@; plan tests => 10 + MSGIDS*4 + 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(__x(b10 => 1, 2), 'b10'); 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 ### do not index these: __x(+"e1"); ### 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 $msgid"); 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; Log-Report-0.998/META.json0000644000175000001440000000201612231427551015675 0ustar00markovusers00000000000000{ "abstract" : "report a problem, pluggable handlers and language support", "author" : [ "Mark Overmeer" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120630", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Log-Report", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Devel::GlobalDestruction" : "0.09", "Encode" : "2.00", "Scalar::Util" : "0", "Sys::Syslog" : "0.27", "Test::More" : "0.86" } } }, "release_status" : "stable", "version" : "0.998" }