Log-Report-1.18/0000755000175000001440000000000013002344345014151 5ustar00markovusers00000000000000Log-Report-1.18/t/0000755000175000001440000000000013002344345014414 5ustar00markovusers00000000000000Log-Report-1.18/t/60mojo.t0000644000175000001440000000155112705145357015730 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test MojoX::Log::Report use warnings; use strict; use lib 'lib', '../lib'; use Test::More; use Log::Report undef; use Data::Dumper; BEGIN { eval "require Mojolicious"; plan skip_all => 'Mojolicious is not installed' if $@; plan skip_all => 'installed Mojolicious too old (requires 2.16)' if $Mojolicious::VERSION < 2.16; plan tests => 7; } use_ok('MojoX::Log::Report'); my $log = MojoX::Log::Report->new; isa_ok($log, 'MojoX::Log::Report'); isa_ok($log, 'Mojo::Log'); my $tmp; dispatcher close => 'default'; try { $log->error("going to die"); $tmp = 42 } mode => 3; my $err = $@; #warn Dumper $err; cmp_ok($tmp, '==', 42, 'errors not cast directly'); ok($err->success, 'block continued succesfully'); my @exc = $err->exceptions; cmp_ok(scalar @exc, '==', 1, "caught 1"); is("$exc[0]", "error: going to die\n"); Log-Report-1.18/t/00use.t0000644000175000001440000000250512705145357015552 0ustar00markovusers00000000000000#!/usr/bin/env perl use warnings; use strict; use Test::More tests => 11; # The versions of the following packages are reported to help understanding # the environment in which the tests are run. This is certainly not a # full list of all installed modules. my @show_versions = qw/PPI POSIX Test::Pod Log::Log4perl Sys::Syslog Log::Dispatch String::Print Mojolicious /; # Log::Report::Optional # Log::Report::Lexicon warn "Perl $]\n"; foreach my $package (sort @show_versions) { eval "require $package"; my $report = !$@ ? "version ". ($package->VERSION || 'unknown') : $@ =~ m/^Can't locate/ ? "not installed" : "reports error"; warn "$package $report\n"; } use_ok('Log::Report'); use_ok('Log::Report::Die'); use_ok('Log::Report::Dispatcher'); use_ok('Log::Report::Dispatcher::File'); use_ok('Log::Report::Dispatcher::Try'); use_ok('Log::Report::Dispatcher::Perl'); use_ok('Log::Report::Dispatcher::Callback'); use_ok('Log::Report::Domain'); use_ok('Log::Report::Exception'); use_ok('Log::Report::Message'); use_ok('Log::Report::Translator'); # Log::Report::Dispatcher::Syslog requires optional Sys::Syslog # Log::Report::Dispatcher::LogDispatch requires optional Log::Dispatch # Log::Report::Dispatcher::Log4perl requires optional Log::Log4perl Log-Report-1.18/t/41die.t0000644000175000001440000000051612705145357015524 0ustar00markovusers00000000000000#!/usr/bin/env perl # Convert die into report use warnings; use strict; use lib 't'; use POSIX; eval { setlocale(LC_ALL, 'POSIX') }; $! = 3; my $errno = $!+0; my $errstr = "$!"; #### Carp only works in package != main use DieTests; # we need a short stack trace sub simple_wrapper() { DieTests::run_tests() } simple_wrapper(); Log-Report-1.18/t/31stack.t0000644000175000001440000000110012705145357016055 0ustar00markovusers00000000000000#!/usr/bin/env perl # test the lexicon index. use warnings; use strict; use lib 'lib', '../lib'; use Test::More tests => 1; use Log::Report; use Log::Report::Dispatcher; my $stack; my $start = __LINE__; sub hhh(@) { $stack = Log::Report::Dispatcher->collectStack(3) } sub ggg(@) { shift; hhh(@_) } sub fff(@) { ggg(reverse @_) } fff(42, 3.2, "this is a text"); is_deeply($stack, [ [ 'main::hhh(3.2, 42)', $0, $start+2 ] , [ 'main::ggg("this is a text", 3.2, 42)', $0, $start+3 ] , [ 'main::fff(42, 3.2, "this is a text")', $0, $start+5 ] ] ); Log-Report-1.18/t/54try.t0000644000175000001440000000545512705145357015614 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test try() use warnings; use strict; use Test::More tests => 36; 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', format => sub {shift}; 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), '==', 2); is($l2[1]->name, 'try', 'only try dispatcher'); error "this is an error"; }; my $caught = $@; # be careful with this... Test::More may spoil it. my @l3 = dispatcher 'list'; cmp_ok(scalar(@l3), '==', 1); is($l3[0]->name, 'out', 'original dispatcher restored'); isa_ok($caught, 'Log::Report::Dispatcher::Try'); ok($caught->failed); ok($caught ? 1 : 0); my @r1 = $caught->exceptions; cmp_ok(scalar(@r1), '==', 1); isa_ok($r1[0], 'Log::Report::Exception'); my @r2 = $caught->wasFatal; cmp_ok(scalar(@r2), '==', 1); isa_ok($r2[0], 'Log::Report::Exception'); eval { try { try { failure "oops! no network" }; $@->reportAll; }; $@->reportAll; }; like($@, qr[^failure: oops]i); ### context my $context; my $scalar = try { $context = !wantarray && defined wantarray ? 'SCALAR' : 'OTHER'; my @x = 1..10; @x; }; is($context, 'SCALAR', 'try in SCALAR context'); cmp_ok($scalar, '==', 10); try { $context = !defined wantarray ? 'VOID' : 'OTHER'; 3; }; is($context, 'VOID', 'try in VOID context'); my @list = try { $context = wantarray ? 'LIST' : 'OTHER'; 1..5; }; is($context, 'LIST', 'try in LIST context'); cmp_ok(scalar @list, '==', 5); ### convert die/croak/confess # conversions by Log::Report::Die, see t/*die.t my $die = try { die "oops" }; ok(ref $@, 'caught die'); isa_ok($@, 'Log::Report::Dispatcher::Try'); my $die_ex = $@->wasFatal; isa_ok($die_ex, 'Log::Report::Exception'); is($die_ex->reason, 'ERROR'); like("$@", qr[^try-block stopped with ERROR: oops at ] ); my $croak = try { croak "oops2" }; ok(ref $@, 'caught croak'); isa_ok($@, 'Log::Report::Dispatcher::Try'); my $croak_ex = $@->wasFatal; isa_ok($croak_ex, 'Log::Report::Exception'); is($croak_ex->reason, 'ERROR'); like("$@", qr[^try-block stopped with ERROR: oops2 at ] ); my $confess = try { confess "oops3" }; ok(ref $@, 'caught confess'); isa_ok($@, 'Log::Report::Dispatcher::Try'); my $confess_ex = $@->wasFatal; isa_ok($confess_ex, 'Log::Report::Exception'); is($confess_ex->reason, 'PANIC'); like("$@", qr[^try-block stopped with PANIC: oops3 at ] ); Log-Report-1.18/t/52logdisp.t0000644000175000001440000000165012705145357016426 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test Log::Dispatch (only very simple tests) use warnings; use strict; use lib 'lib', '../lib'; use File::Temp qw/tempfile/; use Test::More; use Log::Report undef, syntax => 'SHORT'; BEGIN { eval "require Log::Dispatch"; plan skip_all => 'Log::Dispatch not installed' if $@; my $sv = Log::Dispatch->VERSION; eval { Log::Dispatch->VERSION(2.00) }; plan skip_all => "Log::Dispatch too old (is $sv, requires 2.00)" if $@; plan tests => 5; use_ok('Log::Report::Dispatcher::LogDispatch'); } use_ok('Log::Dispatch::File'); my ($out, $outfn) = tempfile; dispatcher 'Log::Dispatch::File' => 'logger' , filename => $outfn , to_level => ['ALERT-' => 'err']; dispatcher close => 'default'; cmp_ok(-s $outfn, '==', 0); notice "this is a test"; my $s1 = -s $outfn; cmp_ok($s1, '>', 0); warning "some more"; my $s2 = -s $outfn; cmp_ok($s2, '>', $s1); unlink $outfn; Log-Report-1.18/t/11concat.t0000644000175000001440000000174212705145357016231 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-1.18/t/09message.t0000644000175000001440000000257012705145357016415 0ustar00markovusers00000000000000#!/usr/bin/env perl # Try constructing a message object use warnings; use strict; use Test::More tests => 22; use Scalar::Util 'refaddr'; use Log::Report; use Log::Report::Message; ### direct creation my $msg = Log::Report::Message->new ( _msgid => 'try' , _domain => 'test' , _class => 'monkey, donkey' , var => 42 ); ok(defined $msg, 'created message manually'); isa_ok($msg, 'Log::Report::Message'); is($msg->msgid, 'try'); is($msg->domain, 'test'); is($msg->valueOf('_domain'), 'test'); is($msg->valueOf('var'), 42); my @c = $msg->classes; cmp_ok(scalar @c, '==', 2, 'list classes'); is($c[0], 'monkey'); is($c[1], 'donkey'); ok($msg->inClass('monkey'), 'inClass'); ok($msg->inClass('donkey')); is($msg->inClass( qr/^d/ ), 'donkey'); is($msg->inClass( qr/key/ ), 'monkey'); ### indirect creation, non-translated try { report ERROR => 'not translated', _classes => 'one two' }; my $err = $@; isa_ok($err, 'Log::Report::Dispatcher::Try'); my $fatal = $err->wasFatal; isa_ok($fatal, 'Log::Report::Exception'); my $message = $fatal->message; isa_ok($message, 'Log::Report::Message'); is("$message", 'not translated', 'untranslated'); is($message->inClass('one'), 'one'); is($message->inClass('two'), 'two'); is($fatal->inClass('two'), 'two'); my $fatal2 = $err->wasFatal(class => 'two'); isa_ok($fatal2, 'Log::Report::Exception'); cmp_ok(refaddr $fatal, '==', refaddr $fatal2); Log-Report-1.18/t/10interp.t0000644000175000001440000001130512705145357016256 0ustar00markovusers00000000000000#!/usr/bin/env perl # Try __ use warnings; use strict; use lib 'lib', '../lib'; use Test::More tests => 69; use Log::Report; # no domains, no translator use Scalar::Util qw/reftype/; ### examples from Log::Report::Message and more # Check overloading sub ol_is($$;$) { # since Test::More 0.95_01, is() does not stringify its arguments. # This means that overloading does not kick in. How to test # overloading now? my ($f, $s, $comment) = @_; overload::Overloaded($f) || overload::Overloaded($s) or die "both not overloaded, in '$f' and '$s'"; is("$f", "$s", $comment); } my $a = __"Hello"; ok(defined $a); is(ref $a, 'Log::Report::Message'); is(reftype $a, 'HASH'); ol_is(__"Hello World", 'Hello World'); ol_is(__"Hello World {a}", 'Hello World {a}'); ol_is(__('Hello World {a}'), 'Hello World {a}'); my $c = __x"Hello"; ok(defined $c); is(ref $c, 'Log::Report::Message'); is(reftype $c, 'HASH'); ol_is(__x("Hello World", a => 42), 'Hello World'); ol_is(__x("Hello World {a}", a => 42), 'Hello World 42'); ol_is((__x"Hello World {a}", a => 42), 'Hello World 42'); ol_is((__x "Hello World {a}", a => 42), 'Hello World 42'); ol_is((__x "{a}{a}{a}", a => 42), '424242'); my $d = __n"Hello","World",3; ok(defined $d); is(ref $d, 'Log::Report::Message'); is(reftype $d, 'HASH'); ol_is(__n("Hello", "World", 1), 'Hello'); ol_is(__n("Hello", "World", 0), 'World'); ol_is(__n("Hello", "World", 2), 'World'); my $e = __nx"Hello","World",3,a=>42; ok(defined $e); is(ref $e, 'Log::Report::Message'); is(reftype $e, 'HASH'); ol_is(__nx("Hel{a}lo", "Wor{a}ld", 1,a=>42), 'Hel42lo'); ol_is(__nx("Hel{a}lo", "Wor{a}ld", 0,a=>42), 'Wor42ld'); ol_is(__nx("Hel{a}lo", "Wor{a}ld", 2,a=>42), 'Wor42ld'); ol_is(__xn("Hel{a}lo", "Wor{a}ld", 2,a=>42), 'Wor42ld'); my $e1 = 1; ol_is((__nx "one", "more", $e1++), "one"); ol_is((__nx "one", "more", $e1), "more"); my @files = 'monkey'; my $nr_files = @files; ol_is((__nx "one file", "{_count} files", $nr_files), 'one file'); ol_is((__nx "one file", "{_count} files", @files), 'one file'); push @files, 'donkey'; $nr_files = @files; ol_is((__nx "one file", "{_count} files", $nr_files), '2 files'); ol_is((__nx "one file", "{_count} files", @files), '2 files'); my $f = N__"Hi"; ok(defined $f); is(ref $f, ''); is(N__"Hi", "Hi"); is((N__"Hi"), "Hi"); is(N__("Hi"), "Hi"); my @g = N__n "Hi", "bye"; cmp_ok(scalar @g, '==', 2); is($g[0], 'Hi'); is($g[1], 'bye'); # # Use _count directly # ol_is(__nx("single {_count}", "multi {_count}", 0), 'multi 0'); ol_is(__nx("single {_count}", "multi {_count}", 1), 'single 1'); ol_is(__nx("single {_count}", "multi {_count}", 2), 'multi 2'); # # Expand arrays # { local $" = ', '; my @one = 'rabbit'; ol_is((__x "files: {f}", f => \@files), "files: monkey, donkey", 'check join on $"'); ol_is((__xn "one file: {f}", "{_count} files: {f}", @files, f => \@files), "2 files: monkey, donkey"); ol_is((__x "files: {f}", f => \@one), "files: rabbit"); ol_is((__xn "one file: {f}", "{_count} files: {f}", @one, f => \@one), "one file: rabbit"); } { local $" = '#'; ol_is((__x "files: {f}", f => \@files), "files: monkey#donkey"); ol_is((__x "files: {f}", f => \@files, _join => ', ') , "files: monkey, donkey", 'check _join'); } # # clone # my $s2 = __x "found {nr} files", nr => 5; my $t2 = $s2->(nr => 3); isa_ok($t2, 'Log::Report::Message'); ol_is($s2, 'found 5 files'); ol_is($t2, 'found 3 files'); # clone by overload my $s = __x "A={a};B={b}", a=>11, b=>12; isa_ok($s, 'Log::Report::Message'); is(reftype $s, 'HASH'); is($s->toString, "A=11;B=12"); my $t = $s->(b=>13); isa_ok($t, 'Log::Report::Message'); is(reftype $t, 'HASH'); isnt("$s", "$t"); is($t->toString, "A=11;B=13"); is($s->toString, "A=11;B=12"); # unchanged # # format # use constant PI => 4 * atan2(1, 1); my $approx = 'approx pi: 3.141593'; my $approx2 = sprintf "approx pi: %.6f", PI; $approx2 =~ s/,/./g; # locale numeric :( is($approx2, $approx, 'sprintf'); ol_is((__x "approx pi: {approx}", approx => sprintf("%.6f", PI)), $approx, 'sprintf nested'); my $app = __x "approx pi: {pi%.6f}", pi => PI; $app =~ s/\,/./g; # translated under locale, which may use ',' is($app, $approx, 'interpolated format'); ol_is((__x "{perms} {links%2d} {user%-8s} {size%8d} {fn}" , perms => '-rw-r--r--', links => 1, user => 'superman' , size => '1234567', fn => '/etc/profile') , '-rw-r--r-- 1 superman 1234567 /etc/profile'); # # trailing newline # my $msg1 = __x"who am i\n \n "; is($msg1->msgid, 'who am i', 'ignore white-space at the end'); is($msg1->append, "\n \n "); my $msg2 = __x"\n \t who am i"; is($msg2->msgid, 'who am i', 'ignore white-space before '); is($msg2->prepend, "\n \t "); Log-Report-1.18/t/70dancer2.t0000644000175000001440000000657512720546715016316 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More; BEGIN { eval "require Dancer2"; plan skip_all => 'Dancer2 is not installed' if $@; plan skip_all => "Dancer2 is too old: $Dancer2::VERSION" if $Dancer2::VERSION < 0.151000; # for to_app() warn "Dancer2 version $Dancer2::VERSION\n"; plan tests => 5; eval "require Plack::Test"; ok !$@, 'Unable to load Plack::Test for Dancer2 tests'; eval "require HTTP::Cookies"; ok !$@, 'Unable to load HTTP::Cookies for Dancer2 tests'; eval "require HTTP::Request::Common"; ok !$@, 'Unable to load HTTP::Request::Common for Dancer2 tests'; HTTP::Request::Common->import; } { package TestApp; use Dancer2; # Import options can be passed to Log::Report. use Dancer2::Plugin::LogReport 'test_app', import => 'dispatcher'; # or you can just use the plugin to get syntax => 'LONG' # use Dancer2::Plugin::LogReport; set session => 'Simple'; set logger => 'LogReport'; dispatcher close => 'default'; get '/write_message/:level/:text' => sub { my $level = param('level'); my $text = param('text'); eval qq($level "$text"); }; get '/read_message' => sub { my $all = session 'messages'; my $message = pop @$all or return ''; "$message"; }; get '/process' => sub { process(sub { error "Fatal error text" }); }; } my $url = 'http://localhost'; my $jar = HTTP::Cookies->new(); my $test = Plack::Test->create( TestApp->to_app ); # Basic tests to log messages and read from session subtest 'Basic messages' => sub { # Log a notice message { my $req = GET "$url/write_message/notice/notice_text"; $jar->add_cookie_header($req); my $res = $test->request( $req ); ok $res->is_success, "get /write_message"; $jar->extract_cookies($res); # Get the message $req = GET "$url/read_message"; $jar->add_cookie_header($req); $res = $test->request( $req ); is ($res->content, 'notice_text'); } # Log a trace message { my $req = GET "$url/write_message/trace/trace_text"; $jar->add_cookie_header($req); my $res = $test->request( $req ); ok $res->is_success, "get /write_message"; $jar->extract_cookies($res); # This time it shouldn't make it to the messages session $req = GET "$url/read_message"; $jar->add_cookie_header($req); $res = $test->request( $req ); is ($res->content, ''); } }; # Tests to check fatal errors, and catching with process() subtest 'Throw error' => sub { # Throw an uncaught error. Should redirect. { my $req = GET "$url/write_message/error/error_text"; my $res = $test->request( $req ); ok $res->is_redirect, "get /write_message"; } # The same, this time caught and displayed { my $req = GET "$url/process"; $jar->add_cookie_header($req); my $res = $test->request( $req ); ok $res->is_success, "get /write_message"; is ($res->content, '0'); # Check caught message is in session $jar->extract_cookies($res); $req = GET "$url/read_message"; $jar->add_cookie_header($req); $res = $test->request( $req ); is ($res->content, 'Fatal error text'); } }; done_testing; Log-Report-1.18/t/50file.t0000644000175000001440000000600312705145357015677 0ustar00markovusers00000000000000#!/usr/bin/env perl # test the file back-end, without translations use warnings; use strict; use Test::More tests => 39; use Log::Report; use POSIX 'locale_h'; setlocale(LC_ALL, 'en_US'); my @disp = dispatcher 'list'; cmp_ok(scalar(@disp), '==', 1); isa_ok($disp[0], 'Log::Report::Dispatcher'); # start new dispatcher to file my $file1 = ''; open my($fh1), ">", \$file1 or die $!; my $d = dispatcher FILE => 'file1', to => $fh1, format => sub {shift}; @disp = dispatcher 'list'; cmp_ok(scalar(@disp), '==', 2); ok(defined $d, 'created file dispatcher'); isa_ok($d, 'Log::Report::Dispatcher::File'); ok($d==$disp[0] || $d==$disp[1], 'in disp list'); ok(!$d->isDisabled); is($d->name, 'file1'); my @needs = $d->needs; cmp_ok(scalar(@needs), '>', 7, 'needs'); is($needs[0], 'NOTICE'); is($needs[-1], 'PANIC'); # start a second dispatcher to a file, which does accept everything # trace-info. my $file2 = ''; open my($fh2), ">", \$file2 or die $!; my $e = dispatcher FILE => 'file2' , format_reason => 'UPPERCASE' , to => $fh2, accept => '-INFO' , format => sub {shift}; ok(defined $e, 'created second disp'); isa_ok($e, 'Log::Report::Dispatcher::File'); @disp = dispatcher 'list'; cmp_ok(scalar(@disp), '==', 3); @needs = $e->needs; cmp_ok(scalar(@needs), '>=', 3, 'needs'); is($needs[0], 'TRACE'); is($needs[-1], 'INFO'); # silence default dispatcher for tests dispatcher close => 'default'; @disp = dispatcher 'list'; cmp_ok(scalar(@disp), '==', 2); # # Start producing messages # cmp_ok(length $file1, '==', 0); cmp_ok(length $file2, '==', 0); trace "trace"; cmp_ok(length $file1, '==', 0, 'disp1 ignores trace'); my $t = length $file2; cmp_ok($t, '>', 0, 'disp2 take trace'); is($file2, "TRACE: trace\n"); my $linenr = __LINE__ +1; assert "assertive"; cmp_ok(length $file1, '==', 0, 'disp1 ignores assert'); my $t2 = length $file2; cmp_ok($t2, '>', $t, 'disp2 take assert'); is(substr($file2, $t), "ASSERT: assertive\n at $0 line $linenr\n"); info "just to inform you"; cmp_ok(length $file1, '==', 0, 'disp1 ignores info'); my $t3 = length $file2; cmp_ok($t3, '>', $t2, 'disp2 take info'); is(substr($file2, $t2), "INFO: just to inform you\n"); notice "note this!"; my $s = length $file1; cmp_ok($s, '>', 0, 'disp1 take notice'); is($file1, "notice: note this!\n"); # format_reason LOWERCASE my $t4 = length $file2; cmp_ok($t4, '==', $t3, 'disp2 ignores notice'); warning "oops, be warned!"; my $s2 = length $file1; cmp_ok($s2, '>', $s, 'disp1 take warning'); like(substr($file1, $s), qr/^warning: oops, be warned!/); my $t5 = length $file2; cmp_ok($t5, '==', $t4, 'disp2 ignores warnings'); # # test filters # my (@messages, @messages2); dispatcher filter => sub { push @messages, $_[3]; @_[2,3] }, 'file1'; dispatcher filter => sub { push @messages2, $_[3]; @_[2,3] }, 'file2'; notice "here are"; cmp_ok(scalar(@messages), '==', 1, 'capture message'); is($messages[0]->toString, 'here are', 'toString'); is($messages[0]->toHTML, 'here <we> are', 'toHTML'); cmp_ok(scalar(@messages2), '==', 0, 'do not capture message'); Log-Report-1.18/t/51syslog.t0000644000175000001440000000111612705145357016301 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test syslog, but only mildly use warnings; use strict; use Test::More; use Log::Report undef, syntax => 'SHORT'; BEGIN { eval "require Sys::Syslog"; plan skip_all => 'Sys::Syslog not installed' if $@; my $sv = Sys::Syslog->VERSION; eval { Sys::Syslog->VERSION(0.11) }; plan skip_all => "Sys::Syslog too old (is $sv, requires 0.11)" if $@; plan tests => 1; use_ok('Log::Report::Dispatcher::Syslog'); } dispatcher SYSLOG => 'syslog', to_prio => ['ALERT-' => 'err']; dispatcher close => 'default'; notice "this is a test"; Log-Report-1.18/t/53log4perl.t0000644000175000001440000000345212705145357016520 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test Log::Log4perl (only very simple tests) use warnings; use strict; use File::Temp qw/tempfile/; use Test::More; use Fcntl qw/SEEK_CUR/; use Log::Report undef, syntax => 'SHORT'; BEGIN { eval "require Log::Log4perl"; plan skip_all => 'Log::Log4perl not installed' if $@; my $sv = Log::Log4perl->VERSION; eval { Log::Log4perl->VERSION(1.00) }; plan skip_all => "Log::Log4perl too old (is $sv, requires 1.00)" if $@; plan tests => 5; } my ($out, $outfn) = tempfile; my $name = 'logger'; # adapted from the docs my $conf = <<__CONFIG; log4perl.category.$name = INFO, Logfile log4perl.appender.Logfile = Log::Log4perl::Appender::File log4perl.appender.Logfile.filename = $outfn log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout log4perl.appender.Logfile.layout.ConversionPattern = %d %F{2} %L> %m %n __CONFIG dispatcher LOG4PERL => $name, config => \$conf; dispatcher close => 'default'; cmp_ok(-s $outfn, '==', 0); my $date_qr = qr!\d{4}/\d{2}/\d{2} \d{2}:\d{2}:\d{2}!; my ($line_number, $log_line, $expected_msg); notice "this is a test"; $line_number = __LINE__; my $s1 = -s $outfn; cmp_ok($s1, '>', 0); $log_line = <$out>; #warn "LINE1 = $log_line"; $log_line =~ s!\\!/!g; # windows $expected_msg = "$line_number> notice: this is a test"; # do not anchor at the end: $ does not match on Windows like($log_line, qr!^$date_qr t[/\\]53log4perl\.t \Q$expected_msg\E!); warning "some more"; $line_number = __LINE__; my $s2 = -s $outfn; cmp_ok $s2, '>', $s1; seek $out, 0, SEEK_CUR; $log_line = <$out>; #warn "LINE2 = $log_line"; $log_line =~ s!\\!/!g; # windows $expected_msg = "$line_number> warning: some more"; like($log_line, qr!^$date_qr t[/\\]53log4perl\.t \Q$expected_msg\E!); unlink $outfn; Log-Report-1.18/t/55throw.t0000644000175000001440000000157712705145357016143 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test throw() use warnings; use strict; use Test::More tests => 9; use Log::Report undef, syntax => 'SHORT'; eval { use POSIX ':locale_h', 'setlocale'; # avoid user's environment setlocale(LC_ALL, 'POSIX'); }; # start a new logger my $text = ''; open my($fh), '>', \$text; dispatcher close => 'default'; dispatcher FILE => 'out', to => $fh, accept => 'ALL', format => sub {shift}; cmp_ok(length $text, '==', 0, 'file logger'); try { error "test" }; ok($@, 'caugth rethrown error'); my $e1 = $@->wasFatal; isa_ok($e1, 'Log::Report::Exception'); is($e1->reason, 'ERROR'); my $m1 = $e1->message; isa_ok($m1, 'Log::Report::Message'); is("$m1", 'test'); # Now, rethrow the exception try { $e1->throw(reason => 'ALERT') }; ok(!$@, 'caught rethrown, non fatal'); my @e2 = $@->exceptions; cmp_ok(scalar @e2, '==', 1); my $e2 = $e2[0]; is("$e2", "alert: test\n"); Log-Report-1.18/t/DieTests.pm0000644000175000001440000001100013002344341016462 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. package DieTests; use vars '$VERSION'; $VERSION = '1.18'; 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}}; my $r = <<__RESULT; $reason: $message ($errno) $err $loca $stack __RESULT $r =~ s!\\!/!g; # Windows $r; } sub run_tests() { ### #### Testing die_decode itself ### ok(1, "err $errno is '$errstr'"); # die eval { die "ouch" }; my $die_text1 = $@; is(process($die_text1), <<__OUT, "die"); ERROR: ouch (no errno) 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"); FAULT: 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"); FAULT: 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-1.18/lib/0000755000175000001440000000000013002344345014717 5ustar00markovusers00000000000000Log-Report-1.18/lib/Log/0000755000175000001440000000000013002344345015440 5ustar00markovusers00000000000000Log-Report-1.18/lib/Log/Report/0000755000175000001440000000000013002344345016713 5ustar00markovusers00000000000000Log-Report-1.18/lib/Log/Report/Dispatcher/0000755000175000001440000000000013002344345021001 5ustar00markovusers00000000000000Log-Report-1.18/lib/Log/Report/Dispatcher/Callback.pm0000644000175000001440000000126413002344341023032 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use warnings; use strict; package Log::Report::Dispatcher::Callback; use vars '$VERSION'; $VERSION = '1.18'; 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-1.18/lib/Log/Report/Dispatcher/Callback.pod0000644000175000001440000001136213002344342023201 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Callback - call a code-ref for each log-line =head1 INHERITANCE Log::Report::Dispatcher::Callback is a Log::Report::Dispatcher =head1 SYNOPSIS sub cb($$$) { my ($disp, $options, $reason, $message) = @_; ... } dispatcher Log::Report::Dispatcher::Callback => 'cb' , callback => \&cb; dispatcher CALLBACK => 'cb' # same , callback => \&cb; =head1 DESCRIPTION This basic file logger accepts a callback, which is called for each message which is to be logged. When you need complex things, you may best make your own extension to L, but for simple things this will do. Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. B<. Example> sub send_mail($$$) { my ($disp, $options, $reason, $message) = @_; my $msg = Mail::Send->new(Subject => $reason , To => 'admin@localhost'); my $fh = $msg->open('sendmail'); print $fh $disp->translate($reason, $message); close $fh; } dispatcher CALLBACK => 'mail', callback => \&send_mail; =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Log::Report::Dispatcher::Callback-EB($type, $name, %options) -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode callback charset Log::Report::Dispatcher format_reason Log::Report::Dispatcher 'LOWERCASE' locale Log::Report::Dispatcher mode Log::Report::Dispatcher 'NORMAL' =over 2 =item accept => REASONS =item callback => CODE Your C is called with five parameters: this dispatcher object, the options, a reason and a message. The C are the first parameter of L (read over there). The C is a capitized string like C. Then, the C (is a L). Finally the text-domain of the message. =item charset => CHARSET =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item locale => LOCALE =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =back =back =head2 Accessors Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">. =over 4 =item $obj-EB() Returns the code reference which will handle each logged message. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$reason] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Logging Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">. =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher::Callback-EB(@CODE) Inherited, see L =item $obj-EB() =item Log::Report::Dispatcher::Callback-EB() Inherited, see L =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher::Callback-EB( [$maxdepth] ) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message, $domain) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB(%options) =item Log::Report::Dispatcher::Callback-EB(%options) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message) Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report/Dispatcher/LogDispatch.pm0000644000175000001440000000365113002344341023541 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use warnings; use strict; package Log::Report::Dispatcher::LogDispatch; use vars '$VERSION'; $VERSION = '1.18'; 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->translate(@_) or return; my $level = $self->reasonToLevel($_[1]); $self->backend->log(level => $level, message => $text); $self; } sub reasonToLevel($) { $_[0]->{level}{$_[1]} } 1; Log-Report-1.18/lib/Log/Report/Dispatcher/LogDispatch.pod0000644000175000001440000001346513002344342023714 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::LogDispatch - send messages to Log::Dispatch back-end =head1 INHERITANCE Log::Report::Dispatcher::LogDispatch is a Log::Report::Dispatcher =head1 SYNOPSIS use Log::Dispatch::File; dispatcher Log::Dispatch::File => 'logger', accept => 'NOTICE-' , filename => 'logfile', to_level => [ 'ALERT-' => 'err' ]; # disable default dispatcher dispatcher close => 'logger'; =head1 DESCRIPTION This dispatchers produces output to and C back-end. (which will NOT be automatically installed for you). The REASON for a message often uses names which are quite similar to the log-levels used by Log::Dispatch. However: they have a different approach. The REASON of Log::Report limits the responsibility of the programmer to indicate the cause of the message: whether it was able to handle a certain situation. The Log::Dispatch levels are there for the user's of the program. However: the programmer does not known anything about the application (in the general case). This is cause of much of the trickery in Perl programs. The default translation table is list below. You can change the mapping using L. See example in SYNOPSIS. Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Log::Report::Dispatcher::LogDispatch-EB($type, $name, %options) The Log::Dispatch infrastructure has quite a large number of output TYPEs, each extending the Log::Dispatch::Output base-class. You do not create these objects yourself: Log::Report is doing it for you. The Log::Dispatch back-ends are very careful with validating their parameters, so you will need to restrict the options to what is supported for the specific back-end. See their respective manual-pages. The errors produced by the back-ends quite horrible and untranslated, sorry. -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode callbacks [] charset Log::Report::Dispatcher format_reason Log::Report::Dispatcher 'LOWERCASE' locale Log::Report::Dispatcher max_level undef min_level debug mode Log::Report::Dispatcher 'NORMAL' to_level [] =over 2 =item accept => REASONS =item callbacks => CODE|ARRAY-of-CODE See Log::Dispatch::Output. =item charset => CHARSET =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item locale => LOCALE =item max_level => LEVEL Like C. =item min_level => LEVEL Restrict the messages which are passed through based on the LEVEL, so after the reason got translated into a Log::Dispatch compatible LEVEL. The default will use Log::Report restrictions only. =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item to_level => ARRAY-of-PAIRS See L. =back =back =head2 Accessors Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">. =over 4 =item $obj-EB() Returns the Log::Dispatch::Output object which is used for logging. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$reason] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Logging Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">. =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher::LogDispatch-EB(@CODE) Inherited, see L =item $obj-EB() =item Log::Report::Dispatcher::LogDispatch-EB() Inherited, see L =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher::LogDispatch-EB( [$maxdepth] ) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message, $domain) Inherited, see L =item $obj-EB($reason) Returns a level which is understood by Log::Dispatch, based on a translation table. This can be changed with L. =item $obj-EB() Inherited, see L =item $obj-EB(%options) =item Log::Report::Dispatcher::LogDispatch-EB(%options) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message) Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report/Dispatcher/Log4perl.pod0000644000175000001440000001541313002344342023176 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Log4perl - send messages to Log::Log4perl back-end =head1 INHERITANCE Log::Report::Dispatcher::Log4perl is a Log::Report::Dispatcher =head1 SYNOPSIS # start using log4perl via a config file # The name of the dispatcher is the name of the default category. dispatcher LOG4PERL => 'logger' , accept => 'NOTICE-' , config => "$ENV{HOME}/.log.conf"; # disable default dispatcher dispatcher close => 'logger'; # configuration inline, not in file: adapted from the Log4perl manpage my $name = 'logger'; my $outfile = '/tmp/a.log'; my $config = <<__CONFIG; log4perl.category.$name = INFO, Logfile log4perl.logger.Logfile = Log::Log4perl::Appender::File log4perl.logger.Logfile.filename = $outfn log4perl.logger.Logfile.layout = Log::Log4perl::Layout::PatternLayout log4perl.logger.Logfile.layout.ConversionPattern = %d %F{1} %L> %m __CONFIG dispatcher LOG4PERL => $name, config => \$config; =head1 DESCRIPTION This dispatchers produces output tot syslog, based on the C module (which will not be automatically installed for you). Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. =head2 Reasons <--> Levels The REASONs for a message in L are names quite similar to the log levels used by Log::Log4perl. The default mapping is list below. You can change the mapping using L. TRACE => $DEBUG ERROR => $ERROR ASSERT => $DEBUG FAULT => $ERROR INFO => $INFO ALERT => $FATAL NOTICE => $INFO FAILURE => $FATAL WARNING => $WARN PANIC => $FATAL MISTAKE => $WARN =head2 Categories C uses text-domains for translation tables. These are also used as categories for the Log4perl infrastructure. So, typically every module start with: use Log::Report 'my-text-domain', %more_options; Now, if there is a logger inside the log4perl configuration which is named 'my-text-domain', that will be used. Otherwise, the name of the dispatcher is used to select the logger. =head3 Limitiations The global C<$caller_depth> concept of Log::Log4perl is broken. That variable is used to find the filename and line number of the logged messages. But these messages may have been caught, rerouted, eval'ed, and otherwise followed a unpredictable multi-leveled path before it reached the Log::Log4perl dispatcher. This means that layout patterns C<%F> and C<%L> are not useful in the generic case, maybe in your specific case. =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Log::Report::Dispatcher::Log4perl-EB($type, $name, %options) The Log::Log4perl infrastructure has all settings in a configuration file. In that file, you should find a category with the $name. -Option --Defined in --Default accept Log::Report::Dispatcher 'ALL' charset Log::Report::Dispatcher config format_reason Log::Report::Dispatcher 'LOWERCASE' locale Log::Report::Dispatcher mode Log::Report::Dispatcher 'NORMAL' to_level [] =over 2 =item accept => REASONS =item charset => CHARSET =item config => FILENAME|SCALAR When a SCALAR reference is passed in, that must refer to a string which contains the configuration text. Otherwise, specify an existing FILENAME. =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item locale => LOCALE =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item to_level => ARRAY-of-PAIRS See L. =back =back =head2 Accessors Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB( [$domain] ) Returns the Log::Log4perl::Logger object which is used for logging. When there is no specific logger for this $domain (logger with the exact name of the $domain) the default logger is being used, with the name of this dispatcher. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$reason] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Logging Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">. =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher::Log4perl-EB(@CODE) Inherited, see L =item $obj-EB() =item Log::Report::Dispatcher::Log4perl-EB() Inherited, see L =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher::Log4perl-EB( [$maxdepth] ) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message, $domain) Inherited, see L =item $obj-EB($reason) Returns a level which is understood by Log::Dispatch, based on a translation table. This can be changed with L. example: use Log::Log4perl qw/:levels/; # by default, ALERTs are output as $FATAL dispatcher Log::Log4perl => 'logger' , to_level => [ ALERT => $ERROR, ] , ...; =item $obj-EB() Inherited, see L =item $obj-EB(%options) =item Log::Report::Dispatcher::Log4perl-EB(%options) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message) Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report/Dispatcher/Try.pod0000644000175000001440000002226313002344342022265 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Try - capture all reports as exceptions =head1 INHERITANCE Log::Report::Dispatcher::Try is a Log::Report::Dispatcher =head1 SYNOPSIS try { ... }; # mind the ';' !! if($@) { # signals something went wrong if(try {...}) { # block ended normally my $x = try { read_temperature() }; my @x = try { read_lines_from_file() }; try { ... } # no comma!! mode => 'DEBUG', accept => 'ERROR-'; try sub { ... }, # with comma mode => 'DEBUG', accept => 'ALL'; try \&myhandler, accept => 'ERROR-'; try { ... } hide => 'TRACE'; print ref $@; # Log::Report::Dispatcher::Try $@->reportFatal; # re-dispatch result of try block $@->reportAll; # ... also warnings etc if($@) {...} # if errors if($@->failed) { # same # } if($@->success) { # no errors # } try { # something causes an error report, which is caught failure 'no network'; }; $@->reportFatal(to => 'syslog'); # overrule destination print $@->exceptions; # no re-cast, just print =head1 DESCRIPTION The 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. Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">. =over 4 =item $obj-EB() Only when initiated with a FILENAME, the file will be closed. In any other case, nothing will be done. =item Log::Report::Dispatcher::Try-EB($type, $name, %options) -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode charset Log::Report::Dispatcher died undef exceptions [] format_reason Log::Report::Dispatcher 'LOWERCASE' hide 'NONE' locale Log::Report::Dispatcher mode Log::Report::Dispatcher 'NORMAL' on_die 'ERROR' =over 2 =item accept => REASONS =item charset => CHARSET =item died => STRING The exit string ($@) of the eval'ed block. =item exceptions => ARRAY ARRAY of L objects. =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item hide => REASON|ARRAY|'ALL'|'NONE' [1.09] see L =item locale => LOCALE =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item on_die => 'ERROR'|'PANIC' When code which runs in this block exits with a die(), it will get translated into a L using L. How serious are we about these errors? =back =back =head2 Accessors Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">. =over 4 =item $obj-EB() Returns the value of MB( [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(REASON|REASONS|ARRAY|'ALL'|'NONE') [1.09] By default, the try will only catch messages which stop the execution of the block (errors etc, internally a 'die'). Other messages are passed to parent try blocks, if none than to the dispatchers. This option gives the opportunity to block, for instance, trace messages. Those messages are still collected inside the try object, so may get passed-on later via L if you like. Be warned: Using this method will reset the whole 'hide' configuration: it's a I not an I. example: change the setting of the running block my $parent_try = dispatcher 'active-try'; parent_try->hide('NONE'); =item $obj-EB(REASON) =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$reason] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Logging Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">. =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher::Try-EB(@CODE) Inherited, see L =item $obj-EB() =item Log::Report::Dispatcher::Try-EB() Inherited, see L =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher::Try-EB( [$maxdepth] ) Inherited, see L =item $obj-EB($opts, $reason, $message) Other dispatchers translate the message here, and make it leave the program. However, messages in a "try" block are only captured in an intermediate layer: they may never be presented to an end-users. And for sure, we do not know the language yet. The $message is either a STRING or a L. =item $obj-EB(%options) Re-cast the messages in all collect exceptions into the defined dispatchers, which were disabled during the try block. The %options will end-up as HASH of %options to L; see L which does the job. =item $obj-EB() Re-cast only the fatal message to the defined dispatchers. If the block was left without problems, then nothing will be done. The %options will end-up as HASH of %options to L; see L which does the job. =item $obj-EB() Inherited, see L =item $obj-EB(%options) =item Log::Report::Dispatcher::Try-EB(%options) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message) Inherited, see L =back =head2 Status =over 4 =item $obj-EB() Returns true if the block was left with an fatal message. =item $obj-EB() If this object is kept in C<$@>, and someone uses this as string, we want to show the fatal error message. The message is not very informative for the good cause: we do not want people to simply print the C<$@>, but wish for a re-cast of the message using L or L. =item $obj-EB() Returns true if the block exited normally. =item $obj-EB(%options) Returns the L which caused the "try" block to die, otherwise an empty LIST (undef). -Option--Default class undef =over 2 =item class => CLASS|REGEX Only return the exception if it was fatal, and in the same time in the specified CLASS (as string) or matches the REGEX. See L =back =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 OVERLOADING =over 4 =item overload: B Returns true if the previous try block did produce a terminal error. This "try" object is assigned to C<$@>, and the usual perl syntax is C. =item overload: B When C<$@> is used the traditional way, it is checked to have a string content. In this case, stringify into the fatal error or nothing. =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report/Dispatcher/File.pm0000644000175000001440000000732313002344341022217 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use warnings; use strict; package Log::Report::Dispatcher::File; use vars '$VERSION'; $VERSION = '1.18'; use base 'Log::Report::Dispatcher'; use Log::Report 'log-report'; use IO::File (); use POSIX qw/strftime/; use Encode qw/find_encoding/; use Fcntl qw/:flock/; sub init($) { my ($self, $args) = @_; if(!$args->{charset}) { my $lc = $ENV{LC_CTYPE} || $ENV{LC_ALL} || $ENV{LANG} || ''; my $cs = $lc =~ m/\.([\w-]+)/ ? $1 : ''; $args->{charset} = length $cs && find_encoding $cs ? $cs : undef; } $self->SUPER::init($args); my $name = $self->name; $self->{to} = $args->{to} or error __x"dispatcher {name} needs parameter 'to'", name => $name; $self->{replace} = $args->{replace} || 0; my $format = $args->{format} || sub { '['.localtime()."] $_[0]" }; $self->{LRDF_format} = ref $format eq 'CODE' ? $format : $format eq 'LONG' ? sub { my $msg = shift; my $domain = shift || '-'; my $stamp = strftime "%Y-%m-%dT%H:%M:%S", gmtime; "[$stamp $$] $domain $msg" } : error __x"unknown format parameter `{what}'" , what => ref $format || $format; $self; } #----------- sub filename() {shift->{LRDF_filename}} sub format() {shift->{LRDF_format}} sub output($) { # fast simple case return $_[0]->{LRDF_output} if $_[0]->{LRDF_output}; my ($self, $msg) = @_; my $name = $self->name; my $to = $self->{to}; if(!ref $to) { # constant file name $self->{LRDF_filename} = $to; my $binmode = $self->{replace} ? '>' : '>>'; my $f = $self->{LRDF_output} = IO::File->new($to, $binmode) or fault __x"cannot write log into {file} with mode {binmode}" , binmode => $binmode, file => $to; $f->autoflush; return $self->{LRDF_output} = $f; } if(ref $to eq 'CODE') { # variable filename my $fn = $self->{LRDF_filename} = $to->($self, $msg); return $self->{LRDF_output} = $self->{LRDF_out}{$fn}; } # probably file-handle $self->{LRDF_output} = $to; } #----------- sub close() { my $self = shift; $self->SUPER::close or return; my $to = $self->{to}; my @close = ref $to eq 'CODE' ? values %{$self->{LRDF_out}} : $self->{LRDF_filename} ? $self->{LRDF_output} : (); $_->close for @close; $self; } sub rotate($) { my ($self, $old) = @_; my $to = $self->{to}; my $logs = ref $to eq 'CODE' ? $self->{LRDF_out} : +{ $self->{to} => $self->{LRDF_output} }; while(my ($log, $fh) = each %$logs) { !ref $log or error __x"cannot rotate log file which was opened as file-handle"; my $oldfn = ref $old eq 'CODE' ? $old->($log) : $old; trace "rotating $log to $oldfn"; rename $log, $oldfn or fault __x"unable to rotate logfile {fn} to {oldfn}" , fn => $log, oldfn => $oldfn; $fh->close; # close after move not possible on Windows? my $f = $self->{LRDF_output} = $logs->{$log} = IO::File->new($log, '>>') or fault __x"cannot write log into {file}", file => $log; $f->autoflush; } $self; } #----------- sub log($$$$) { my ($self, $opts, $reason, $msg, $domain) = @_; my $trans = $self->translate($opts, $reason, $msg); my $text = $self->format->($trans, $domain, $msg); my $out = $self->output($msg); flock $out, LOCK_EX; $out->print($text); flock $out, LOCK_UN; } 1; Log-Report-1.18/lib/Log/Report/Dispatcher/Syslog.pm0000644000175000001440000000607213002344341022620 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use warnings; use strict; package Log::Report::Dispatcher::Syslog; use vars '$VERSION'; $VERSION = '1.18'; use base 'Log::Report::Dispatcher'; use Log::Report 'log-report'; use Sys::Syslog qw/:standard :extended :macros/; use Log::Report::Util qw/@reasons expand_reasons/; use Encode qw/encode/; use File::Basename qw/basename/; my %default_reasonToPrio = ( TRACE => LOG_DEBUG , ASSERT => LOG_DEBUG , INFO => LOG_INFO , NOTICE => LOG_NOTICE , WARNING => LOG_WARNING , MISTAKE => LOG_WARNING , ERROR => LOG_ERR , FAULT => LOG_ERR , ALERT => LOG_ALERT , FAILURE => LOG_EMERG , PANIC => LOG_CRIT ); @reasons==keys %default_reasonToPrio or panic __"not all reasons have a default translation"; my $active; sub init($) { my ($self, $args) = @_; $args->{format_reason} ||= 'IGNORE'; $self->SUPER::init($args); error __x"max one active syslog dispatcher, attempt for {new} have {old}" , new => $self->name, old => $active if $active; $active = $self->name; setlogsock(delete $args->{logsocket}) if $args->{logsocket}; my $ident = delete $args->{identity} || basename $0; my $flags = delete $args->{flags} || 'pid,nowait'; my $fac = delete $args->{facility} || 'user'; openlog $ident, $flags, $fac; # doesn't produce error. $self->{LRDS_incl_dom} = delete $args->{include_domain}; $self->{LRDS_charset} = delete $args->{charset} || "utf-8"; $self->{LRDS_format} = $args->{format} || sub {$_[0]}; $self->{prio} = +{ %default_reasonToPrio }; if(my $to_prio = delete $args->{to_prio}) { my @to = @$to_prio; while(@to) { my ($reasons, $level) = splice @to, 0, 2; my @reasons = expand_reasons $reasons; my $prio = Sys::Syslog::xlate($level); error __x"syslog level '{level}' not understood", level => $level if $prio eq -1; $self->{prio}{$_} = $prio for @reasons; } } $self; } sub close() { my $self = shift; undef $active; closelog; $self->SUPER::close; } #-------------- sub format(;$) { my $self = shift; @_ ? $self->{LRDS_format} = shift : $self->{LRDS_format}; } #-------------- sub log($$$$$) { my ($self, $opts, $reason, $msg, $domain) = @_; my $text = $self->translate($opts, $reason, $msg) or return; my $format = $self->format; # handle each line in message separately $text =~ s/\s+$//s; my @text = split /\n/, $format->($text, $domain, $msg); my $prio = $self->reasonToPrio($reason); my $charset = $self->{LRDS_charset}; if($self->{LRDS_incl_dom} && $domain) { $domain =~ s/\%//g; # security syslog $prio, "$domain %s", encode($charset, shift @text); } syslog $prio, "%s", encode($charset, $_) for @text; } sub reasonToPrio($) { $_[0]->{prio}{$_[1]} } 1; Log-Report-1.18/lib/Log/Report/Dispatcher/Perl.pod0000644000175000001440000000271613002344342022412 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Perl - send messages to die and warn =head1 INHERITANCE Log::Report::Dispatcher::Perl is a Log::Report::Dispatcher =head1 SYNOPSIS dispatcher Log::Report::Dispatcher::Perl => 'default' , accept => 'NOTICE-'; # close the default dispatcher dispatcher close => 'default'; =head1 DESCRIPTION Ventilate the problem reports via the standard Perl error mechanisms: C, C, and C. There can be only one such dispatcher (per thread), because once C is called, we are not able to return. Therefore, this dispatcher will always be called last. In the early releases of Log::Report, it tried to simulate the behavior of warn and die using STDERR and exit; however: that is not possible. Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report/Dispatcher/Perl.pm0000644000175000001440000000106613002344341022240 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use warnings; use strict; package Log::Report::Dispatcher::Perl; use vars '$VERSION'; $VERSION = '1.18'; use base 'Log::Report::Dispatcher'; use Log::Report 'log-report'; use IO::File; my $singleton = 0; # can be only one (per thread) sub log($$$$) { my ($self, $opts, $reason, $message, $domain) = @_; print STDERR $self->translate($opts, $reason, $message); } 1; Log-Report-1.18/lib/Log/Report/Dispatcher/File.pod0000644000175000001440000001604713002344342022371 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::File - send messages to a file or file-handle =head1 INHERITANCE Log::Report::Dispatcher::File is a Log::Report::Dispatcher =head1 SYNOPSIS dispatcher Log::Report::Dispatcher::File => 'stderr' , to => \*STDERR, accept => 'NOTICE-'; # close a dispatcher dispatcher close => 'stderr'; # let dispatcher open and close the file dispatcher FILE => 'mylog', to => '/var/log/mylog' , charset => 'utf-8'; ... dispatcher close => 'mylog'; # will close file # open yourself, then also close yourself open OUT, ">:encoding('iso-8859-1')", '/var/log/mylog' or fault "..."; dispatcher FILE => 'mylog', to => \*OUT; ... dispatcher close => 'mylog'; close OUT; # dispatch into a scalar my $output = ''; open $outfile, '>', \$output; dispatcher FILE => 'into-scalar', to => \$outfile; ... dispatcher close => 'into-scalar'; print $output; =head1 DESCRIPTION This basic file logger accepts an file-handle or filename as destination. [1.00] writing to the file protected by a lock, so multiple processes can write to the same file. Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">. =over 4 =item Log::Report::Dispatcher::File-EB($type, $name, %options) -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode charset Log::Report::Dispatcher LOCALE format format_reason Log::Report::Dispatcher 'LOWERCASE' locale Log::Report::Dispatcher mode Log::Report::Dispatcher 'NORMAL' replace false to =over 2 =item accept => REASONS =item charset => CHARSET =item format => CODE|'LONG' [1.00] process each printed line. By default, this adds a timestamp, but you may want to add hostname, process number, or more. format => sub { '['.localtime().'] '.$_[0] } format => sub { shift } # no timestamp format => 'LONG' The first parameter to format is the string to print; it is already translated and trailed by a newline. The second parameter is the text-domain (if known). [1.10] As third parameter, you get the $msg raw object as well (maybe you want to use the message context?) The "LONG" format is equivalent to: my $t = strftime "%FT%T", gmtime; "[$t $$] $_[1] $_[0]" Use of context: format => sub { my ($msgstr, $domain, $msg) = @_; my $host = $msg->context->{host}; "$host $msgstr"; } =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item locale => LOCALE =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item replace => BOOLEAN Only used in combination with a FILENAME: throw away the old file if it exists. Probably you wish to append to existing information. Use the LOCALE setting by default, which is LC_CTYPE or LC_ALL or LANG (in that order). If these contain a character-set which Perl understands, then that is used, otherwise silently ignored. =item to => FILENAME|FILEHANDLE|OBJECT|CODE You can either specify a FILENAME, which is opened in append mode with autoflush on. Or pass any kind of FILE-HANDLE or some OBJECT which implements a C method. You probably want to have autoflush enabled on your FILE-HANDLES. When cleaning-up the dispatcher, the file will only be closed in case of a FILENAME. [1.10] When you pass a CODE, then for each log message the function is called with two arguments: this dispatcher object and the message object. In some way (maybe via the message context) you have to determine the log filename. This means that probably many log-files are open at the same time. # configuration time dispatcher FILE => 'logfile', to => sub { my ($disp, $msg) = @_; $msg->context->{logfile} }; # whenever you want to change the logfile textdomain->updateContext(logfile => '/var/log/app'); (textdomain 'mydomain')->setContext(logfile => '/var/log/app'); # or error __x"help", _context => {logfile => '/dev/tty'}; error __x"help", _context => "logfile=/dev/tty"; =back =back =head2 Accessors Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">. =over 4 =item $obj-EB() Returns the name of the opened file, or C in case this dispatcher was started from a file-handle or file-object. =item $obj-EB() =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$reason] ) Inherited, see L =item $obj-EB($msg) Returns the file-handle to write the log lines to. [1.10] This may depend on the $msg (especially message context) =item $obj-EB() Inherited, see L =back =head2 File maintenance =over 4 =item $obj-EB() Only when initiated with a FILENAME, the file will be closed. In any other case, nothing will be done. =item $obj-EB($filename|CODE) [1.00] Move the current file to $filename, and start a new file. =back =head2 Logging Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">. =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher::File-EB(@CODE) Inherited, see L =item $obj-EB() =item Log::Report::Dispatcher::File-EB() Inherited, see L =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher::File-EB( [$maxdepth] ) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message, $domain) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB(%options) =item Log::Report::Dispatcher::File-EB(%options) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message) Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report/Dispatcher/Log4perl.pm0000644000175000001440000000516213002344341023027 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use warnings; use strict; package Log::Report::Dispatcher::Log4perl; use vars '$VERSION'; $VERSION = '1.18'; use base 'Log::Report::Dispatcher'; use Log::Report 'log-report'; use Log::Report::Util qw/@reasons expand_reasons/; use Log::Log4perl qw/:levels/; my %default_reasonToLevel = ( TRACE => $DEBUG , ASSERT => $DEBUG , INFO => $INFO , NOTICE => $INFO , WARNING => $WARN , MISTAKE => $WARN , ERROR => $ERROR , FAULT => $ERROR , ALERT => $FATAL , FAILURE => $FATAL , PANIC => $FATAL ); @reasons==keys %default_reasonToLevel or panic __"Not all reasons have a default translation"; # Do not show these as source of the error: one or more caller frames up Log::Log4perl->wrapper_register($_) for qw/ Log::Report Log::Report::Dispatcher Log::Report::Dispatcher::Try /; sub init($) { my ($self, $args) = @_; $args->{accept} ||= 'ALL'; $self->SUPER::init($args); my $name = $self->name; my $config = delete $args->{config} or error __x"Log4perl back-end {name} requires a 'config' parameter" , name => $name; $self->{LRDL_levels} = { %default_reasonToLevel }; if(my $to_level = delete $args->{to_level}) { my @to = @$to_level; while(@to) { my ($reasons, $level) = splice @to, 0, 2; my @reasons = expand_reasons $reasons; $level =~ m/^[0-5]$/ or error __x "Log4perl level '{level}' must be in 0-5" , level => $level; $self->{LRDL_levels}{$_} = $level for @reasons; } } Log::Log4perl->init($config) or return; $self; } #sub close() #{ my $self = shift; # $self->SUPER::close or return; # $self; #} sub logger(;$) { my ($self, $domain) = @_; defined $domain or return Log::Log4perl->get_logger($self->name); # get_logger() creates a logger if that does not exist. But we # want to route it to default $Log::Log4perl::LOGGERS_BY_NAME->{$domain} ||= Log::Log4perl->get_logger($self->name); } sub log($$$$) { my ($self, $opts, $reason, $msg, $domain) = @_; my $text = $self->translate($opts, $reason, $msg) or return; my $level = $self->reasonToLevel($reason); local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 3; $text =~ s/\s+$//s; # log4perl adds own \n $self->logger($domain)->log($level, $text); $self; } sub reasonToLevel($) { $_[0]->{LRDL_levels}{$_[1]} } 1; Log-Report-1.18/lib/Log/Report/Dispatcher/Try.pm0000644000175000001440000000540513002344341022115 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use warnings; use strict; package Log::Report::Dispatcher::Try; use vars '$VERSION'; $VERSION = '1.18'; use base 'Log::Report::Dispatcher'; use Log::Report 'log-report', syntax => 'SHORT'; use Log::Report::Exception (); use Log::Report::Util qw/%reason_code/; use overload bool => 'failed' , '""' => 'showStatus' , fallback => 1; #----------------- sub init($) { my ($self, $args) = @_; defined $self->SUPER::init($args) or return; $self->{exceptions} = delete $args->{exceptions} || []; $self->{died} = delete $args->{died}; $self->hide($args->{hide} // 'NONE'); $self->{on_die} = $args->{on_die} // 'ERROR'; $self; } sub 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 hides($) { my $h = shift->{hides} or return 0; keys %$h ? $h->{(shift)} : 1; } sub hide(@) { my $self = shift; my @h = map { ref $_ eq 'ARRAY' ? @$_ : defined($_) ? $_ : () } @_; $self->{hides} = @h==0 ? undef : @h==1 && $h[0] eq 'ALL' ? {} # empty HASH = ALL : @h==1 && $h[0] eq 'NONE' ? undef : +{ map +($_ => 1), @h }; } sub die2reason() { shift->{on_die} } #----------------- sub log($$$$) { my ($self, $opts, $reason, $message, $domain) = @_; unless($opts->{stack}) { my $mode = $self->mode; $opts->{stack} = $self->collectStack if $reason eq 'PANIC' || ($mode==2 && $reason_code{$reason} >= $reason_code{ALERT}) || ($mode==3 && $reason_code{$reason} >= $reason_code{ERROR}); } $opts->{location} ||= ''; my $e = Log::Report::Exception->new ( reason => $reason , report_opts => $opts , message => $message ); push @{$self->{exceptions}}, $e; $self->{died} ||= exists $opts->{is_fatal} ? $opts->{is_fatal} : $e->isFatal; $self; } sub reportFatal(@) { $_->throw(@_) for shift->wasFatal } sub reportAll(@) { $_->throw(@_) for shift->exceptions } #----------------- sub failed() { 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-1.18/lib/Log/Report/Dispatcher/Syslog.pod0000644000175000001440000001506713002344342022773 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher::Syslog - send messages to syslog =head1 INHERITANCE Log::Report::Dispatcher::Syslog is a Log::Report::Dispatcher =head1 SYNOPSIS # add syslog dispatcher dispatcher SYSLOG => 'syslog', accept => 'NOTICE-' , format_reason => 'IGNORE' , to_prio => [ 'ALERT-' => 'err' ]; # disable default dispatcher, when daemon dispatcher close => 'default'; =head1 DESCRIPTION This dispatchers produces output to syslog, based on the Sys::Syslog module (which will NOT be automatically installed for you, because some systems have a problem with this dependency). The REASON for a message often uses names which are quite similar to the log-levels used by syslog. However: they have a different purpose. The REASON is used by the programmer to indicate the cause of the message: whether it was able to handle a certain situation. The syslog levels are there for the user's of the program (with syslog usually the system administrators). It is not unusual to see a "normal" error or mistake as a very serious situation in a production environment. So, you may wish to translate any message above reason MISTAKE into a LOG_CRIT. The default translation table is list below. You can change the mapping using L. See example in SYNOPSIS. TRACE => LOG_DEBUG ERROR => LOG_ERR ASSERT => LOG_DEBUG FAULT => LOG_ERR INFO => LOG_INFO ALERT => LOG_ALERT NOTICE => LOG_NOTICE FAILURE => LOG_EMERG WARNING => LOG_WARNING PANIC => LOG_CRIT MISTAKE => LOG_WARNING Extends L<"DESCRIPTION" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Log::Report::Dispatcher::Syslog-EB($type, $name, %options) With syslog, people tend not to include the REASON of the message in the logs, because that is already used to determine the destination of the message. -Option --Defined in --Default accept Log::Report::Dispatcher depend on mode charset 'utf8' facility 'user' flags 'pid,nowait' format format_reason Log::Report::Dispatcher 'IGNORE' identity include_domain locale Log::Report::Dispatcher logsocket undef mode Log::Report::Dispatcher 'NORMAL' to_prio [] =over 2 =item accept => REASONS =item charset => CHARSET Translate the text-strings into the specified charset, otherwise the sysadmin may get unreadable text. =item facility => STRING The possible values for this depend (a little) on the system. POSIX only defines C, and C up to C. =item flags => STRING Any combination of flags as defined by Sys::Syslog, for instance C, C, and C. =item format => CODE [1.10] With a CODE reference you get your hands on the text before it gets sent to syslog. The three parameters are: the (translated) text, the related text domain object, and the message object. You may want to use context information from the latter. =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE =item identity => STRING =item include_domain => BOOLEAN [1.00] Include the text-domain of the message in each logged message. =item locale => LOCALE =item logsocket => 'unix'|'inet'|'stream'|HASH If specified, the log socket type will be initialized to this before C is called. If not specified, the system default is used. =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 =item to_prio => ARRAY-of-PAIRS See L. =back =back =head2 Accessors Extends L<"Accessors" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Accessors">. =over 4 =item $obj-EB( [CODE] ) Returns the CODE ref which formats the syslog line. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$reason] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Logging Extends L<"Logging" in Log::Report::Dispatcher|Log::Report::Dispatcher/"Logging">. =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher::Syslog-EB(@CODE) Inherited, see L =item $obj-EB() =item Log::Report::Dispatcher::Syslog-EB() Inherited, see L =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher::Syslog-EB( [$maxdepth] ) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message, $domain) Inherited, see L =item $obj-EB($reason) Returns a level which is understood by syslog(3), based on a translation table. This can be changed with L. =item $obj-EB() Inherited, see L =item $obj-EB(%options) =item Log::Report::Dispatcher::Syslog-EB(%options) Inherited, see L =item $obj-EB(HASH-$of-%options, $reason, $message) Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Dispatcher|Log::Report::Dispatcher/"DETAILS">. =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report/Exception.pm0000644000175000001440000000361013002344341021203 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use warnings; use strict; package Log::Report::Exception; use vars '$VERSION'; $VERSION = '1.18'; use Log::Report 'log-report'; use Log::Report::Util qw/is_fatal to_html/; use POSIX qw/locale_h/; use Scalar::Util qw/blessed/; use overload '""' => 'toString' , fallback => 1; sub new($@) { my ($class, %args) = @_; $args{report_opts} ||= {}; bless \%args, $class; } sub report_opts() {shift->{report_opts}} sub reason(;$) { my $self = shift; @_ ? $self->{reason} = uc(shift) : $self->{reason}; } sub isFatal() { is_fatal shift->{reason} } sub message(;$) { my $self = shift; @_ or return $self->{message}; my $msg = shift; blessed $msg && $msg->isa('Log::Report::Message') or panic "message() of exception expects Log::Report::Message"; $self->{message} = $msg; } sub inClass($) { $_[0]->message->inClass($_[1]) } sub throw(@) { my $self = shift; my $opts = @_ ? { %{$self->{report_opts}}, @_ } : $self->{report_opts}; my $reason; if($reason = delete $opts->{reason}) { $self->{reason} = $reason; $opts->{is_fatal} = is_fatal $reason unless exists $opts->{is_fatal}; } else { $reason = $self->{reason}; } $opts->{stack} ||= Log::Report::Dispatcher->collectStack; report $opts, $reason, $self; } # where the throw is handled is not interesting sub PROPAGATE($$) {shift} sub toString(;$) { my ($self, $locale) = @_; my $msg = $self->message; lc($self->{reason}).': '.(ref $msg ? $msg->toString($locale) : $msg)."\n"; } sub toHTML(;$) { to_html($_[0]->toString($_[1])) } sub print(;$) { my $self = shift; (shift || *STDERR)->print($self->toString); } 1; Log-Report-1.18/lib/Log/Report/DBIC/0000755000175000001440000000000013002344345017414 5ustar00markovusers00000000000000Log-Report-1.18/lib/Log/Report/DBIC/Profiler.pod0000644000175000001440000000230613002344342021700 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::DBIC::Profiler - query profiler for DBIx::Class =head1 INHERITANCE Log::Report::DBIC::Profiler is a DBIx::Class::Storage::Statistics =head1 SYNOPSIS use Log::Report::DBIC::Profiler; $schema->storage->debugobj(Log::Report::DBIC::Profiler->new); $schema->storage->debug(1); # And maybe (if no exceptions expected from DBIC) $schema->exception_action(sub { panic @_ }); # Log to syslog use Log::Report; dispatcher SYSLOG => 'myapp' , identity => 'myapp' , facility => 'local0' , flags => "pid ndelay nowait" , mode => 'DEBUG'; =head1 DESCRIPTION This profile will log DBIx::Class queries via L to a selected back-end (via a dispatcher, see L) =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report/DBIC/Profiler.pm0000644000175000001440000000130313002344341021525 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use strict; use warnings; package Log::Report::DBIC::Profiler; use vars '$VERSION'; $VERSION = '1.18'; use base 'DBIx::Class::Storage::Statistics'; use Log::Report 'log-report', import => 'trace'; use Time::HiRes qw(time); my $start; sub print($) { trace $_[1] } sub query_start(@) { my $self = shift; $self->SUPER::query_start(@_); $start = time; } sub query_end(@) { my $self = shift; $self->SUPER::query_end(@_); trace sprintf "execution took %0.4f seconds elapse", time-$start; } 1; Log-Report-1.18/lib/Log/Report/messages/0000755000175000001440000000000013002344345020522 5ustar00markovusers00000000000000Log-Report-1.18/lib/Log/Report/messages/log-report.utf-8.po0000644000175000001440000003013412705145357024132 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-1.18/lib/Log/Report/messages/log-report/0000755000175000001440000000000013002344345022614 5ustar00markovusers00000000000000Log-Report-1.18/lib/Log/Report/messages/log-report/nl_NL.po0000644000175000001440000003661112705145357024200 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-1.18/lib/Log/Report/Message.pm0000644000175000001440000001135013002344341020631 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use warnings; use strict; package Log::Report::Message; use vars '$VERSION'; $VERSION = '1.18'; use Log::Report 'log-report'; use POSIX qw/locale_h/; use List::Util qw/first/; use Log::Report::Util qw/to_html/; # Work-around for missing LC_MESSAGES on old Perls and Windows { no warnings; eval "&LC_MESSAGES"; *LC_MESSAGES = sub(){5} if $@; } use overload '""' => 'toString' , '&{}' => sub { my $obj = shift; sub{$obj->clone(@_)} } , '.' => 'concat' , fallback => 1; sub new($@) { my ($class, %s) = @_; if(ref $s{_count}) { my $c = $s{_count}; $s{_count} = ref $c eq 'ARRAY' ? @$c : keys %$c; } defined $s{_join} or $s{_join} = $"; if($s{_msgid}) { $s{_append} = defined $s{_append} ? $1.$s{_append} : $1 if $s{_msgid} =~ s/(\s+)$//; $s{_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 context() {shift->{_context}} 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} : ''); # assumed is that switching locales is expensive my $oldloc = setlocale(LC_MESSAGES); setlocale(LC_MESSAGES, $locale) if defined $locale && (!defined $oldloc || $locale ne $oldloc); # create a translation my $text = (textdomain $self->{_domain}) ->translate($self, $self->{_lang} || $locale || $oldloc); defined $text or return (); $text =~ s/\{([^%}]+)(\%[^}]*)?\}/$self->_expand($1,$2)/ge if $self->{_expand}; $text = "$self->{_prepend}$text" if defined $self->{_prepend}; $text .= "$self->{_append}" if defined $self->{_append}; setlocale(LC_MESSAGES, $oldloc) if defined $oldloc && (!defined $locale || $oldloc ne $locale); $text; } sub _expand($$) { my ($self, $key, $format) = @_; my $value = $self->{$key} // $self->{_context}{$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 } my %tohtml = qw/ > gt < lt " quot & amp /; sub toHTML(;$) { to_html($_[0]->toString($_[1])) } sub untranslated() { my $self = shift; (defined $self->{_prepend} ? $self->{_prepend} : '') . (defined $self->{_msgid} ? $self->{_msgid} : '') . (defined $self->{_append} ? $self->{_append} : ''); } sub concat($;$) { my ($self, $what, $reversed) = @_; if($reversed) { $what .= $self->{_prepend} if defined $self->{_prepend}; return ref($self)->new(%$self, _prepend => $what); } $what = $self->{_append} . $what if defined $self->{_append}; ref($self)->new(%$self, _append => $what); } #---------------- 1; Log-Report-1.18/lib/Log/Report/Exception.pod0000644000175000001440000000746413002344342021365 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|Regexp) Check whether any of the classes listed in the message match $class (string) or the Regexp. This uses L. =item $obj-EB( [$fh] ) The default filehandle is STDOUT. example: print $exception; # via overloading $exception->print; # OO style =item $obj-EB(%options) Insert the message contained in the exception into the currently defined dispatchers. The C name is commonly known exception related terminology for C. The %options overrule the captured options to L. This can be used to overrule a destination. Also, the reason can be changed. example: overrule defaults to report try { print {to => 'stderr'}, ERROR => 'oops!' }; $@->reportFatal(to => 'syslog'); $exception->throw(to => 'syslog'); $@->wasFatal->throw(reason => 'WARNING'); =item $obj-EB( [$locale] ) [1.11] as L, and escape HTML volatile characters. =item $obj-EB( [$locale] ) Prints the reason and the message. Differently from L, this only represents the textual content: it does not re-cast the exceptions to higher levels. example: printing exceptions print $_->toString for $@->exceptions; print $_ for $@->exceptions; # via overloading =back =head1 OVERLOADING =over 4 =item overload: B Produces "reason: message". =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report/Translator.pm0000644000175000001440000000344113002344341021400 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. package Log::Report::Translator; use vars '$VERSION'; $VERSION = '1.18'; use warnings; use strict; use Log::Report 'log-report'; use Log::Report::Message; use File::Spec (); my %lexicons; sub _fn_to_lexdir($); sub new(@) { my $class = shift; (bless {}, $class)->init( {callerfn => (caller)[1], @_} ); } sub init($) { my ($self, $args) = @_; my $lex = delete $args->{lexicons} || delete $args->{lexicon} || (ref $self eq __PACKAGE__ ? [] : _fn_to_lexdir $args->{callerfn}); my @lex; foreach my $dir (ref $lex eq 'ARRAY' ? @$lex : $lex) { unless(exists $INC{'Log/Report/Lexicon/Index.pm'}) { eval "require Log::Report::Lexicon::Index"; panic $@ if $@; error __x"You have to upgrade Log::Report::Lexicon to at least 1.00" if $Log::Report::Lexicon::Index::VERSION < 1.00; } # lexicon indexes are shared my $l = $lexicons{$dir} ||= Log::Report::Lexicon::Index->new($dir); $l->index; # index the files now push @lex, $l; } $self->{lexicons} = \@lex; $self->{charset} = $args->{charset} || 'utf-8'; $self; } sub _fn_to_lexdir($) { 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-1.18/lib/Log/Report/Message.pod0000644000175000001440000004027413002344342021007 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Message - a piece of text to be translated =head1 INHERITANCE Log::Report::Message is extended by Dancer2::Plugin::LogReport::Message =head1 SYNOPSIS # Objects created by Log::Report's __ functions # Full feature description in the DETAILS section # no interpolation __"Hello, World"; # with interpolation __x"age {years}", years => 12; # interpolation for one or many my $nr_files = @files; __nx"one file", "{_count} files", $nr_files; __nx"one file", "{_count} files", \@files; # interpolation of arrays __x"price-list: {prices%.2f}", prices => \@prices, _join => ', '; # white-spacing on msgid preserved print __"\tCongratulations,\n"; print "\t", __("Congratulations,"), "\n"; # same =head1 DESCRIPTION Any use of a translation function exported by L, like C<__()> (the function is named underscore-underscore) or C<__x()> (underscore-underscore-x) will result in this object. It will capture some environmental information, and delay the translation until it is needed. Creating an object first and translating it later, is slower than translating it immediately. However, on the location where the message is produced, we do not yet know in what language to translate it to: that depends on the front-end, the log dispatcher. =head1 METHODS =head2 Constructors =over 4 =item $obj-EB(%options, $variables) Returns a new object which copies info from original, and updates it with the specified %options and $variables. The advantage is that the cached translations are shared between the objects. example: use of clone() my $s = __x "found {nr} files", nr => 5; my $t = $s->clone(nr => 3); my $t = $s->(nr => 3); # equivalent print $s; # found 5 files print $t; # found 3 files =item Log::Report::Message-EB($domain, $msgid, $params) See L on the details how to integrate Log::Report translations with Template::Toolkit (version 1 and 2) =item Log::Report::Message-EB(%options) B, but use L and friends. The %options is a mixed list of object initiation parameters (all with a leading underscore) and variables to be filled in into the translated C<_msgid> string. -Option --Default _append undef _category undef _class [] _classes [] _context undef _count undef _domain _expand false _join $" $LIST_SEPARATOR _lang _msgid undef _plural undef _prepend undef _to =over 2 =item _append => STRING|MESSAGE Text as STRING or MESSAGE object to be displayed after the display of this message. =item _category => INTEGER The category when the real gettext library is used, for instance LC_MESSAGES. =item _class => STRING|ARRAY When messages are used for exception based programming, you add C<_class> parameters to the argument list. Later, with for instance L, you can check the category of the message. One message can be part of multiple classes. The STRING is used as comma- and/or blank separated list of class tokens (barewords), the ARRAY lists all tokens separately. See L. =item _classes => STRING|ARRAY Alternative for C<_class>, which cannot be used at the same time. =item _context => WORDS|ARRAY [1.00] Set keywords which can be used to select alternatives between translations. Read the DETAILS section in L =item _count => INTEGER|ARRAY|HASH When defined, the C<_plural> need to be defined as well. When an ARRAY is provided, the length of the ARRAY is taken. When a HASH is given, the number of keys in the HASH is used. =item _domain => STRING The text-domain (translation table) to which this C<_msgid> belongs. With this parameter, your can "borrow" translations from other textdomains. Be very careful with this (although there are good use-cases) The xgettext msgid extractor may add the used msgid to this namespace as well. To avoid that, add a harmless '+': print __x(+"errors", _domain => 'global'); The extractor will not take the msgid when it is an expression. The '+' has no effect on the string at runtime. =item _expand => BOOLEAN Indicates whether variables are to be filled-in. =item _join => STRING Which STRING to be used then an ARRAY is being filled-in. =item _lang => ISO [1.00] Override language setting from locale, for instance because that is not configured correctly (yet). This does not extend to prepended or appended translated message object. =item _msgid => MSGID The message label, which refers to some translation information. Usually a string which is close the English version of the message. This will also be used if there is no translation possible/known. Leading white-space C<\s> will be added to C<_prepend>. Trailing white-space will be added before C<_append>. =item _plural => MSGID Can be used together with C<_count>. This plural form of the C<_msgid> text is used to simplify the work of translators, and as fallback when no translation is possible: therefore, this can best resemble an English message. White-space at the beginning and end of the string are stripped off. The white-space provided by the C<_msgid> will be used. =item _prepend => STRING|MESSAGE Text as STRING or MESSAGE object to be displayed before the display of this message. =item _to => NAME Specify the NAME of a dispatcher as destination explicitly. Short for C<< report {to => NAME}, ... >> See L =back =back =head2 Accessors =over 4 =item $obj-EB() Returns the string or L object which is appended after this one. Usually C. =item $obj-EB() Returns the LIST of classes which are defined for this message; message group indicators, as often found in exception-based programming. =item $obj-EB() Returns an HASH if there is a context defined for this message. =item $obj-EB() Returns the count, which is used to select the translation alternatives. =item $obj-EB() Returns the domain of the first translatable string in the structure. =item $obj-EB() 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|Regexp) Returns true if the message is in the specified $class (string) or matches the Regexp. The trueth value is the (first matching) class. =item $obj-EB( [$locale] ) [1.11] Translate the message, and then entity encode HTML volatile characters. =item $obj-EB( [$locale] ) Translate a message. If not specified, the default locale is used. =item $obj-EB() Return the concatenation of the prepend, msgid, and append strings. Variable expansions within the msgid is not performed. =back =head1 DETAILS =head2 OPTIONS and VARIABLES The L functions which define translation request can all have OPTIONS. Some can have VARIABLES to be interpolated in the string as well. To distinguish between the OPTIONS and VARIABLES (both a list of key-value pairs), the keys of the OPTIONS start with an underscore C<_>. As result of this, please avoid the use of keys which start with an underscore in variable names. On the other hand, you are allowed to interpolate OPTION values in your strings. =head3 Interpolating With the C<__x()> or C<__nx()>, interpolation will take place on the translated MSGID string. The translation can contain the VARIABLE and OPTION names between curly brackets. Text between curly brackets which is not a known parameter will be left untouched. fault __x"cannot open open {filename}", filename => $fn; print __xn"directory {dir} contains one file" ,"directory {dir} contains {nr_files} files" , scalar(@files) # (1) (2) , nr_files => scalar @files # (3) , dir => $dir; (1) this required third parameter is used to switch between the different plural forms. English has only two forms, but some languages have many more. (2) the "scalar" keyword is not needed, because the third parameter is in SCALAR context. You may also pass C< \@files > there, because ARRAYs will be converted into their length. A HASH will be converted into the number of keys in the HASH. (3) the C keyword is required here, because it is LIST context: otherwise all filenames will be filled-in as parameters to C<__xn()>. See below for the available C<_count> valure, to see how the C parameter can disappear. =head3 Interpolation of VARIABLES C uses L to interpolate values in(translated) messages. This is a very powerful syntax, and you should certainly read that manual-page. Here, we only described additional features, specific to the usage of C in C objects. There is no way of checking beforehand whether you have provided all required values, to be interpolated in the translated string. For interpolating, the following rules apply: =over 4 =item * Simple scalar values are interpolated "as is" =item * References to SCALARs will collect the value on the moment that the output is made. The C object which is created with the C<__xn> can be seen as a closure. The translation can be reused. See example below. =item * Code references can be used to create the data "under fly". The C object which is being handled is passed as only argument. This is a hash in which all OPTIONS and VARIABLES can be found. =item * When the value is an ARRAY, all members will be interpolated with C<$"> between the elements. Alternatively (maybe nicer), you can pass an interpolation parameter via the C<_join> OPTION. =back local $" = ', '; error __x"matching files: {files}", files => \@files; error __x"matching files: {files}", files => \@files, _join => ', '; =head3 Interpolation of OPTIONS You are permitted the interpolate OPTION values in your string. This may simplify your coding. The useful names are: =over 4 =item _msgid The MSGID as provided with L and L =item _plural, _count The PLURAL MSGIDs, respectively the COUNT as used with L and L =item _textdomain The label of the textdomain in which the translation takes place. =item _class or _classes Are to be used to group reports, and can be queried with L, L, or L. =back B<. Example: using the _count> With Locale::TextDomain, you have to do use Locale::TextDomain; print __nx ( "One file has been deleted.\n" , "{num} files have been deleted.\n" , $num_files , num => $num_files ); With C, you can do use Log::Report; print __nx ( "One file has been deleted.\n" , "{_count} files have been deleted.\n" , $num_files ); Of course, you need to be aware that the name used to reference the counter is fixed to C<_count>. The first example works as well, but is more verbose. =head3 Handling white-spaces In above examples, the msgid and plural form have a trailing new-line. In general, it is much easier to write print __x"Hello, World!\n"; than print __x("Hello, World!") . "\n"; For the translation tables, however, that trailing new-line is "over information"; it is an layout issue, not a translation issue. Therefore, the first form will automatically be translated into the second. All leading and trailing white-space (blanks, new-lines, tabs, ...) are removed from the msgid 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 because the first value of C<$i> is captured in the initial message object. With Log::Report, you can do it (except when you use contexts) use Log::Report; my $i; my $s = __x("Hello World {i}\n", i => \$i); foreach $i (1..100_000) { print $s; } Mind you not to write: C in above case!!!! You can also write an incomplete translation: use Log::Report; my $s = __x "Hello World {i}\n"; foreach my $i (1..100_000) { print $s->(i => $i); } In either case, the translation will be looked-up only once. =head1 OVERLOADING =over 4 =item overload: B When the object is used to call as $function, a new object is created with the data from the original one but updated with the new parameters. Implemented in C. =item overload: B An (accidental) use of concatenation (a dot where a comma should be used) would immediately stringify the object. This is avoided by overloading that operation. =item overload: B When the object is used in string context, it will get translated. Implemented as L. =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report/Translator.pod0000644000175000001440000000635513002344342021556 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Translator - base implementation for translating messages =head1 INHERITANCE Log::Report::Translator is extended by Log::Report::Translator::Gettext Log::Report::Translator::POT =head1 SYNOPSIS # internal infrastructure my $msg = Log::Report::Message->new(_msgid => "Hello World\n"); print Log::Report::Translator->new(...)->translate($msg); # normal use textdomain 'my-domain' , translator => Log::Report::Translator->new; # default print __"Hello World\n"; =head1 DESCRIPTION A module (or distribution) has a certain way of translating messages, usually C. The translator is based on some C for the message, which can be specified as option per text element, but usually is package scoped. This base class does not translate at all: it will use the MSGID (and MSGID_PLURAL if available). It's a nice fallback if the language packs are not installed. =head1 METHODS =head2 Constructors =over 4 =item Log::Report::Translator-EB(%options) -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, $ctxt] ) Returns the translation of the $message, a C object, based on the current locale. Translators are permitted to peek into the internal HASH of the message object, for performance reasons. =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report/Domain.pod0000644000175000001440000002221113002344342020621 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Domain - administer one text-domain =head1 INHERITANCE Log::Report::Domain is a Log::Report::Minimal::Domain =head1 SYNOPSIS # internal usage use Log::Report::Domain; my $domain = Log::Report::Domain->new(name => $name); # find a ::Domain object use Log::Report 'my-domain'; my $domain = textdomain 'my-domain'; # find domain config my $domain = textdomain; # config of this package # explicit domain configuration package My::Package; use Log::Report 'my-domain'; # set textdomain for package textdomain $name, %configure; # set config, once per program (textdomain $name)->configure(%configure); # same textdomain->configure(%configure); # same if current package in $name # implicit domain configuration package My::Package; use Log::Report 'my-domain', %configure; # external file for configuration (perl or json format) use Log::Report 'my-domain', config => $filename; use Log::Report 'my-domain'; textdomain->configure(config => $filename); =head1 DESCRIPTION L can handle multiple sets of packages at the same time: in the usual case a program consists of more than one software distribution, each containing a number of packages. Each module in an application belongs to one of these sets, by default the domain set 'default'. For C, those packags sets are differentiated via the text-domain value in the C statement: use Log::Report 'my-domain'; There are many things you can configure per (text)domain. This is not only related to translations, but also -for instance- for text formatting configuration. The administration for the configuration is managed in this package. Extends L<"DESCRIPTION" in Log::Report::Minimal::Domain|Log::Report::Minimal::Domain/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Minimal::Domain|Log::Report::Minimal::Domain/"METHODS">. =head2 Constructors Extends L<"Constructors" in Log::Report::Minimal::Domain|Log::Report::Minimal::Domain/"Constructors">. =over 4 =item Log::Report::Domain-EB(%options) Create a new Domain object. -Option--Defined in --Default name Log::Report::Minimal::Domain =over 2 =item name => STRING =back =back =head2 Attributes Extends L<"Attributes" in Log::Report::Minimal::Domain|Log::Report::Minimal::Domain/"Attributes">. =over 4 =item $obj-EB(%options) The import is automatically called when the package is compiled. For all but one packages in your distribution, it will only contain the name of the DOMAIN. For one package, it will contain configuration information. These %options are used for all packages which use the same DOMAIN. See chapter L below. -Option --Defined in --Default config undef context_rules undef formatter PRINTI native_language 'en_US' translator created internally where Log::Report::Minimal::Domain =over 2 =item config => FILENAME Read the settings from the file. The parameters found in the file are used as default for the parameters above. This parameter is especially useful for the C, which need to be shared between the running application and F. See L =item context_rules => HASH|OBJECT When rules are provided, the translator will use the C fields as provided by PO-files (gettext). This parameter is used to initialize a L helper object. =item formatter => CODE|'PRINTI'|'PRINTP' Selects the formatter used for the errors messages. The default is C, which will use L: interpolation with curly braces around the variable names. C uses positional parameters, just like C, implemented by L. =item native_language => CODESET This is the language which you have used to write the translatable and the non-translatable messages in. In case no translation is needed, you still wish the system error messages to be in the same language as the report. Of course, each textdomain can define its own. =item translator => L|HASH Set the object which will do the translations for this domain. =item where => ARRAY =back =item $obj-EB() =item $obj-EB() Returns the current default translation context settings as HASH. You should not modify the content of that HASH: change it by called L or L. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() =item $obj-EB($filename) =item Log::Report::Domain-EB($filename) Helper method, which simply parses the content $filename into a HASH to be used as parameters to L. The filename must end on '.pl', to indicate that it uses perl syntax (can be processed with Perl's C command) or end on '.json'. See also chapter L below. Currently, this file can be in Perl native format (when ending on C<.pl>) or JSON (when it ends with C<.json>). Various modules may explain parts of what can be found in these files, for instance L. =item $obj-EB(STRING|HASH|ARRAY|PAIRS) Temporary set the default translation context for messages. This is used when the message is created without a C<_context> parameter. The context can be retrieved with L. Contexts are totally ignored then there are no C. When you do not wish to change settings, you may simply provide a HASH. example: use Log::Report 'my-domain', context_rules => {}; =item $obj-EB() =item $obj-EB(STRING|HASH|ARRAY|PAIRS) [1.10] Make changes and additions to the active context (see L). =back =head2 Action Extends L<"Action" in Log::Report::Minimal::Domain|Log::Report::Minimal::Domain/"Action">. =over 4 =item Log::Report::Domain-EB( $msgid, [$args] ) Inherited, see L =item $obj-EB($message, $language) Translate the $message into the $language. =back =head1 DETAILS =head2 Configuring Configuration of a domain can happen in many ways: either explicitly or implicitly. The explicit form: package My::Package; use Log::Report 'my-domain'; textdomain 'my-domain', %configuration; textdomain->configure(%configuration); textdomain->configure(\%configuration); textdomain->configure(conf => $filename); The implicit form is (no variables possible, only constants!) package My::Package; use Log::Report 'my-domain', %configuration; use Log::Report 'my-domain', conf => '/filename'; You can only configure your domain in one place in your program. The textdomain setup is then used for all packages in the same domain. This also works for L, which is a dressed-down version of L. =head3 configuring your formatter The C and C are special constants for L, and will use L functions C respectively C in their default modus. When you want your own formatter, or configuration of C, you need to pass a code reference. my $sp = String::Print->new ( modifiers => ... , serializers => ... ); textdomain 'some-domain' , formatter => sub { $sp->printi(@_) }; =head3 configuring global values Say, you log for a (Dancer) webserver, where you wish to include the website name in some of the log lines. For this, (ab)use the translation context: ### first enabled translation contexts use Log::Report 'my-domain', context_rules => {}; # or use Log::Report 'my-domain'; textdomain->configure(context_rules => {}); ### every time you start working for a different virtual host (textdomain 'my-domain')->setContext(host => $host); ### now you can use that in your code package My::Package; use Log::Report 'my-domain'; error __x"in {host} not logged-in {user}", user => $username; =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report/Die.pm0000644000175000001440000000314713002344341017753 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use warnings; use strict; package Log::Report::Die; use vars '$VERSION'; $VERSION = '1.18'; use base 'Exporter'; our @EXPORT = qw/die_decode/; use POSIX qw/locale_h/; sub die_decode($%) { my ($text, %args) = @_; my @text = split /\n/, $text; @text or return (); chomp $text[-1]; # Try to catch the error directly, to remove it from the error text my %opt = (errno => $! + 0); my $err = "$!"; my $dietxt = $text[0]; if($text[0] =~ s/ at (.+) line (\d+)\.?$// ) { $opt{location} = [undef, $1, $2, undef]; } elsif(@text > 1 && $text[1] =~ m/^\s*at (.+) line (\d+)\.?$/ ) { # sometimes people carp/confess with \n, folding the line $opt{location} = [undef, $1, $2, undef]; splice @text, 1, 1; } $text[0] =~ s/\s*[.:;]?\s*$err\s*$// # the $err is translation sensitive or delete $opt{errno}; my @msg = shift @text; length $msg[0] or $msg[0] = 'stopped'; my @stack; foreach (@text) { if(m/^\s*(.*?)\s+called at (.*?) line (\d+)\s*$/) { push @stack, [ $1, $2, $3 ] } else { push @msg, $_ } } $opt{stack} = \@stack; $opt{classes} = [ 'perl', (@stack ? 'confess' : 'die') ]; my $reason = $opt{errno} ? 'FAULT' : @stack ? 'PANIC' : $args{on_die} || 'ERROR'; ($dietxt, \%opt, $reason, join("\n", @msg)); } "to die or not to die, that's the question"; Log-Report-1.18/lib/Log/Report/Dispatcher.pm0000644000175000001440000002216013002344341021334 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use warnings; use strict; package Log::Report::Dispatcher; use vars '$VERSION'; $VERSION = '1.18'; use Log::Report 'log-report'; use Log::Report::Util qw/parse_locale expand_reasons %reason_code escape_chars/; use POSIX qw/strerror/; use List::Util qw/sum first/; use Encode qw/find_encoding FB_DEFAULT/; use Devel::GlobalDestruction qw/in_global_destruction/; eval { POSIX->import('locale_h') }; if($@) { no strict 'refs'; *setlocale = sub { $_[1] }; *LC_ALL = sub { undef }; } my %modes = (NORMAL => 0, VERBOSE => 1, ASSERT => 2, DEBUG => 3 , 0 => 0, 1 => 1, 2 => 2, 3 => 3); my @default_accept = ('NOTICE-', 'INFO-', 'ASSERT-', 'ALL'); my %always_loc = map +($_ => 1), qw/ASSERT ALERT FAILURE PANIC/; my %predef_dispatchers = map +(uc($_) => __PACKAGE__.'::'.$_) , qw/File Perl Syslog Try Callback Log4perl/; my @skip_stack = sub { $_[0][0] =~ m/^Log\:\:Report(?:\:\:|$)/ }; sub new(@) { my ($class, $type, $name, %args) = @_; # $type is a class name or predefined name. my $backend = $predef_dispatchers{$type} ? $predef_dispatchers{$type} : $type->isa('Log::Dispatch::Output') ? __PACKAGE__.'::LogDispatch' : $type; eval "require $backend"; $@ and alert "cannot use class $backend:\n$@"; (bless {name => $name, type => $type, filters => []}, $backend) ->init(\%args); } my %format_reason = ( LOWERCASE => sub { lc $_[0] } , UPPERCASE => sub { uc $_[0] } , UCFIRST => sub { ucfirst lc $_[0] } , IGNORE => sub { '' } ); my $default_mode = 'NORMAL'; sub init($) { my ($self, $args) = @_; my $mode = $self->_set_mode(delete $args->{mode} || $default_mode); $self->{locale} = delete $args->{locale}; my $accept = delete $args->{accept} || $default_accept[$mode]; $self->{needs} = [ expand_reasons $accept ]; my $f = delete $args->{format_reason} || 'LOWERCASE'; $self->{format_reason} = ref $f eq 'CODE' ? $f : $format_reason{$f} or error __x"illegal format_reason '{format}' for dispatcher", format => $f; my $csenc; if(my $cs = delete $args->{charset}) { my $enc = find_encoding $cs or error __x"Perl does not support charset {cs}", cs => $cs; $csenc = sub { no warnings 'utf8'; $enc->encode($_[0]) }; } $self->{charset_enc} = $csenc || sub { $_[0] }; $self; } sub close() { my $self = shift; $self->{closed}++ and return undef; $self->{disabled}++; $self; } sub DESTROY { in_global_destruction or shift->close } #---------------------------- sub name {shift->{name}} sub type() {shift->{type}} sub mode() {shift->{mode}} #Please use C $MODE;> sub defaultMode($) {$default_mode = $_[1]} # only to be used via Log::Report::dispatcher(mode => ...) # because requires re-investigating collective dispatcher needs sub _set_mode($) { my $self = shift; my $mode = $self->{mode} = $modes{$_[0]}; defined $mode or panic "unknown run mode $_[0]"; $self->{needs} = [ expand_reasons $default_accept[$mode] ]; trace __x"switching to run mode {mode} for {pkg}, accept {accept}" , mode => $mode, pkg => ref $self, accept => $default_accept[$mode] unless $self->isa('Log::Report::Dispatcher::Try'); $mode; } # only to be called from Log::Report::dispatcher()!! # because requires re-investigating needs sub _disabled($) { my $self = shift; @_ ? ($self->{disabled} = shift) : $self->{disabled}; } sub isDisabled() {shift->{disabled}} sub needs(;$) { my $self = shift; return () if $self->{disabled}; my $needs = $self->{needs}; @_ or return @$needs; my $need = shift; first {$need eq $_} @$needs; } #----------- sub log($$$$) { panic "method log() must be extended per back-end"; } sub translate($$$) { my ($self, $opts, $reason, $msg) = @_; my $mode = $self->{mode}; my $code = $reason_code{$reason} or panic "unknown reason '$reason'"; my $show_loc = $always_loc{$reason} || ($mode==2 && $code >= $reason_code{WARNING}) || ($mode==3 && $code >= $reason_code{MISTAKE}); my $show_stack = $reason eq 'PANIC' || ($mode==2 && $code >= $reason_code{ALERT}) || ($mode==3 && $code >= $reason_code{ERROR}); my $locale = defined $msg->msgid ? ($opts->{locale} || $self->{locale}) # translate whole : (textdomain $msg->domain)->nativeLanguage; my $oldloc = setlocale(&LC_ALL) // ""; setlocale(&LC_ALL, $locale) if $locale && $locale ne $oldloc; my $r = $self->{format_reason}->((__$reason)->toString); my $e = $opts->{errno} ? strerror($opts->{errno}) : undef; my $format = $r && $e ? N__"{reason}: {message}; {error}" : $r ? N__"{reason}: {message}" : $e ? N__"{message}; {error}" : undef; my $text = ( defined $format ? __x($format, message => $msg->toString , reason => $r, error => $e) : $msg )->toString; $text =~ s/\n*\z/\n/; if($show_loc) { if(my $loc = $opts->{location} || $self->collectLocation) { my ($pkg, $fn, $line, $sub) = @$loc; # pkg and sub are missing when decoded by ::Die $text .= " " . __x( 'at {filename} line {line}' , filename => $fn, line => $line)->toString . "\n"; } } if($show_stack) { my $stack = $opts->{stack} ||= $self->collectStack; foreach (@$stack) { $text .= $_->[0] . " " . __x( 'at {filename} line {line}' , filename => $_->[1], line => $_->[2] )->toString . "\n"; } } setlocale(&LC_ALL, $oldloc) if $locale && $locale ne $oldloc; $self->{charset_enc}->($text); } sub collectStack($) { my ($thing, $max) = @_; my $nest = $thing->skipStack; # special trick by Perl for Carp::Heavy: adds @DB::args { package DB; # non-blank before package to avoid problem with OODoc my @stack; while(!defined $max || $max--) { my ($pkg, $fn, $linenr, $sub) = caller $nest++; defined $pkg or last; my $line = $thing->stackTraceLine(call => $sub, params => \@DB::args); push @stack, [$line, $fn, $linenr]; } \@stack; } } sub addSkipStack(@) { my $thing = shift; push @skip_stack, @_; $thing; } sub skipStack() { my $thing = shift; my $nest = 1; my $args; do { $args = [caller ++$nest] } while @$args && first {$_->($args)} @skip_stack; # do not count my own stack level in! @$args ? $nest-1 : 1; } sub collectLocation() { [caller shift->skipStack] } sub stackTraceLine(@) { my ($thing, %args) = @_; my $max = $args{max_line} ||= 500; my $abstract = $args{abstract} || 1; my $maxparams = $args{max_params} || 8; my @params = @{$args{params}}; my $call = $args{call}; my $obj = ref $params[0] && $call =~ m/^(.*\:\:)/ && UNIVERSAL::isa($params[0], $1) ? shift @params : undef; my $listtail = ''; if(@params > $maxparams) { $listtail = ', [' . (@params-$maxparams) . ' more]'; $#params = $maxparams -1; } $max -= @params * 2 - length($listtail); # \( ( \,[ ] ){n-1} \) my $calling = $thing->stackTraceCall(\%args, $abstract, $call, $obj); my @out = map $thing->stackTraceParam(\%args, $abstract, $_), @params; my $total = sum map {length $_} $calling, @out; ATTEMPT: while($total <= $max) { $abstract++; last if $abstract > 2; # later more levels foreach my $p (reverse 0..$#out) { my $old = $out[$p]; $out[$p] = $thing->stackTraceParam(\%args, $abstract, $params[$p]); $total -= length($old) - length($out[$p]); last ATTEMPT if $total <= $max; } my $old = $calling; $calling = $thing->stackTraceCall(\%args, $abstract, $call, $obj); $total -= length($old) - length($calling); } $calling .'(' . join(', ',@out) . $listtail . ')'; } # 1: My::Object(0x123141, "my string") # 2: My::Object=HASH(0x1231451) # 3: My::Object("my string") # 4: My::Object() # sub stackTraceCall($$$;$) { my ($thing, $args, $abstract, $call, $obj) = @_; if(defined $obj) # object oriented { my ($pkg, $method) = $call =~ m/^(.*\:\:)(.*)/; return overload::StrVal($obj) . '->' . $call; } else # imperative { return $call; } } sub stackTraceParam($$$) { my ($thing, $args, $abstract, $param) = @_; defined $param or return 'undef'; $param = overload::StrVal($param) if ref $param; return $param # int or float if $param =~ /^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[eE][+-]?\d+)?$/; my $escaped = escape_chars $param; if(length $escaped > 80) { $escaped = substr($escaped, 0, 30) . '...['. (length($escaped) -80) .' chars more]...' . substr($escaped, -30); } qq{"$escaped"}; } #------------ 1; Log-Report-1.18/lib/Log/Report/Die.pod0000644000175000001440000000407213002344342020120 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 This module is used internally, to translate output of 'die' and Carp functions into L objects. =head1 FUNCTIONS =over 4 =item B(STRING, %options) The STRING is the content of C<$@> after an eval() caught a die(). croak(), or confess(). This routine tries to convert this into parameters for L. This is done in a very smart way, even trying to find the stringifications of C<$!>. 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 -Option--Default on_die 'ERROR' =over 2 =item on_die => REASON =back =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report/Domain.pm0000644000175000001440000000745313002344341020465 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use warnings; use strict; package Log::Report::Domain; use vars '$VERSION'; $VERSION = '1.18'; use base 'Log::Report::Minimal::Domain'; use Log::Report 'log-report'; use Log::Report::Util qw/parse_locale/; use Scalar::Util qw/blessed/; use Log::Report::Translator; sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $self->{LRD_ctxt_def} = {}; $self; } #---------------- sub nativeLanguage() {shift->{LRD_native}} sub translator() {shift->{LRD_transl}} sub contextRules() {shift->{LRD_ctxt_rules}} #---------------- sub configure(%) { my ($self, %args) = @_; if(my $config = delete $args{config}) { my $set = $self->readConfig($config); %args = (%$set, %args); } # 'formatter' is handled by the base-class, but documented here. $self->SUPER::configure(%args); my $transl = $args{translator} || Log::Report::Translator->new; $transl = Log::Report::Translator->new(%$transl) if ref $transl eq 'HASH'; !blessed $transl || $transl->isa('Log::Report::Translator') or panic "translator must be a Log::Report::Translator object"; $self->{LRD_transl} = $transl; my $native = $self->{LRD_native} = $args{native_language} || 'en_US'; my ($lang) = parse_locale $native; defined $lang or error __x"the native_language '{locale}' is not a valid locale" , locale => $native; if(my $cr = $args{context_rules}) { my $tc = 'Log::Report::Translator::Context'; eval "require $tc"; panic $@ if $@; if(blessed $cr) { $cr->isa($tc) or panic "context_rules must be a $tc" } elsif(ref $cr eq 'HASH') { $cr = Log::Report::Translator::Context->new(rules => $cr) } else { panic "context_rules expects object or hash, not {have}", have=>$cr; } $self->{LRD_ctxt_rules} = $cr; } $self; } sub setContext(@) { my $self = shift; my $cr = $self->contextRules # ignore context if no rules given or error __x"you need to configure context_rules before setContext"; $self->{LRD_ctxt_def} = $cr->needDecode(set => @_); } sub updateContext(@) { my $self = shift; my $cr = $self->contextRules # ignore context if no rules given or return; my $rules = $cr->needDecode(update => @_); my $r = $self->{LRD_ctxt_def} ||= {}; @{$r}{keys %$r} = values %$r; $r; } sub defaultContext() { shift->{LRD_ctxt_def} } sub readConfig($) { my ($self, $fn) = @_; my $config; if($fn =~ m/\.pl$/i) { $config = do $fn; } elsif($fn =~ m/\.json$/i) { eval "require JSON"; panic $@ if $@; open my($fh), '<:encoding(utf8)', $fn or fault __x"cannot open JSON file for context at {fn}" , fn => $fn; local $/; $config = JSON->utf8->decode(<$fh>); } else { error __x"unsupported context file type for {fn}", fn => $fn; } $config; } #------------------- sub translate($$) { my ($self, $msg, $lang) = @_; my ($msgid, $msgctxt); if(my $rules = $self->contextRules) { ($msgid, $msgctxt) = $rules->ctxtFor($msg, $lang, $self->defaultContext); } else { $msgid = $msg->msgid; 1 while $msgid =~ s/\{([^}]*)\<\w+([^}]*)\}/length "$1$2" ? "{$1$2}" : ''/e; } # This is ugly, horrible and worse... but I do not want to mutulate # the message neither to clone it. We do need to get rit of {<} local $msg->{_msgid} = $msgid; my $tr = $self->translator || $self->configure->translator; $tr->translate($msg, $lang, $msgctxt) || $msgid; } 1; __END__ Log-Report-1.18/lib/Log/Report/Dispatcher.pod0000644000175000001440000003206013002344342021503 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Dispatcher - manage message dispatching, display or logging =head1 INHERITANCE Log::Report::Dispatcher is extended by Log::Report::Dispatcher::Callback Log::Report::Dispatcher::File Log::Report::Dispatcher::Log4perl Log::Report::Dispatcher::LogDispatch Log::Report::Dispatcher::Perl Log::Report::Dispatcher::Syslog Log::Report::Dispatcher::Try =head1 SYNOPSIS use Log::Report; # The following will be created for you automatically dispatcher 'PERL', 'default', accept => 'NOTICE-'; dispatcher close => 'default'; # after deamonize dispatcher 'FILE', 'log' , mode => 'DEBUG', to => '/var/log/mydir/myfile'; # Full package name is used, same as 'FILE' dispatcher Log::Report::Dispatch::File => 'stderr' , to => \*STDERR, accept => 'NOTICE-'; =head1 DESCRIPTION In L, dispatchers are used to handle (exception) messages which are created somewhere else. Those message were produced (thrown) by L and friends. This base-class handles the creation of dispatchers, plus the common filtering rules. See the L section, below. =head1 METHODS =head2 Constructors =over 4 =item $obj-EB() Terminate the dispatcher activities. The dispatcher gets disabled, to avoid the case that it is accidentally used. Returns C (false) if the dispatcher was already closed. =item Log::Report::Dispatcher-EB($type, $name, %options) Create a dispatcher. The $type of back-end to start is required, and listed in the L part of this manual-page. For various external back-ends, special wrappers are created. The $name must be uniquely identifying this dispatcher. When a second dispatcher is created (via L) with the name of an existing dispatcher, the existing one will get replaced. All %options which are not consumed by this base constructor are passed to the wrapped back-end. Some of them will check whether all %options are understood, other ignore unknown %options. -Option --Default accept depend on mode charset format_reason 'LOWERCASE' locale mode 'NORMAL' =over 2 =item accept => REASONS See L for possible values. If the initial mode for this dispatcher does not need verbose or debug information, then those levels will not be accepted. When the mode equals "NORMAL" (the default) then C's default is C. In case of "VERBOSE"> it will be C, C results in C, and "DEBUG" in C. =item charset => CHARSET Convert the messages in the specified character-set (codeset). By default, no conversion will take place, because the right choice cannot be determined automatically. =item format_reason => 'UPPERCASE'|'LOWERCASE'|'UCFIRST'|'IGNORE'|CODE How to show the reason text which is printed before the message. When a CODE is specified, it will be called with a translated text and the returned text is used. =item locale => LOCALE Overrules the global setting. Can be overruled by L. =item mode => 'NORMAL'|'VERBOSE'|'ASSERT'|'DEBUG'|0..3 Possible values are C (or C<0> or C), which will not show C or debug messages, C (C<1>; shows C not debug), C (C<2>; only ignores C messages), or C (C<3>) which shows everything. See section L. You are advised to use the symbolic mode names when the mode is changed within your program: the numerical values are available for smooth Getopt::Long integration. =back =back =head2 Accessors =over 4 =item $obj-EB() =item $obj-EB() Returns the mode in use for the dispatcher as number. See L and L. =item $obj-EB() Returns the unique name of this dispatcher. =item $obj-EB( [$reason] ) Returns the list with all REASONS which are needed to fulfill this dispatcher's needs. When disabled, the list is empty, but not forgotten. [0.999] when only one $reason is specified, it is returned if in the list. =item $obj-EB() The dispatcher $type, which is usually the same as the class of this object, but not in case of wrappers like for Log::Dispatch. =back =head2 Logging =over 4 =item $obj-EB(@CODE) =item Log::Report::Dispatcher-EB(@CODE) [1.13] Add one or more CODE blocks of caller lines which should not be collected for stack-traces or location display. A CODE gets called with an ARRAY of caller information, and returns true when that line should get skipped. B this logic is applied globally: on all dispatchers. example: By default, all lines in the Log::Report packages are skipped from display, with a simple CODE as this: sub in_lr { $_[0][0] =~ m/^Log\:\:Report(?:\:\:|$)/ } Log::Report::Dispatcher->addSkipStack(\&in_lr); The only parameter to in_lr is the return of caller(). The first element of that ARRAY is the package name of a stack line. =item $obj-EB() =item Log::Report::Dispatcher-EB() Collect the information to be displayed as line where the error occurred. =item $obj-EB( [$maxdepth] ) =item Log::Report::Dispatcher-EB( [$maxdepth] ) Returns an ARRAY of ARRAYs with text, filename, line-number. =item $obj-EB(HASH-$of-%options, $reason, $message, $domain) This method is called by L and should not be called directly. Internally, it will call L, which does most $of the work. =item $obj-EB() [1.13] Returns the number of nestings in the stack which should be skipped to get outside the Log::Report (and related) modules. The end-user does not want to see those internals in stack-traces. =item $obj-EB(%options) =item Log::Report::Dispatcher-EB(%options) -Option --Default abstract 1 call filename linenr max_line undef max_params 8 package params =over 2 =item abstract => INTEGER The higher the abstraction value, the less details are given about the caller. The minimum abstraction is specified, and then increased internally to make the line fit within the C margin. =item call => STRING =item filename => STRING =item linenr => INTEGER =item max_line => INTEGER =item max_params => INTEGER =item package => CLASS =item params => ARRAY =back =item $obj-EB(HASH-$of-%options, $reason, $message) See L, which describes the actions taken by this method. A string is returned, which ends on a new-line, and may be multi-line (in case a stack trace is produced). =back =head1 DETAILS =head2 Available back-ends When a dispatcher is created (via L or L), you must specify the TYPE of the dispatcher. This can either be a class name, which extends a L, or a pre-defined abbreviation of a class name. Implemented are: =over 4 =item L (abbreviation 'PERL') Use Perl's own C, C and C to ventilate reports. This is the default dispatcher. =item L (abbreviation 'FILE') Logs the message into a file, which can either be opened by the class or be opened before the dispatcher is created. =item L (abbreviation 'SYSLOG') Send messages into the system's syslog infrastructure, using Sys::Syslog. =item L (abbreviation 'CALLBACK') Calls any CODE reference on receipt of each selected message, for instance to send important message as email or SMS. =item C All of the Log::Dispatch::Output extensions can be used directly. The L will wrap around that back-end. =item C Use the Log::Log4perl main object to write to dispatchers. This infrastructure uses a configuration file. =item L (abbreviation 'TRY') Used by function L. It collects the exceptions and can produce them on request. =back =head2 Processing the message =head3 Addition information The modules which use C will only specify the base of the message string. The base dispatcher and the back-ends will extend this message with additional information: =over 4 =item . the reason =item . the filename/line-number where the problem appeared =item . the filename/line-number where it problem was reported =item . the error text in C<$!> =item . a stack-trace =item . a trailing new-line =back When the message is a translatable object (L, for instance created with L), then the added components will get translated as well. Otherwise, all will be in English. Exactly what will be added depends on the actual mode of the dispatcher (change it with L, initiate it with L). mode mode mode mode REASON SOURCE TE! NORM VERB ASSE DEBUG trace program ... S assert program ... SL SL info program T.. S S S notice program T.. S S S S mistake user T.. S S S SL warning program T.. S S SL SL error user TE. S S SL SC fault system TE! S S SL SC alert system T.! SL SL SC SC failure system TE! SL SL SC SC panic program .E. SC SC SC SC T - usually translated E - exception (execution interrupted) ! - will include $! text at display L - include filename and linenumber S - show/print when accepted C - stack trace (like Carp::confess()) =head3 Filters With a filter, you can block or modify specific messages before translation. There may be a wish to change the REASON of a report or its content. It is not possible to avoid the exit which is related to the original message, because a module's flow depends on it to happen. When there are filters defined, they will be called in order of definition. For each of the dispatchers which are called for a certain REASON (which C that REASON), it is checked whether its name is listed for the filter (when no names where specified, then the filter is applied to all dispatchers). When selected, the filter's CODE reference is called with four arguments: the dispatcher object (a L), the HASH-of-OPTIONS passed as optional first argument to L, the REASON, and the MESSAGE. Returned is the new REASON and MESSAGE. When the returned REASON is C, then the message will be ignored for that dispatcher. Be warned about processing the MESSAGE: it is a L object which may have a C string and C string or object. When the call to L contained multiple comma-separated components, these will already have been joined together using concatenation (see L. B<. Example: a filter on syslog> dispatcher filter => \&myfilter, 'syslog'; # ignore all translatable and non-translatable messages containing # the word "skip" sub myfilter($$$$) { my ($disp, $opts, $reason, $message) = @_; return () if $message->untranslated =~ m/\bskip\b/; ($reason, $message); } B<. Example: take all mistakes and warnings serious> dispatch filter => \&take_warns_seriously; sub take_warns_seriously($$$$) { my ($disp, $opts, $reason, $message) = @_; $reason eq 'MISTAKE' ? (ERROR => $message) : $reason eq 'WARNING' ? (FAULT => $message) : ($reason => $message); } =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report.pod0000644000175000001440000012115213002344342017416 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' to get trace and verbose messages use Log::Report mode => 'DEBUG'; # Usually invoked with a domain, which groups packages use Log::Report 'my-domain', %options; # Interpolation syntax via String::Print # First step to translations, once you need it. print __x"my name is {name}", name => $n; # print, so no exception print __"Hello World\n"; # (optional) translation, no interpolation print __x'Hello World'; # SYNTAX ERROR!! ' is alternative for :: # Functions replacing die/warn/carp, casting exceptions. error "oops"; # exception like die(), no translation -f $config or panic "Help!"; # alert/error/fault/info/...more # Combined exception, interpolation, and optional translation error __x"Help!"; # __x() creates ::Message object error __x('gettext msgid', param => $value, ...) if $condition; # Also non fatal "exceptions" find their way to dispatchers info __x"started {pid}", pid => $$; # translatable debug "$i was here!"; # you probably do not want to translate debug panic "arrghhh"; # like Carp::Confess # Many destinations for an exception message (may exist in parallel) dispatcher PERL => 'default' # see Log::Report::Dispatcher: use die/warn , reasons => 'NOTICE-'; # this dispatcher is already present at start dispatcher SYSLOG => 'syslog'# also send to syslog , charset => 'iso-8859-1' # explicit character conversions , locale => 'en_US'; # overrule user's locale dispatcher close => 'default'; # stop default die/warn dispatcher # Fill-in values, like Locale::TextDomain and gettext # See Log::Report::Message section DETAILS fault __x"cannot allocate {size} bytes", size => $size; fault "cannot allocate $size bytes"; # no translation, ok fault __x"cannot allocate $size bytes"; # not translatable, wrong # Translation depending on count # Leading and trailing whitespace stay magically outside translation # tables. @files in scalar context. Special parameter with _ print __xn"found one file\n", "found {_count} files", @files; # Borrow from an other text-domain (see Log::Report::Message) print __x(+"errors in {line}", _domain => 'global', line => $line); # catch errors (implements hidden eval/die) try { error }; if($@) {...} # $@ isa Log::Report::Dispatcher::Try if(my $exception = $@->wasFatal) # ::Exception object # Language translations at the output component # Translation management via Log::Report::Lexicon use POSIX::1003::Locale qw/setlocale LC_ALL/; setlocale(LC_ALL, 'nl_NL'); info __"Hello World!"; # in Dutch, if translation table found # Exception classes, see Log::Report::Exception try { error __x"something", _class => 'parsing,schema' }; if($@->wasFatal->inClass('parsing')) ... =head1 DESCRIPTION Get messages to users and logs. C combines three tasks which are closely related in one: =over 4 =item . logging (like L and syslog), and =item . exceptions (like error and info), with =item . translations (like C and L) =back You B to use this module for all three reasons: pick what you need now, maybe extend the usage later. Read more about how and why in the L section, below. Especially, you should B. Also, you can study this module swiftly via the article published in the German Perl C<$foo-magazine>. English version: F =head1 FUNCTIONS =head2 Report Production and Configuration =over 4 =item B( <$type, $name, %options>|<$command, @names> ) The C function controls access to dispatchers: the back-ends which process messages, do the logging. Dispatchers are global entities, addressed by a symbolic $name. Please read L as well. The C suite has its own dispatcher @types, but also connects to external dispatching frameworks. Each need some (minor) conversions, especially with respect to translation of REASONS of the reports into log-levels as the back-end understands. [1.10] When you open a dispatcher with a $name which is already in use, that existing dispatcher gets closed. Except when you have given an 'dispatcher "do-not-reopen"' earlier, in which case the first object stays alive, and the second attempt ignored. [1.11] The automatically created default dispatcher will get replaced, even when this option is given, by another dispatcher which is named 'default'. The %options are a mixture of parameters needed for the Log::Report dispatcher wrapper and the settings of the back-end. See L, the documentation for the back-end specific wrappers, and the back-ends for more details. Implemented COMMANDs are C, C, C, C, C, C, C, C, C, and C. Most commands are followed by a LIST of dispatcher @names to be addressed. For C see section L; it requires a MODE argument before the LIST of NAMEs. Non-existing names will be ignored. When C is specified, then all existing dispatchers will get addressed. For C see L; it requires a CODE reference before the @names of the dispatchers which will have the it applied (defaults to all). With C, you only provide a REASON: it will return the list of dispatchers which need to be called in case of a message with the REASON is triggered. The C [1.09] returns the closest surrounding exception catcher, a L object. For both the creation as COMMANDs version of this method, all objects involved are returned as LIST, non-existing ones skipped. In SCALAR context with only one name, the one object is returned. example: play with dispatchers dispatcher Log::Dispatcher::File => mylog => , accept => 'MISTAKE-' # for wrapper , locale => 'pt_BR' # other language , filename => 'logfile'; # for back-end dispatcher close => 'mylog'; # cleanup my $obj = dispatcher find => 'mylog'; my @obj = dispatcher 'list'; dispatcher disable => 'syslog'; dispatcher enable => 'mylog', 'syslog'; # more at a time dispatcher mode => 'DEBUG', 'mylog'; dispatcher mode => 'DEBUG', 'ALL'; my $catcher = dispatcher 'active-try'; dispatcher 'do-not-reopen'; my @need_info = dispatcher needs => 'INFO'; if(dispatcher needs => 'INFO') ... # anyone needs INFO # Getopt::Long integration: see Log::Report::Dispatcher::mode() dispatcher PERL => 'default', mode => 'DEBUG', accept => 'ALL' if $debug; =item B( [%options], $reason, $message|, ) The C function is sending (for some $reason) a $message to be displayed or logged (by a `dispatcher'). This function is the core for L, L etc functions, which are nicer names for this exception throwing: better use those short names. The $reason is a string like 'ERROR' (for function C). The $message is a L object (which are created with the special translation syntax like L<__x()|Log::Report/"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 optional %options are listed below. Quite differently from other functions and methods, they have to be passed in a HASH as first parameter. This function returns the LIST of dispatchers which accepted the $message. When empty, no back-end has accepted it so the $message was "lost". Even when no back-end needs the message, the program will still exit when there is a $reason to C. -Option --Default errno $! or 1 is_fatal locale undef location undef stack undef to undef =over 2 =item errno => INTEGER When the $reason includes the error text (See L), you can overrule the error code kept in C<$!>. In other cases, the return code defaults to C<1> (historical UNIX behavior). When the message $reason (combined with the run-mode) is severe enough to stop the program, this value as return code of the program. The use of this option itself will not trigger an C. =item is_fatal => BOOLEAN Some logged exceptions are fatal, other aren't. The default usually is correct. However, you may want an error to be caught (usually with L), redispatch it to syslog, but without it killing the main program. =item locale => LOCALE Use this specific locale, in stead of the user's preference. =item location => STRING When defined, this location is used in the display. Otherwise, it is determined automatically if needed. An empty string will disable any attempt to display this line. =item stack => ARRAY When defined, that data is used to display the call stack. Otherwise, it is collected via C if needed. =item to => NAME|ARRAY-of-NAMEs Sent the $message only to the NAMEd dispatchers. Ignore unknown NAMEs. Still, the dispatcher needs to be enabled and accept the REASONs. =back example: for use of L # long syntax example report TRACE => "start processing now"; report INFO => '500: ' . __'Internal Server Error'; # explicit dispatcher, no translation report {to => 'syslog'}, NOTICE => "started process $$"; notice "started process $$", _to => 'syslog'; # same # short syntax examples trace "start processing now"; warning __x'Disk {percent%.2f}% full', percent => $p if $p > 97; # error message, overruled to be printed in Brazilian report {locale => 'pt_BR'} , WARNING => "do this at home!"; =item B(CODE, %options) Execute the CODE while blocking all dispatchers as long as it is running. The exceptions which occur while running the CODE are caught until it has finished. When there where no fatal errors, the result of the CODE execution is returned. After the CODE was tried, the C<$@> will contain a L object, which contains the collected messages. 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( [$level,][$domain,] %options ) The import is automatically called when the package is compiled. For all packages but one in your distribution, it will only contain the name of the $domain. For one package, the import list may additionally contain textdomain configuration %options. These %options are used for all packages which use the same $domain. These are alternatives: # Do not use variables in the %*config! They are not yet initialized # when Log::Report->import is run!!! use Log::Report 'my-domain', %config, %domain_config; use Log::Report 'my-domain', %config; textdomain 'my-domain', %domain_config; # vars allowed The latter syntax has major advantages, when the configuration of the domain is determined at run-time. It is probably also easier to understand. See L, for the B for the domain configuration. Here, we only list the options which are related to the normal import behavior. The export $level is a plus (+) followed by a number, for instance C<+1>, to indicate to on which caller level we need to work. This is used in L. It defaults to '0': my direct caller. -Option --Default import undef message_class Log::Report::Message mode 'NORMAL' syntax 'SHORT' =over 2 =item import => FUNCTION|ARRAY [0.998] When not specified, the C option determines the list of functions which are being exported. With this option, the C option is ignored and only the specified FUNCTION(s) are imported. =item message_class => CLASS [1.08] Use a more powerful message object class, for instance because your messages need extra attributes. The provided CLASS must extend L =item mode => LEVEL This sets the default mode for all created dispatchers. You can also selectively change the output mode, like dispatcher PERL => 'default', mode => 3 =item syntax => 'REPORT'|'SHORT'|'LONG' The SHORT syntax will add the report abbreviations (like function L) to your name-space. Otherwise, each message must be produced with L. C is an alternative to C: both do not polute your namespace with the useful abbrev functions. =back example: of import use Log::Report mode => 3; # '3' or 'DEBUG' use Log::Report 'my-domain'; # in each package producing messages use Log::Report 'my-domain' # in one package, top of distr , mode => 'VERBOSE' , syntax => 'REPORT' # report ERROR, not error() , translator => Log::Report::Translator::POT->new ( lexicon => '/home/mine/locale' # bindtextdomain , charset => 'UTF-8' # codeset ) , native_language => 'nl_NL'; # untranslated msgs are Dutch use Log::Report import => 'try'; # or ARRAY of functions =item B( <[$domain], $config> | <$domain, 'DELETE'> ) [1.00] Without CONFIGuration, this returns the L object which administers the $domain, by default the domain effictive in the scope of the package. A very special case is for "DELETE", which will remove the domain configuration. =back =head2 Reasons =over 4 =item Log::Report-EB( $reason, [$reasons] ) Returns true when the reporter needs any of the $reasons, when any of the active dispatchers is collecting messages in the specified level. This is useful when the processing of data for the message is relatively expensive, but for instance only required in debug mode. example: if(Log::Report->needs('TRACE')) { my @args = ...expensive calculation...; trace "your options are: @args"; } =back =head1 DETAILS =head2 Introduction Getting messages to users and logs. The distincting concept of this module, is that three tasks which are strongly related are merged into one simple syntax. The three tasks: =over 4 =item produce some text on a certain condition, =item translate it to the proper language, and =item deliver it in some way to a user. =back Text messages in Perl are produced by commands like C, C, C, C, or C. But where is that output directed to? Translations is hard. There is no clean exception mechanism. Besides, the C/C/C together produce only three different output "levels" with a message. Think of the variation syslog offers: more than 7 levels. Many people manually implement their own tricks to get additional levels, like verbose and debug flags. Log::Report offers that variety. The (optional) translations use the beautiful syntax defined by Locale::TextDomain, with some own extensions (of course). A very important difference is that translations are delayed till the delivery step: until a dispatcher actually writes your message into a file, sends it to syslog, or shows it on the screen. This means that the pop-up in the graphical interface of the user may show the text in the language of the user --say Chinese in utf8--, but at the same time syslog may write the latin1 English version of the same message. =head2 Background ideas The following ideas are the base of this implementation: =over 4 =item . simplification Handling errors and warnings is probably the most labor-intensive task for a programmer: when programs are written correctly, up-to three-quarters of the code is related to testing, reporting, and handling (problem) conditions. Simplifying the way to create reports, simplifies programming and maintenance. =item . multiple dispatchers It is not the location where the (for instance) error occurs which determines what will happen with the text, but the main application which uses the the complaining module has control. Messages have a reason. Based on the `reason' classification, they can get ignored, send to one or multiple dispatchers, like Log::Dispatch, Log::Log4perl, or UNIX syslog. =item . delayed translations The background ideas are that of Locale::TextDomain, based on C. However, in the C infrastructure, translations are postponed until the text is dispatched to a screen or log-file; the same report can be sent to syslog in (for instance) English and to the user interface in Dutch. =item . context sensitive Using contexts, you can set-up how to translate or rewrite messages, to improve messages. A typical problem is whether to use gender in text (use 'his' or 'her'): you can set a gender in a context, and the use translation tables to pick the right one. =back =head2 Error handling models There are two approaches to handling errors and warnings. In the first approach, as produced by C, C and the C family of commands, the program handles the problem immediately on the location where the problem appears. In the second approach, an I is thrown on the spot where the problem is created, and then somewhere else in the program the condition is handled. The implementation of exceptions in Perl5 is done with a eval-die pair: on the spot where the problem occurs, C is called. But, because of the execution of that routine is placed within an C, the program as a whole will not die, just the execution of a part of the program will seize. However, what if the condition which caused the routine to die is solvable on a higher level? Or what if the user of the code doesn't bother that a part fails, because it has implemented alternatives for that situation? Exception handling is quite clumsy in Perl5. The C set of distributions let modules concentrate on the program flow, and let the main program decide on the report handling model. The infrastructure to translate messages into multiple languages, whether to create exceptions or carp/die, to collect longer explanations with the messages, to log to mail or syslog, and so on, is decided in pluggable back-ends. =head3 The Reason for the report Traditionally, perl has a very simple view on error reports: you either have a warning or an error. However, it would be much clearer for user's and module-using applications, when a distinction is made between various causes. For instance, a configuration error is quite different from a disk-full situation. In C, the produced reports in the code tell I is wrong. The main application defines loggers, which interpret the cause into (syslog) levels. Defined by C are =over 4 =item . trace (debug, program) The message will be used when some logger has debugging enabled. The messages show steps taken by the program, which are of interest by the developers and maintainers of the code, but not for end-users. =item . assert (program) Shows an unexpected condition, but continues to run. When you want the program to abort in such situation, that use C. =item . info (verbose, program) These messages show larger steps in the execution of the program. Experienced users of the program usually do not want to see all these intermediate steps. Most programs will display info messages (and higher) when some C flag is given on the command-line. =item . notice (program) An user may need to be aware of the program's accidental smart behavior, for instance, that it initializes a lasting C directory in your home directory. Notices should be sparse. =item . warning (program) The program encountered some problems, but was able to work around it by smart behavior. For instance, the program does not understand a line from a log-file, but simply skips the line. =item . mistake (user) When a user does something wrong, but what is correctable by smart behavior of the program. For instance, in some configuration file, you can fill-in "yes" or "no", but the user wrote "yeah". The program interprets this as "yes", producing a mistake message as warning. It is much nicer to tell someone that he/she made a mistake, than to call that an error. =item . error (user) The user did something wrong, which is not automatically correctable or the program is not willing to correct it automatically for reasons of code quality. For instance, an unknown option flag is given on the command-line. These are configuration issues, and have no useful value in C<$!>. The program will be stopped, usually before taken off. =item . fault (system) The program encountered a situation where it has no work-around. For instance, a file cannot be opened to be written. The cause of that problem can be some user error (i.e. wrong filename), or external (you accidentally removed a directory yesterday). In any case, the C<$!> (C<$ERRNO>) variable is set here. =item . alert (system) Some external cause disturbs the execution of the program, but the program stays alive and will try to continue operation. For instance, the connection to the database is lost. After a few attempts, the database can be reached and the program continues as if nothing happened. The cause is external, so C<$!> is set. Usually, a system administrator needs to be informed about the problem. =item . failure (system) Some external cause makes it impossible for this program to continue. C<$!> is set, and usually the system administrator wants to be informed. The program will die. The difference with C is subtile and not always clear. A fault reports an error returned by an operating system call, where the failure would report an operational problem, like a failing mount. =item . panic (program) All above report classes are expected: some predictable situation is encountered, and therefore a message is produced. However, programs often do some internal checking. Of course, these conditions should never be triggered, but if they do... then we can only stop. For instance, in an OO perl module, the base class requires all sub-classes to implement a certain method. The base class will produce a stub method with triggers a panic when called. The non-dieing version of this test C. =back I or being C are run-time behaviors, and have nothing directly to do with the type of message which is produced. These two are B which can be set on the dispatchers: one dispatcher may be more verbose that some other. On purpose, we do not use the terms C or C, because the dispatcher can be configured what to do in cause of which condition. For instance, it may decide to stop execution on warnings as well. The terms C and C are avoided, because the program cause versus user cause distinction (warn vs carp) is reflected in the use of different reasons. There is no need for C and C either, because the dispatcher can be configured to produce stack-trace information (for a limited sub-set of dispatchers) =head3 Report levels Various frameworks used with perl programs define different labels to indicate the reason for the message to be produced. Perl5 Log::Dispatch Syslog Log4Perl Log::Report print 0,debug debug debug trace print 0,debug debug debug assert print 1,info info info info warn\n 2,notice notice info notice warn 3,warning warn warn mistake carp 3,warning warn warn warning die\n 4,error err error error die 5,critical crit fatal fault croak 6,alert alert fatal alert croak 7,emergency emerg fatal failure confess 7,emergency emerg fatal panic =head3 Run modes The run-mode change which messages are passed to a dispatcher, but from a different angle than the dispatch filters; the mode changes behavioral aspects of the messages, which are described in detail in L. However, it should behave as you expect: the DEBUG mode shows more than the VERBOSE mode, and both show more than the NORMAL mode. B<. Example: extract run mode from Getopt::Long> The C function will count the number of C options on the command-line when a C<+> is after the option name. use Log::Report; use Getopt::Long qw(:config no_ignore_case bundling); my $mode; # defaults to NORMAL GetOptions 'v+' => \$mode , 'verbose=i' => \$mode , 'mode=s' => \$mode or exit 1; dispatcher 'PERL', 'default', mode => $mode; Now, C<-vv> will set C<$mode> to C<2>, as will C<--verbose 2> and C<--verbose=2> and C<--mode=ASSERT>. Of course, you do not need to provide all these options to the user: make a choice. B<. Example: the mode of a dispatcher> my $mode = dispatcher(find => 'myname')->mode; B<. Example: run-time change mode of a dispatcher> To change the running mode of the dispatcher, you can do dispatcher mode => DEBUG => 'myname'; However, be warned that this does not change the types of messages accepted by the dispatcher! So: probably you will not receive the trace, assert, and info messages after all. So, probably you need to replace the dispatcher with a new one with the same name: dispatcher FILE => 'myname', to => ..., mode => 'DEBUG'; This may reopen connections (depends on the actual dispatcher), which might be not what you wish to happened. In that case, you must take the following approach: # at the start of your program dispatcher FILE => 'myname', to => ... , accept => 'ALL'; # overrule the default 'NOTICE-' !! # now it works dispatcher mode => DEBUG => 'myname'; # debugging on ... dispatcher mode => NORMAL => 'myname'; # debugging off Of course, this comes with a small overall performance penalty. =head3 Exceptions The simple view on live says: you 're dead when you die. However, more complex situations try to revive the dead. Typically, the "die" is considered a terminating exception, but not terminating the whole program, but only some logical block. Of course, a wrapper round that block must decide what to do with these emerging problems. Java-like languages do not "die" but throw exceptions which contain the information about what went wrong. Perl modules like C simulate this. It's a hassle to create exception class objects for each emerging problem, and the same amount of work to walk through all the options. Log::Report follows a simpler scheme. Fatal messages will "die", which is caught with "eval", just the Perl way (used invisible to you). However, the wrapper gets its hands on the message as the user has specified it: untranslated, with all unprocessed parameters still at hand. try { fault __x "cannot open file {file}", file => $fn }; if($@) # is Log::Report::Dispatcher::Try { my $cause = $@->wasFatal; # is Log::Report::Exception $cause->throw if $cause->message->msgid =~ m/ open /; # all other problems ignored } See L and L. =head2 Comparison =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; # can be left-out when there is no debug/verbose dispatcher PERL => 'default', mode => 'DEBUG'; my $dir = '/etc'; File::Spec->file_name is_absolute($dir) or mistake "directory name must be absolute"; -d $dir or panic "what platform are you on?"; until(opendir DIR, $dir) { alert "cannot read system directory $dir"; sleep 60; } info "Processing directory $dir"; while(defined(my $file = readdir DIR)) { if($file =~ m/\.bak$/) { notice "found backup file $dir/$f"; next; } assert "file $dir/$file is binary" if -B "$dir/$file"; trace "processing file $dir/$file"; unless(open FILE, "<", "$dir/$file") { error "no permission to read from $dir/$f" if $!==ENOPERM; fault "unable to read from $dir/$f"; } close FILE or failure "read errors in $dir/$file"; } A lot of things are quite visibly different, and there are a few smaller changes. There is no need for a new-line after the text of the message. When applicable (error about system problem), then the C<$!> is added automatically. =head3 Log::Dispatch and Log::Log4perl The two major logging frameworks for Perl are Log::Dispatch and Log::Log4perl; both provide a pluggable logging interface. Both frameworks do not have (gettext or maketext) language translation support, which has various consequences. When you wish for to report in some other language, it must be translated before the logging function is called. This may mean that an error message is produced in Chinese, and therefore also ends-up in the syslog file in Chinese. When this is not your language, you have a problem. Log::Report translates only in the back-end, which means that the user may get the message in Chinese, but you get your report in your beloved Dutch. When no dispatcher needs to report the message, then no time is lost in translating. With both logging frameworks, you use terminology comparable to syslog: the module programmer determines the seriousness of the error message, not the application which integrates multiple modules. This is the way perl programs usually work, but often the cause for inconsequent user interaction. =head3 Locale::gettext and Locate::TextDomain Both on GNU gettext based implementations can be used as translation frameworks. Locale::TextDomain syntax is supported, with quite some extensions. Read the excellent documentation of Locale::Textdomain. Only the tried access via C<$__> and C<%__> are not supported. The main difference with these modules is the moment when the translation takes place. In Locale::TextDomain, an C<__x()> will result in an immediate translation request via C. C's version of C<__x()> will only capture what needs to be translated in an object. When the object is used in a print statement, only then the translation will take place. This is needed to offer ways to send different translations of the message to different destinations. To be able to postpone translation, objects are returned which stringify into the translated text. =head1 DIAGNOSTICS =over 4 =item Error: in SCALAR context, only one dispatcher name accepted The L method returns the L objects which it has accessed. When multiple names where given, it wishes to return a LIST of objects, not the count of them. =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Log/Report.pm0000644000175000001440000003417113002344341017253 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use warnings; use strict; package Log::Report; use vars '$VERSION'; $VERSION = '1.18'; use base 'Exporter'; use List::Util qw/first/; use Scalar::Util qw/blessed/; use Log::Report::Util; my $lrm = 'Log::Report::Message'; ### if you change anything here, you also have to change Log::Report::Minimal my @make_msg = qw/__ __x __n __nx __xn N__ N__n N__w/; my @functions = qw/report dispatcher try textdomain/; my @reason_functions = qw/trace assert info notice warning mistake error fault alert failure panic/; our @EXPORT_OK = (@make_msg, @functions, @reason_functions); sub _whats_needed(); sub dispatcher($@); sub textdomain(@); sub trace(@); sub assert(@); sub info(@); sub notice(@); sub warning(@); sub mistake(@); sub error(@); sub fault(@); sub alert(@); sub failure(@); sub panic(@); sub __($); sub __x($@); sub __n($$$@); sub __nx($$$@); sub __xn($$$@); sub N__($); sub N__n($$); sub N__w(@); # # Some initiations # my $reporter = {}; my $default_mode = 0; my @nested_tries; # we can only load these after Log::Report has compiled, because # the use this module themselves. require Log::Report::Die; require Log::Report::Domain; require Log::Report::Message; require Log::Report::Exception; require Log::Report::Dispatcher; require Log::Report::Dispatcher::Try; #eval "require Log::Report::Translator::POT"; panic $@ if $@; #, translator => Log::Report::Translator::POT->new(charset => 'utf-8'); textdomain 'log-report'; my $default_dispatcher = dispatcher PERL => 'default', accept => 'NOTICE-'; sub report($@) { my $opts = ref $_[0] eq 'HASH' ? +{ %{ (shift) } } : {}; my $reason = shift; my $stop = exists $opts->{is_fatal} ? $opts->{is_fatal} : is_fatal $reason; my @disp; if(defined(my $try = $nested_tries[-1])) { push @disp, @{$reporter->{needs}{$reason}||[]} unless $stop || $try->hides($reason); push @disp, $try if $try->needs($reason); } else { @disp = @{$reporter->{needs}{$reason} || []}; } is_reason $reason or error __x"token '{token}' not recognized as reason", token=>$reason; # return when no-one needs it: skip unused trace() fast! @disp || $stop or return; $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; } my $message = shift; unless(Log::Report::Dispatcher->can('collectLocation')) { # internal Log::Report error can result in "deep recursions". eval "require Carp"; Carp::confess($message); } $opts->{location} ||= Log::Report::Dispatcher->collectLocation; my $exception; if(!blessed $message) { # untranslated message into object @_%2 and error __x"odd length parameter list with '{msg}'", msg => $message; $message = $lrm->new(_prepend => $message, @_); } elsif($message->isa('Log::Report::Exception')) { $exception = $message; $message = $exception->message; } elsif($message->isa('Log::Report::Message')) { @_==0 or error __x"a message object is reported with more parameters"; } if(my $to = $message->to) { @disp = grep $_->name eq $to, @disp; @disp or return; } my $domain = $message->domain; if(my $filters = $reporter->{filters}) { DISPATCHER: foreach my $d (@disp) { my ($r, $m) = ($reason, $message); foreach my $filter (@$filters) { next if keys %{$filter->[1]} && !$filter->[1]{$d->name}; ($r, $m) = $filter->[0]->($d, $opts, $r, $m, $domain); $r or next DISPATCHER; } $d->log($opts, $r, $m, $domain); } } else { $_->log($opts, $reason, $message, $domain) for @disp; } if($stop) { # $^S = $EXCEPTIONS_BEING_CAUGHT; parse: undef, eval: 1, else 0 (defined($^S) ? $^S : 1) or exit($opts->{errno} || 0); $! = $opts->{errno} || 0; $@ = $exception || Log::Report::Exception->new(report_opts => $opts , reason => $reason, message => $message); die; # $@->PROPAGATE() will be called, some eval will catch this } @disp; } my %disp_actions = map +($_ => 1), qw/ close find list disable enable mode needs filter active-try do-not-reopen /; my $reopen_disp = 1; sub dispatcher($@) { if(! $disp_actions{$_[0]}) { my ($type, $name) = (shift, shift); # old dispatcher with same name will be closed in DESTROY my $disps = $reporter->{dispatchers}; if(!$reopen_disp) { my $has = first {$_->name eq $name} @$disps; if(defined $has && $has ne $default_dispatcher) { trace "not reopening $name"; return $has; } } my @disps = grep $_->name ne $name, @$disps; trace "reopening dispatcher $name" if @disps != @$disps; my $disp = Log::Report::Dispatcher ->new($type, $name, mode => $default_mode, @_); push @disps, $disp if $disp; $reporter->{dispatchers} = \@disps; _whats_needed; return $disp ? ($disp) : undef; } my $command = shift; if($command eq 'list') { mistake __"the 'list' sub-command doesn't expect additional parameters" if @_; my @disp = @{$reporter->{dispatchers}}; push @disp, $nested_tries[-1] if @nested_tries; return @disp; } if($command eq 'needs') { my $reason = shift || 'undef'; error __"the 'needs' sub-command parameter '{reason}' is not a reason" unless is_reason $reason; my $disp = $reporter->{needs}{$reason}; return $disp ? @$disp : (); } if($command eq 'filter') { my $code = shift; error __"the 'filter' sub-command needs a CODE reference" unless ref $code eq 'CODE'; my %names = map +($_ => 1), @_; push @{$reporter->{filters}}, [ $code, \%names ]; return (); } if($command eq 'active-try') { return $nested_tries[-1]; } if($command eq 'do-not-reopen') { $reopen_disp = 0; return (); } my $mode = $command eq 'mode' ? shift : undef; my $all_disp = @_==1 && $_[0] eq 'ALL'; my $disps = $reporter->{dispatchers}; my @disps; if($all_disp) { @disps = @$disps } else { # take the dispatchers in the specified order. Both lists # are small, so O(x²) is small enough for my $n (@_) { push @disps, grep $_->name eq $n, @$disps } } error __"only one dispatcher name accepted in SCALAR context" if @disps > 1 && !wantarray && defined wantarray; if($command eq 'close') { my %kill = map +($_->name => 1), @disps; @$disps = grep !$kill{$_->name}, @$disps; $_->close for @disps; } elsif($command eq 'enable') { $_->_disabled(0) for @disps } elsif($command eq 'disable') { $_->_disabled(1) for @disps } elsif($command eq 'mode') { Log::Report::Dispatcher->defaultMode($mode) if $all_disp; $_->_set_mode($mode) for @disps; } # find does require reinventarization _whats_needed if $command ne 'find'; wantarray ? @disps : $disps[0]; } END { $_->close for @{$reporter->{dispatchers}} } # _whats_needed # Investigate from all dispatchers which reasons will need to be # passed on. After dispatchers are added, enabled, or disabled, # this method shall be called to re-investigate the back-ends. sub _whats_needed() { my %needs; foreach my $disp (@{$reporter->{dispatchers}}) { push @{$needs{$_}}, $disp for $disp->needs; } $reporter->{needs} = \%needs; } sub try(&@) { my $code = shift; @_ % 2 and report {location => [caller 0]}, PANIC => __x"odd length parameter list for try(): forgot the terminating ';'?"; my $disp = Log::Report::Dispatcher::Try->new(TRY => 'try', @_); push @nested_tries, $disp; # user's __DIE__ handlers would frustrate the exception mechanism local $SIG{__DIE__}; my ($ret, @ret); if(!defined wantarray) { eval { $code->() } } # VOID context elsif(wantarray) { @ret = eval { $code->() } } # LIST context else { $ret = eval { $code->() } } # SCALAR context my $err = $@; pop @nested_tries; my $is_exception = blessed $err && $err->isa('Log::Report::Exception'); if($err && !$is_exception && !$disp->wasFatal) { ($err, my($opts, $reason, $text)) = Log::Report::Die::die_decode($err, on_die => $disp->die2reason); $disp->log($opts, $reason, __$text); } $disp->died($err) if $err && ($is_exception ? $err->isFatal : 1); $@ = $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(@) { pkg2domain $_[0] } sub __($) { $lrm->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; $lrm->new ( _msgid => $msgid , _expand => 1 , _domain => _default_domain(caller) , @_ ); } sub __n($$$@) { my ($single, $plural, $count) = (shift, shift, shift); $lrm->new ( _msgid => $single , _plural => $plural , _count => $count , _domain => _default_domain(caller) , @_ ); } sub __nx($$$@) { my ($single, $plural, $count) = (shift, shift, shift); $lrm->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); $lrm->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; if($INC{'Log/Report/Minimal.pm'}) { my ($pkg, $fn, $line) = caller; # do not report on LR:: modules if(index($pkg, 'Log::Report::') != 0) { # @pkgs empty during release testings of L::R distributions my @pkgs = Log::Report::Optional->usedBy; die "Log::Report loaded too late in $fn line $line, " . "put in $pkg before ", (join ',', @pkgs) if @pkgs; } } my $to_level = ($_[0] && $_[0] =~ m/^\+\d+$/ ? shift : undef) || 0; my $textdomain = @_%2 ? shift : undef; my %opts = @_; my ($pkg, $fn, $linenr) = caller $to_level; my $domain; if(defined $textdomain) { pkg2domain $pkg, $textdomain, $fn, $linenr; $domain = textdomain $textdomain; } ### Log::Report options if(exists $opts{mode}) { $default_mode = delete $opts{mode} || 0; Log::Report::Dispatcher->defaultMode($default_mode); dispatcher mode => $default_mode, 'ALL'; } my @export; if(my $in = delete $opts{import}) { push @export, ref $in eq 'ARRAY' ? @$in : $in; } else { push @export, @functions, @make_msg; my $syntax = delete $opts{syntax} || 'SHORT'; if($syntax eq 'SHORT') { push @export, @reason_functions } elsif($syntax ne 'REPORT' && $syntax ne 'LONG') { error __x"syntax flag must be either SHORT or REPORT, not `{flag}' in {fn} line {line}" , flag => $syntax, fn => $fn, line => $linenr; } } if(my $msg_class = delete $opts{message_class}) { $msg_class->isa($lrm) or error __x"message_class {class} does not extend {base}" , base => $lrm, class => $msg_class; $lrm = $msg_class; } $class->export_to_level(1+$to_level, undef, @export); ### Log::Report::Domain configuration if(!%opts) { } elsif($domain) { $domain->configure(%opts, where => [$pkg, $fn, $linenr ]) } else { error __x"no domain for configuration options in {fn} line {line}" , fn => $fn, line => $linenr; } } # deprecated, since we have a ::Domain object in 1.00 sub translator($;$$$$) { # replaced by (textdomain $domain)->configure my ($class, $name) = (shift, shift); my $domain = textdomain $name or error __x"textdomain `{domain}' for translator not defined" , domain => $name; @_ or return $domain->translator; my ($translator, $pkg, $fn, $line) = @_; ($pkg, $fn, $line) = caller # direct call, not via import unless defined $pkg; $translator->isa('Log::Report::Translator') or error __x"translator must be a {pkg} object for {domain}" , pkg => 'Log::Report::Translator', domain => $name; $domain->configure(translator => $translator, where => [$pkg, $fn, $line]); } sub textdomain(@) { # used for testing return delete $reporter->{textdomains}{$_[0]} if @_==2 && $_[1] eq 'DELETE'; my $name = (@_%2 ? shift : _default_domain(caller)) || 'default'; my $domain = $reporter->{textdomains}{$name} ||= Log::Report::Domain->new(name => $name); $domain->configure(@_, where => [caller]) if @_; $domain; } sub needs(@) { my $thing = shift; my $self = ref $thing ? $thing : $reporter; first {$self->{needs}{$_}} @_; } 1; Log-Report-1.18/lib/Dancer2/0000755000175000001440000000000013002344345016175 5ustar00markovusers00000000000000Log-Report-1.18/lib/Dancer2/Logger/0000755000175000001440000000000013002344345017414 5ustar00markovusers00000000000000Log-Report-1.18/lib/Dancer2/Logger/LogReport.pm0000644000175000001440000000325413002344341021667 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. package Dancer2::Logger::LogReport; use vars '$VERSION'; $VERSION = '1.18'; # ABSTRACT: Dancer2 logger engine for Log::Report use strict; use warnings; use Moo; use Dancer2::Core::Types; use Scalar::Util qw/blessed/; use Log::Report 'log-report', syntax => 'REPORT'; our $AUTHORITY = 'cpan:MARKOV'; my %level_dancer2lr = ( core => 'TRACE' , debug => 'TRACE' ); with 'Dancer2::Core::Role::Logger'; # Set by calling function has dispatchers => ( is => 'ro' , isa => Maybe[HashRef] ); sub BUILD { my $self = shift; my $configs = $self->dispatchers || {default => undef}; $self->{use} = [keys %$configs]; dispatcher 'do-not-reopen'; foreach my $name (keys %$configs) { my $config = $configs->{$name} || {}; if(keys %$config) { my $type = delete $config->{type} or die "dispatcher configuration $name without type"; dispatcher $type, $name, %$config; } } } around 'info' => sub { my ($orig, $self) = (shift, shift); $self->log(info => @_); }; around 'warning' => sub { my ($orig, $self) = (shift, shift); $self->log(warning => @_); }; around 'error' => sub { my ($orig, $self) = (shift, shift); return if $_[0] =~ /^Route exception/; $self->log(error => @_); }; sub log # no protoypes in Dancer2 { my ($self, $level, $msg) = @_; # the levels are nearly the same. my $reason = $level_dancer2lr{$level} || uc $level; report $reason => $msg; undef; } 1; Log-Report-1.18/lib/Dancer2/Logger/LogReport.pod0000644000175000001440000000400013002344342022024 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Dancer2::Logger::LogReport - reroute Dancer2 logs into Log::Report =head1 INHERITANCE Dancer2::Logger::LogReport is a Moo::Object =head1 SYNOPSIS # This module is loaded when configured. It does not provide # end-user functions or methods. # See DETAILS =head1 DESCRIPTION [The Dancer2 plugin was contributed by Andrew Beverley] This logger allows the use of the many logging backends available in L. It will process all of the Dancer2 log messages, and also allow any other module to use the same logging facilities. The same log messages can be sent to multiple destinations at the same time via flexible dispatchers. If using this logger, you may also want to use L Many log back-ends, like syslog, have more levels of system messages. Modules who explicitly load this module can use the missing C, C, C, and C log levels. The C name is provided as well: when you are debugging, you add a 'trace' to your program... it's just a better name than 'debug'. You probably want to set a very simple C, because the dispatchers do already add some of the fields that the default C format adds. For instance, to get the filename/line-number in messages depends on the dispatcher 'mode' (f.i. 'DEBUG'). You also want to set the log level to C, because level filtering is controlled per dispatcher (as well). See L for examples. =head1 METHODS =over 4 =item $obj-EB($level, $params) =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Dancer2/Plugin/0000755000175000001440000000000013002344345017433 5ustar00markovusers00000000000000Log-Report-1.18/lib/Dancer2/Plugin/LogReport/0000755000175000001440000000000013002344345021350 5ustar00markovusers00000000000000Log-Report-1.18/lib/Dancer2/Plugin/LogReport/Message.pm0000644000175000001440000000151513002344341023270 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. use strict; use warnings; package Dancer2::Plugin::LogReport::Message; use vars '$VERSION'; $VERSION = '1.18'; use parent 'Log::Report::Message'; sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $self; } sub reason { my $self = shift; $self->{reason} = $_[0] if exists $_[0]; $self->{reason}; } my %reason2color = ( TRACE => 'info' , ASSERT => 'info' , INFO => 'info' , NOTICE => 'info' , WARNING => 'warning' , MISTAKE => 'warning' ); sub bootstrap_color { my $self = shift; return 'success' if $self->inClass('success'); $reason2color{$self->reason} || 'danger'; } 1; Log-Report-1.18/lib/Dancer2/Plugin/LogReport/Message.pod0000644000175000001440000000427713002344342023447 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Dancer2::Plugin::LogReport::Message - extended Log::Report message class =head1 INHERITANCE Dancer2::Plugin::LogReport::Message is a Log::Report::Message =head1 SYNOPSIS In your template: [% FOR message IN messages %]
[% message.toString | html_entity %]
[% END %] =head1 DESCRIPTION [The Dancer2 plugin was contributed by Andrew Beverley] This class is an extension of L, with functions specifically designed for Dancer applications. Minimal functions are provided (currently only aimed at Bootstrap), but ideas for new ones are welcome. Extends L<"DESCRIPTION" in Log::Report::Message|Log::Report::Message/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Log::Report::Message|Log::Report::Message/"METHODS">. =over 4 =item $obj-EB() Get a suitable bootstrap context color for the message. This can be used as per the SYNOPSIS. C is used for L messages, C colors are used for messages C and below, C is used for C and C, C is used for all other messages =item $obj-EB() Get or set the reason of a message =back =head1 DETAILS Extends L<"DETAILS" in Log::Report::Message|Log::Report::Message/"DETAILS">. =head1 OVERLOADING Extends L<"OVERLOADING" in Log::Report::Message|Log::Report::Message/"OVERLOADING">. =over 4 =item overload: B Inherited, see L =item overload: B Inherited, see L =item overload: B Inherited, see L =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Dancer2/Plugin/LogReport.pod0000644000175000001440000003620413002344342022056 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Dancer2::Plugin::LogReport - logging and exceptions via Log::Report =head1 SYNOPSIS # Load the plugin into Dancer2 # see Log::Report::import() for %options use Log::Report (); # load early in main use Dancer2::Plugin::LogReport %options; # Stop execution, redirect, and display an error to the user $name or error "Please enter a name"; # Add debug information to logger trace "We're here"; # Handling user errors cleanly if (process( sub {MyApp::Model->create_user} )) { # Success, redirect user elsewhere } else { # Failed, continue as if submit hadn't been made. # Error message will be in session for display later. } # Send errors to template for display hook before_template => sub { my $tokens = shift; $tokens->{messages} = session 'messages'; session 'messages' => []; } =head1 DESCRIPTION [The Dancer2 plugin was contributed by Andrew Beverley] This module provides easy access to the extensive logging facilities provided by L. Along with L, this brings together all the internal Dancer2 logging, handling for expected and unexpected exceptions, translations and application logging. Logging is extremely flexible using many of the available L. Multiple dispatchers can be used, each configured separately to display different messages in different formats. By default, messages are logged to a session variable for display on a webpage, and to STDERR. Messages within this plugin use the extended L class rather than the standard L class. Read the L in below in this manual-page. =head1 METHODS =over 4 =item $obj-EB() C is an eval, but one which expects and understands exceptions generated by L. Any messages will be logged as normal in accordance with the dispatchers, but any fatal exceptions will be caught and handled gracefully. This allows much simpler error handling, rather than needing to test for lots of different scenarios. In a module, it is enough to simply use the C keyword in the event of a fatal error. The return value will be 1 for success or 0 if a fatal exception occurred. See the L for an example of how this is expected to be used. This module is configured only once in your application. The other modules which make your website do not need to require this plugin, instead they can C to get useful functions like error and fault. =back =head2 Handlers All the standard L functions are available to use. Please see the L for details of when each one should be used. L to class messages (which can then be tested later): notice __x"Class me up", _class => 'label'; ... if ($msg->inClass('label')) ... L has a special message class, C, which prevents the message from being saved to the messages session variable. This is useful, for example, if you are writing messages within the session hooks, in which case recursive loops can be experienced. =over 4 =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() =item $obj-EB() This is a special additional type, equivalent to C. The difference is that messages using this keyword will have the class C added, which can be used to color the messages differently to the end user. For example, L uses this to display the message in green. =item $obj-EB() =item $obj-EB() =back =head1 DETAILS This chapter will guide you through the myriad of ways that you can use L in your Dancer2 application. We will set up our application to do the following: =over 4 =item Messages to the user We'll look at an easy way to output messages to the user's web page, whether they be informational messages, warnings or errors. =item Debug information We'll look at an easy way to log debug information, at different levels. =item Manage unexpected exceptions We'll handle unexpected exceptions cleanly, in the unfortunate event that they happen in your production application. =item Email alerts of significant errors If we do get unexpected errors then we want to be notified them. =item Log DBIC information and errors We'll specifically look at nice ways to log SQL queries and errors when using DBIx::Class. =back =head2 Larger example In its simplest form, this module can be used for more flexible logging get '/route' => sub { # Stop execution, redirect, and display an error to the user $name or error "Please enter a name"; # The same but translated $name or error __"Please enter a name"; # The same but translated and with variables $name or error __x"{name} is not valid", name => $name; # Show the user a warning, but continue execution mistake "Not sure that's what you wanted"; # Add debug information, can be caught in syslog by adding # the (for instance) syslog dispatcher trace "Hello world"; }; =head2 Setup and Configuration To make full use of L, you'll need to use both L and L. =head3 Dancer2::Logger::LogReport Set up L by adding it to your Dancer2 application configuration (see L). By default, all messages will go to STDERR. To get all message out "the Perl way" (using print, warn and die) just use logger: "LogReport" At start, these are handled by a L object, named 'default'. If you open a new dispatcher with the name 'default', the output via the perl mechanisms will be stopped. To also send messages to your syslog: logger: "LogReport" engines: logger: LogReport: log_format: %a%i%m app_name: MyApp dispatchers: default: # Name type: SYSLOG # Log::Reporter::dispatcher() options identity: myapp facility: local0 flags: "pid ndelay nowait" mode: DEBUG To send messages to a file: logger: "LogReport" engines: logger: LogReport: log_format: %a%i%m app_name: MyApp dispatchers: logfile: # "default" dispatcher stays open as well type: FILE to: /var/log/myapp.log charset: utf-8 mode: DEBUG See L for full details of options. Finally: a Dancer2 script may run many applications. Each application can have its own logger configuration. However, Log::Report dispatchers are global, so will be shared between Dancer2 applications. Any attempt to create a new Log::Report dispatcher by the same name (as will happen when a new Dancer2 application is started with the same configuration) will be ignored. =head3 Dancer2::Plugin::LogReport To use the plugin, you simply use it in your application: package MyApp; use Log::Report (); # use early and minimal once use Dancer2; use Dancer2::Plugin::LogReport %config; Dancer2::Plugin::LogReport takes the same C<%config> options as L itself (see L). If you want to send messages from your modules/models, there is no need to use this specific plugin. Instead, you should simply C to negate the need of loading all the Dancer2 specific code. =head2 In use =head3 Logging debug information In its simplest form, you can now use all the L to send messages to your dispatchers (as configured in the Logger configuration): trace "I'm here"; warning "Something dodgy happened"; panic "I'm bailing out"; # Additional, special Dancer2 keyword success "Settings saved successfully"; =head3 Exceptions Log::Report is a combination of a logger and an exception system. Messages to be logged are I to all listening dispatchers to be handled. This module will also catch any unexpected exceptions: # This will be caught, the error will be logged (full stacktrace to STDOUT, # short message to the session messages), and the user will be forwarded # (default to /). This would also be sent to syslog with the appropriate # dispatcher. get 'route' => sub { my $foo = 1; my $bar = $foo->{x}; # whoops } For a production application (C), the message saved in the session will be the generic text "An unexpected error has occurred". This can be customised in the configuration file, and will be translated. =head3 Sending messages to the user To make it easier to send messages to your users, messages at the following levels are also stored in the user's session: C, C, C, C, C, C, C and C. You can pass these to your template and display them at each page render: hook before_template => sub { my $tokens = shift; $tokens->{messages} = session 'messages'; session 'messages' => []; # Clear the message queue } Then in your template (for example the main layout): [% FOR message IN messages %]
[% message.toString | html_entity %]
[% END %] The C of the message is compatible with Bootstrap contextual colors: C, C, C or C. Now, anywhere in your application that you have used Log::Report, you can warning "Hey user, you should now about this"; and the message will be sent to the next page the user sees. =head3 Handling user errors Sometimes we write a function in a model, and it would be nice to have a nice easy way to return from the function with an error message. One way of doing this is with a separate error message variable, but that can be messy code. An alternative is to use exceptions, but these can be a pain to deal with in terms of catching them. Here's how to do it with Log::Report. In this example, we do use exceptions, but in a neat, easier to use manner. First, your module/model: package MyApp::CD; sub update { my ($self, %values) = @_; $values{title} or error "Please enter a title"; $values{description} or warning "No description entered"; } Then, in your controller: package MyApp; use Dancer2; post '/cd' => sub { my %values = ( title => param('title'); description => param('description'); ); if (process sub { MyApp::CD->update(%values) } ) { success "CD updated successfully"; redirect '/cd'; } template 'cd' => { values => \%values }; } Now, when update() is called, any exceptions are caught. However, there is no need to worry about any error messages. Both the error and warning messages in the above code will have been stored in the messages session variable, where they can be displayed using the code in the previous section. The C will have caused the code to stop running, and process() will have returned false. C will have simply logged the warning and not caused the function to stop running. =head3 Logging DBIC database queries and errors If you use L in your application, you can easily integrate its logging and exceptions. To log SQL queries: # Log all queries and execution time $schema->storage->debugobj(new Log::Report::DBIC::Profiler); $schema->storage->debug(1); By default, exceptions from DBIC are classified at the level "error". This is normally a user level error, and thus may be filtered as normal program operation. If you do not expect to receive any DBIC exceptions, then it is better to class them at the level "panic": # panic() DBIC errors $schema->exception_action(sub { panic @_ }); # Optionally get a stracktrace too $schema->stacktrace(1); If you are occasionally running queries where you expect to naturally get exceptions (such as not inserting multiple values on a unique constraint), then you can catch these separately: try { $self->schema->resultset('Unique')->create() }; # Log any messages from try block, but only as trace $@->reportAll(reason => 'TRACE'); =head3 Email alerts of exceptions If you have an unexpected exception in your production application, then you probably want to be notified about it. One way to do so is configure rsyslog to send emails of messages at the panic level. Use the following configuration to do so: # Normal logging from LOCAL0 local0.* -/var/log/myapp.log # Load the mail module $ModLoad ommail # Configure sender, receiver and mail server $ActionMailSMTPServer localhost $ActionMailFrom root $ActionMailTo root # Set up an email template $template mailSubject,"Critical error on %hostname%" $template mailBody,"RSYSLOG Alert\r\nmsg='%msg%'\r\nseverity='%syslogseverity-text%'" $ActionMailSubject mailSubject # Send an email no more frequently than every minute $ActionExecOnlyOnceEveryInterval 60 # Configure the level of message to notify via email if $syslogfacility-text == 'local0' and $syslogseverity < 3 then :ommail:;mailBody $ActionExecOnlyOnceEveryInterval 0 With the above configuration, you will only be emailed of severe errors, but can view the full log information in /var/log/myapp.log =head1 CONFIGURATION All configuration is optional. The example configuration file below shows the configuration options and defaults. plugins: LogReport: # Whether to handle Dancer HTTP errors such as 404s. Currently has # no effect due to unresolved issues saving messages to the session # and accessing the DSL at that time. handle_http_errors: 1 # Where to forward users in the event of an uncaught fatal # error within a GET request forward_url: / # Or you can specify a template instead [1.13] forward_template: error_template_file # Defaults to empty # For a production server (show_errors: 0), this is the text that # will be displayed instead of unexpected exception errors fatal_error_message: An unexpected error has occurred # The levels of messages that will be saved to the session, and # thus displayed to the end user session_messages: [ NOTICE, WARNING, MISTAKE, ERROR, FAULT, ALERT, FAILURE, PANIC ] =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Dancer2/Plugin/LogReport.pm0000644000175000001440000001774713002344341021722 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. package Dancer2::Plugin::LogReport; use vars '$VERSION'; $VERSION = '1.18'; use warnings; use strict; BEGIN { use Log::Report () } # require very early XXX MO: useless? use Dancer2::Plugin; use Dancer2::Plugin::LogReport::Message; use Log::Report 'log-report', syntax => 'REPORT', message_class => 'Dancer2::Plugin::LogReport::Message'; use Scalar::Util qw/blessed/; my $_dsl; # XXX How to avoid the global? Dancer2::Core::DSL my $_settings; # "use" import sub import { my $class = shift; # Import Log::Report into the caller. Import options get passed through my $level = $Dancer2::VERSION > 0.166001 ? '+1' : '+2'; Log::Report->import($level, @_, syntax => 'LONG'); # Ensure the overridden import method is called (from Exporter::Tiny) # note this does not (currently) pass options through. my $caller = caller; $class->SUPER::import( {into => $caller} ); } my %session_messages; # The default reasons that a message will be displayed to the end user my @default_reasons = qw/NOTICE WARNING MISTAKE ERROR FAULT ALERT FAILURE PANIC/; my $hide_real_message; # Used to hide the real message to the end user my $messages_variable = $_settings->{messages_key} || 'messages'; # Dancer2 import on_plugin_import { my $dsl = $_dsl = shift; # capture global singleton my $settings = $_settings = plugin_setting; # Need init_error for exceptions and other errors $dsl->hook(init_error => sub { my $error = shift; # Catch other exceptions. This hook is called for all errors # not just exceptions (including for example 404s), so check first. # If it's an exception then panic it to get Log::Report # to handle it nicely. If it's another error such as a 404 # then exception will not be set. report 'PANIC' => $error->{exception} if $error->{exception}; }); if($settings->{handle_http_errors}) { # Need after_error for HTTP errors (eg 404) so as to # be able to change the forwarding location $dsl->hook(after_error => sub { my $error = shift; my $msg = __($error->status . ": " . Dancer2::Core::HTTP->status_message($error->status)); # XXX This doesn't work at the moment. The DSL at this point # doesn't seem to respond to changes in the session or # forward requests _forward_home( $_dsl, $msg ); }); } $dsl->hook(after_layout_render => sub { my $session = $_dsl->app->session; $session->write($messages_variable => []); }); # Define which messages are saved to the session for later display # to the user. This can be configured in the config file, or we # choose some sensible defaults. my $sm = $settings->{session_messages} // \@default_reasons; $session_messages{$_} = 1 for ref $sm eq 'ARRAY' ? @$sm : $sm; # In a production server, we don't want the end user seeing (unexpected) # exception messages, for both security and usability. If we detect # that this is a production server (show_errors is 0), then we change # the specific error to a generic error, when displayed to the user. # The message can be customised in the config file. my $fatal_error_message = $settings->{fatal_error_message} // "An unexpected error has occurred"; unless($dsl->app->config->{show_errors}) { $hide_real_message->{$_} = $fatal_error_message for qw/FAULT ALERT FAILURE PANIC/; } if(my $forward_template = $settings->{forward_template}) { # Add a route for the specified template $dsl->app->add_route ( method => 'get' , regexp => qr!^/\Q$forward_template\E$!, , code => sub { shift->app->template($forward_template) } ); # Forward to that new route $settings->{forward_url} = $forward_template; } # This is so that all messages go into the session, to be displayed # on the web page (if required) dispatcher CALLBACK => 'error_handler' , callback => \&_error_handler , mode => 'DEBUG'; Log::Report::Dispatcher->addSkipStack( sub { $_[0][0] =~ m/ ^ Dancer2\:\:(?:Plugin|Logger)\:\:LogReport | ^ Dancer2\:\:Core\:\:Role\:\:DSL /x }); }; # ";" required! sub process($$) { my ($dsl, $coderef) = @_; try { $coderef->() } hide => 'ALL', on_die => 'PANIC'; my $success = $@->died ? 0 : 1; $@->reportAll(is_fatal => 0); $success; } register process => \&process; sub _message_add($) { my $msg = shift; return if ! $session_messages{$msg->reason} || $msg->inClass('no_session'); my $app = $_dsl->app; unless($app->request) { # This happens for HTTP errors # XXX the session is not available in the DSL report 'ASSERT' => "Unable to write message to session: unable to write cookie"; return; } my $r = $msg->reason; if(my $newm = $hide_real_message->{$r}) { $msg = __$newm; $msg->reason($r); } my $session = $app->session; my $msgs = $session->read($messages_variable); push @$msgs, $msg; $session->write($messages_variable => $msgs); } #------ sub _forward_home($$) { my $dsl = shift; _message_add(shift); my $page = $_settings->{forward_url} || '/'; $dsl->redirect($page); } sub _error_handler($$$$) { my ($disp, $options, $reason, $message) = @_; my $fatal_handler = sub { # Check whether this fatal message has been caught, in which case we # don't want to redirect return _message_add($_[0]) if exists $options->{is_fatal} && !$options->{is_fatal}; my $req = $_dsl->request or return; # Don't forward if it's a GET request to the error page, as it will # cause a recursive loop. In this case, do nothing, and let dancer # handle it. # return not needed because of Return::MultiLevel hack, but let's # leave it in anyway in hope. my $fwd_url = $_settings->{forward_url} || ''; return _forward_home($_dsl, $_[0]) if $req->uri ne $fwd_url || !$req->is_get; return; }; $message->reason($reason); my %handler = ( # Default do nothing for the moment (TRACE|ASSERT|INFO) default => sub {_message_add $_[0]} # A user-created error condition that is not recoverable. # This could have already been caught by the process # subroutine, in which case we should continue running # of the program. In all other cases, we should bail # out. , ERROR => $fatal_handler # 'FAULT', 'ALERT', 'FAILURE', 'PANIC' # All these are fatal errors. , FAULT => $fatal_handler , ALERT => $fatal_handler , FAILURE => $fatal_handler , PANIC => $fatal_handler ); my $call = $handler{$reason} || $handler{default}; $call->($message); } sub _report($@) { my ($reason, $dsl) = (shift, shift); my $msg = (blessed($_[0]) && $_[0]->isa('Log::Report::Message')) ? $_[0] : Dancer2::Core::Role::Logger::_serialize(@_); if ($reason eq 'SUCCESS') { $msg = __$msg unless blessed $msg; $msg = $msg->clone(_class => 'success'); $reason = 'NOTICE'; } report uc($reason) => $msg; } register trace => sub { _report(TRACE => @_) }; register assert => sub { _report(ASSERT => @_) }; register notice => sub { _report(NOTICE => @_) }; register mistake => sub { _report(MISTAKE => @_) }; register panic => sub { _report(PANIC => @_) }; register alert => sub { _report(ALERT => @_) }; register fault => sub { _report(FAULT => @_) }; register failure => sub { _report(FAILURE => @_) }; register success => sub { _report(SUCCESS => @_) }; register_plugin for_versions => ['2']; #---------- 1; Log-Report-1.18/lib/MojoX/0000755000175000001440000000000013002344345015753 5ustar00markovusers00000000000000Log-Report-1.18/lib/MojoX/Log/0000755000175000001440000000000013002344345016474 5ustar00markovusers00000000000000Log-Report-1.18/lib/MojoX/Log/Report.pod0000644000175000001440000000303513002344342020451 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME MojoX::Log::Report - divert log messages into Log::Report =head1 INHERITANCE MojoX::Log::Report is a Mojo::Log =head1 SYNOPSIS use MojoX::Log::Report; my $log = MojoX::Log::Report->new(%options); $app->log($log); # install logger in the Mojo::App =head1 DESCRIPTION [Included since Log::Report v1.00] Mojo likes to log messages directly into a file, by default. Log::Report constructs a L object first. Be aware that this extension does catch the messages to be logged, but that the dispatching of the error follows a different route now. For instance, you cannot use C<$ENV{MOJO_LOG_LEVEL}> to control the output level, but you need to use L action C. Mojo defines five "levels" of messages, which map onto Log::Report's reasons this way: debug TRACE info INFO warn WARNING error ERROR fatal ALERT =head1 METHODS =head2 Constructors =over 4 =item MojoX::Log::Report-EB(%options) Inherited %options C and C are ignored. =back =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/MojoX/Log/Report.pm0000644000175000001440000000165313002344341020306 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. package MojoX::Log::Report; use vars '$VERSION'; $VERSION = '1.18'; use Mojo::Base 'Mojo::Log'; # implies use strict etc use Log::Report 'log-report', import => 'report'; sub new(@) { my $class = shift; my $self = $class->SUPER::new(@_); # issue with Mojo, where the base-class registers a function --not # a method-- to handle the message. $self->unsubscribe('message'); # clean all listeners $self->on(message => '_message'); # call it OO $self; } my %level2reason = qw/ debug TRACE info INFO warn WARNING error ERROR fatal ALERT /; sub _message($$@) { my ($self, $level) = (shift, shift); report +{is_fatal => 0} # do not die on errors , $level2reason{$level}, join('', @_); } 1; Log-Report-1.18/lib/Dancer/0000755000175000001440000000000013002344345016113 5ustar00markovusers00000000000000Log-Report-1.18/lib/Dancer/Logger/0000755000175000001440000000000013002344345017332 5ustar00markovusers00000000000000Log-Report-1.18/lib/Dancer/Logger/LogReport.pod0000644000175000001440000000456213002344342021757 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Dancer::Logger::LogReport - reroute Dancer logs into Log::Report =head1 INHERITANCE Dancer::Logger::LogReport is a Dancer::Logger::Abstract Dancer::Logger::LogReport is a Exporter =head1 SYNOPSIS # When your main program is not a Dancer object use My::Dancer::App; use Log::Report; ... start dispatcher ... error "something is wrong"; # Log::Report::error() # When your main program is a Dancer object use Dancer; use Dancer::Logger::LogReport; use Log::Report import => 'dispatcher'; ... start dispatcher ... error "something is wrong"; # Dancer::error() # In any case, your main program needs to start log dispatcers # Both Dancer and other Log::Report based modules will send # their messages here: dispatcher FILE => 'default', ...; # In your config logger: log_report logger_format: %i%m # keep it simple log: debug # filtered by dispatchers =head1 DESCRIPTION The L exception/translation framework defines a large number of logging back-ends. The same log messages can be sent to multiple destinations at the same time via flexible dispatchers. When you use this logger in your Dancer application, it will nicely integrate with non-Dancer modules which need logging. Many log back-ends, like syslog, have more levels of system messages. Modules who explicitly load this module can use the missing C, C, C, and C log levels. The C name is provided as well: when you are debugging, you add a 'trace' to your program... its just a better name than 'debug'. You probably want to set a very simple C, because the dispatchers do already add some of the fields that the default C format adds. For instance, to get the filename/line-number in messages depends on the dispatcher 'mode' (f.i. 'DEBUG'). You also want to set the log level to C, because level filtering is controlled per dispatcher (as well) =head1 SEE ALSO This module is part of Log-Report distribution version 1.18, built on October 21, 2016. Website: F =head1 LICENSE Copyrights 2007-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Log-Report-1.18/lib/Dancer/Logger/LogReport.pm0000644000175000001440000000365113002344341021606 0ustar00markovusers00000000000000# Copyrights 2007-2016 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.02. package Dancer::Logger::LogReport; use vars '$VERSION'; $VERSION = '1.18'; use base 'Dancer::Logger::Abstract', 'Exporter'; use strict; use warnings; use Scalar::Util qw/blessed/; use Log::Report 'log-report', import => 'report'; use Log::Report::Dispatcher (); our $AUTHORITY = 'cpan:MARKOV'; our @EXPORT = qw/ trace assert notice alert panic /; my %level_dancer2lr = ( core => 'TRACE' , debug => 'TRACE' ); # Add some extra 'levels' sub trace { goto &Dancer::Logger::debug } sub assert { goto &Dancer::Logger::assert } sub notice { goto &Dancer::Logger::notice } sub panic { goto &Dancer::Logger::panic } sub alert { goto &Dancer::Logger::alert } sub Dancer::Logger::assert { my $l = logger(); $l && $l->_log(assert => _serialize(@_)) } sub Dancer::Logger::notice { my $l = logger(); $l && $l->_log(notice => _serialize(@_)) } sub Dancer::Logger::alert { my $l = logger(); $l && $l->_log(alert => _serialize(@_)) } sub Dancer::Logger::panic { my $l = logger(); $l && $l->_log(panic => _serialize(@_)) } #sub init(@) #{ my $self = shift; # $self->SUPER::init(@_); #} sub _log { my ($self, $level, $params) = @_; # all dancer levels are the same as L::R levels, except: my $msg; if(blessed $params && $params->isa('Log::Report::Message')) { $msg = $params; } else { $msg = $self->format_message($level => $params); $msg =~ s/\n+$//; } # The levels are nearly the same. my $reason = $level_dancer2lr{$level} // uc $level; # Gladly, report() does not get confused between Dancer's use of # Try::Tiny and Log::Report's try() which starts a new dispatcher. report {is_fatal => 0}, $reason => $msg; undef; } 1; Log-Report-1.18/MANIFEST0000644000175000001440000000336613002344345015312 0ustar00markovusers00000000000000ChangeLog MANIFEST Makefile.PL README examples/dancer/dancer1.pl lib/Dancer/Logger/LogReport.pm lib/Dancer/Logger/LogReport.pod lib/Dancer2/Logger/LogReport.pm lib/Dancer2/Logger/LogReport.pod lib/Dancer2/Plugin/LogReport.pm lib/Dancer2/Plugin/LogReport.pod lib/Dancer2/Plugin/LogReport/Message.pm lib/Dancer2/Plugin/LogReport/Message.pod lib/Log/Report.pm lib/Log/Report.pod lib/Log/Report/DBIC/Profiler.pm lib/Log/Report/DBIC/Profiler.pod lib/Log/Report/Die.pm lib/Log/Report/Die.pod lib/Log/Report/Dispatcher.pm lib/Log/Report/Dispatcher.pod lib/Log/Report/Dispatcher/Callback.pm lib/Log/Report/Dispatcher/Callback.pod lib/Log/Report/Dispatcher/File.pm lib/Log/Report/Dispatcher/File.pod lib/Log/Report/Dispatcher/Log4perl.pm lib/Log/Report/Dispatcher/Log4perl.pod lib/Log/Report/Dispatcher/LogDispatch.pm lib/Log/Report/Dispatcher/LogDispatch.pod lib/Log/Report/Dispatcher/Perl.pm lib/Log/Report/Dispatcher/Perl.pod lib/Log/Report/Dispatcher/Syslog.pm lib/Log/Report/Dispatcher/Syslog.pod lib/Log/Report/Dispatcher/Try.pm lib/Log/Report/Dispatcher/Try.pod lib/Log/Report/Domain.pm lib/Log/Report/Domain.pod lib/Log/Report/Exception.pm lib/Log/Report/Exception.pod lib/Log/Report/Message.pm lib/Log/Report/Message.pod lib/Log/Report/Translator.pm lib/Log/Report/Translator.pod lib/Log/Report/messages/log-report.utf-8.po lib/Log/Report/messages/log-report/nl_NL.po lib/MojoX/Log/Report.pm lib/MojoX/Log/Report.pod t/00use.t t/09message.t t/10interp.t t/11concat.t t/31stack.t t/41die.t t/50file.t t/51syslog.t t/52logdisp.t t/53log4perl.t t/54try.t t/55throw.t t/60mojo.t t/70dancer2.t t/DieTests.pm xt/99pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Log-Report-1.18/ChangeLog0000644000175000001440000006121213002344341015721 0ustar00markovusers00000000000000 ==== version history of Log::Report Unless noted otherwise, these changes where initiated and applied by Mark Overmeer. TODO: . connect to Message::Passing framework version 1.18: Fri 21 Oct 09:50:51 CEST 2016 Fixes: - die_decode() should not return an 'ALERT' reason, because that is not deadly. Dies are always deadly. Improvements: - ::Try has new attribute on_die, to specify whether a die in the code should produce PANICs or ERRORs. Request by [Andrew Beverley] - ::Die::die_decode() got on_die parameter. - the Dancer2 logger will always PANIC on dies. version 1.17: Mon Sep 19 23:42:56 CEST 2016 Improvements: - typo rt.cpan.org#114072, second attempt [Gregor Herrmann, Debian] - include examples in manual pages. version 1.16: Fri 27 May 08:54:01 CEST 2016 Fixes: - ::Dancer2: support for Dancer2 >v0.166001 [Russell Jenkins] Improvements: - typo rt.cpan.org#114072 [Gregor Herrmann, Debian] version 1.15: Mon 18 Apr 13:54:12 CEST 2016 Improvements: - dancer2: test import parameters [Andrew Beverley] https://github.com/PerlDancer/Dancer2/issues/1156 version 1.14: Tue 12 Apr 15:10:27 CEST 2016 Fixes: - dancer2: regression test only for recent Dancer2 [cpantesters] Improvements: - typo rt.cpan.org#111985 [Gregor Herrmann, Debian] - dancer2: treat all exceptions equal [Andrew Beverley] version 1.13: Wed 3 Feb 11:34:18 CET 2016 Fixes: - init of lexicon with HASH rt.cpan.org#111420 [Paulo A Ferreira] Improvements: - skip Log::Report wrappers from stacktrace and location. - added ::Dispatcher::addSkipStack() and ::skipStack() - add forward_url to Dancer2 plugin example [Andrew Beverley] - ignore $SIG{__DIE__} within try blocks [Milos Lazarevic] - dancer2: add regression test for plugin [Andrew Beverley] - dancer2: add forward_template option [Raj Barath] version 1.12: Mon Jan 18 21:55:35 CET 2016 Fixes: - reopen default dispatcher creates a double. [Andrew Beverley] Improvements: - remove mode=DEBUG from Dancer2::* version 1.11: Mon 18 Jan 17:07:43 CET 2016 Fixes: - warning when log outside sub [Andrew Beverley] - missing register of fault and failure [Andrew Beverley] - some module is textdomain logreport, should be log-report. [Andrew Beverley] - Dancer2::Logger::LogReport should not set the mode Improvements: - dispatcher 'do-not-reopen' does not protect the default dispatcher [Andrew Beverley] - produce error when setContext is used while context_rules are not provided. - added ::Exception::toHTML() and ::Message::toHTML() version 1.10: Sat Nov 28 17:39:16 CET 2015 Fixes: - Dancer2 object build [Andrew Beverley] - ::Domain::setContext with PAIRS as parameter - collect stack for exceptions inside try block. [Andrew Beverley] Improvements: - keep dispatchers ordered. - interpolate context setting inside msg_id's as well - add ::Domain::updateContext() - new option dispatcher 'do-not-reopen' - ::Dispatcher::File option format() with CODE, now calls with additional parameter $msg. - ::Dispatcher::File option output() now with CODE, to dynamically return the logfile name. - added t/55throw.t - new method ::Try::hide() - renamed internal fields of ::Dispatcher::File, to lead with LRDF_ - new option ::Dispatcher::Syslog::new(format) version 1.09: Tue 20 Oct 09:26:00 CEST 2015 Fixes: - try: do not ignore is_fatal parameter Improvements: - dispatcher() new action 'active-try' - many, many improvements to Dancer2::* [Andrew Beverley] version 1.08: Thu 8 Oct 17:55:39 CEST 2015 Fixes: - tests on Windows [cpantesters] Improvements: - avoid use of 'package Dancer::Logger' to circumvent complaints of Pause. - Log::Report configure message_class [Andrew Beverley] - Dancer2 plugin improved a lot [Andrew Beverley] version 1.07: Tue Jul 21 17:38:01 CEST 2015 Fixes: - remove superfluous blank lines, when (translated) message ends on \n. Reported by [Andrew Beverley] - Dancer2::Plugin:: deep recursion in ERROR handler [Andrew Beverley] Improvements: - document HASH for ::Syslog::new(logsocket). Idea of [Andrew Beverley] - add Log::Report::DBIC::Profiler [Andrew Beverley] - loads of documentation on using Log::Report in Dancer2, written by [Andrew Beverley] - protect against two instances of ::Syslog at the same time: its impossible. version 1.06: Mon Jun 15 17:30:33 CEST 2015 Fixes: - t/60mojo.t will not run on old mojo's: requires 2.16 (2011) [cpantesters] - ::Dispatcher::File do not use %F/%T in strfime, which is not supported by Windows. - make ::Die understand multiline 'die()' messages. rt.cpan.org#101389 [Ken Neighbors] Improvements: - add Dancer::Log::Report and examples/dancer/ - add Dancer2::*, contributed by [Andrew Beverly] version 1.05: Tue Jun 24 09:38:15 CEST 2014 Fixes: - test in t/10interp.t failed for Perl 5.20, caused by a bugfix or change in overload::Overloaded [cpantesters] version 1.04: Tue Jun 3 10:42:11 CEST 2014 Fixes: - float serialization under locale in test [cpantesters] version 1.03: Thu May 22 11:54:24 CEST 2014 Fixes: - float serialization under locale in test [cpantesters] - non-errors and ::Dispatcher::Perl Improvements: - shorted display of string parameters in stack-trace to max 80 chars - Log4perl log-lines sometimes show dispatcher as source, skip them. - disable 'mode switch' trace for try() version 1.02: Mon Mar 10 16:03:13 CET 2014 Fixes: - add overload fallback to ::Exception and ::Dispatcher rt.cpan.org#92970 [Lukas Mai] - ::Domain::new(translator) with HASH did not initialize - warn better with ::Optional modules are used before Log::Report is used. Improvements: - changed documentation style - ::Lexicon::Index dir-scan immediately, hopefully before fork() version 1.01: Mon Jan 6 23:21:37 CET 2014 Fixes: - LC_MESSAGE missing on Windows [Michael Long] version 1.00: Sun Jan 5 17:23:44 CET 2014 Split into four components, adding - String::Print for formatting, permits positionals now - Log::Report::Optional as base, super lightweight - Log::Report::Lexicon when you need translations Changes: - configuration from ::translator() into ::Domain::configure() - domains are package bound, not line based. - removed isValidReason() and isFatal(), there are function in ::Util - dispatchers(list) inside try() also lists outside dispatchers - ::Dispatcher::Log4perl::new(accept) defaults to 'ALL', because the log4perl configuration will select what to log. - exceptions which get re-thrown with an other reason get rewritten. - alert and failure messages will always show their location - "switching to mode" message from level info to trace Fixes: - do not complain when N__w ends on \n - incorrect initialization of log4perl dispatcher - try inside BEGIN did not catch but died. rt.cpan.org#91671 [Kenney Westerhof] Improvements: - ::Dispatcher::File uses locking to permit parallel writes - ::Dispatcher::File::new(format) - ::Dispatcher::File::rotate() - ::Dispatcher::Log4perl more docs - explain why Log::Log4perl::caller_depth concept is broken - ::Dispatcher::Log4perl support for categories - ::Dispatcher::Syslog::new(include_domain) - ::Dispatcher::Syslog::new(charset) - ::Dispatcher::*::log() knows about textdomain of msg - ::Message::new(_lang) overrides language to be used in translation - add MojoX::Log::Report - new ::Domain, move all domain specific config from ::import() into that module (and/or ::Minimal::Domain) - ::textdomain() - ::Message overload fallback - remove "syntax => 'SHORT'" from examples: is the default - export level on Log::Report::import() version 0.999: Not (yet) released version 0.998: Tue Oct 22 09:55:06 CEST 2013 Fixes: - xgettext-perl: actually use the provided template pattern - xgettext-perl: only take template from .tt and .tt2 files - xgettext-perl: accept '-' (STDIN) for --from Improvements: - more documentation about the PPI extraction process, and how to use ::Message::new(_domain) - Log::Report import option 'import' version 0.997: Fri Sep 27 17:37:11 CEST 2013 Fixes: - error about double definedness of settings, dependent on the order of inclusion of modules. - setlocale does not return the old locale, but the new. Improvements: - xgettext-perl: do not PPI files unless they are Perl - xgettext-perl: do warn when ' (single quotes) are used, needs " (double quote) with __x - __x() now can have a _domain parameter version 0.996: Wed Sep 4 17:23:11 CEST 2013 Fixes: - you could not share one ::Translator::POT over two domains. discovered by [Richard Still] - third attempt to fix errors in t/53log4perl.t on Windows [cpantesters] - remove double reporting of errors which exceptions are caught with eval(). But better use try(). version 0.995: Thu Aug 29 09:19:13 CEST 2013 Fixes: - twice path '\' in t/53log4perl.t in Windows [cpantesters] 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-1.18/xt/0000755000175000001440000000000013002344345014604 5ustar00markovusers00000000000000Log-Report-1.18/xt/99pod.t0000644000175000001440000000041612705145357015751 0ustar00markovusers00000000000000#!/usr/bin/env perl use warnings; use strict; use Test::More; BEGIN { eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; plan skip_all => "devel home uses OODoc" if $ENV{MARKOV_DEVEL}; } all_pod_files_ok(); Log-Report-1.18/examples/0000755000175000001440000000000013002344345015767 5ustar00markovusers00000000000000Log-Report-1.18/examples/dancer/0000755000175000001440000000000013002344345017223 5ustar00markovusers00000000000000Log-Report-1.18/examples/dancer/dancer1.pl0000644000175000001440000000121212705145357021104 0ustar00markovusers00000000000000#!/usr/bin/env perl # Daemon at localhost:3000 use Dancer; use Dancer::Logger::LogReport; use Log::Report import => 'dispatcher'; dispatcher FILE => 'logfile' # open additional log destination # , mode => 'DEBUG' # extended information , to => '/tmp/dancer-demo.log'; dispatcher close => 'default'; # closes warn/die default dispatcher set logger => 'log_report'; set log => 'debug'; set logger_format => 'LOG: %i%m'; get '/' => sub { error "we reached the log"; # use Dancer's error() syntax! notice "one more"; # additional levels, same syntax return "Hello World!\n"; }; start; Log-Report-1.18/Makefile.PL0000644000175000001440000000362413002157065016131 0ustar00markovusers00000000000000use ExtUtils::MakeMaker; use 5.008; my $version = '1.18'; my %prereq = ( Test::More => '0.86' , Sys::Syslog => '0.27' , Encode => '2.00' , Scalar::Util => 0 , Devel::GlobalDestruction => '0.09' , Log::Report::Optional => '1.02' , String::Print => '0.13' ); # Upgrade L::R::Lexicon if installed eval "require Log::Report::Extract"; #warn $@; unless($@) { my $v = $Log::Report::Extract::VERSION || '1.00'; if($v < 1.00) { warn <<'__CHANGES_100'; sleep 10 } *************************************************************** WARNING: with Log::Report 1.00, the distribution got spit into four separate components. If you use *translations*, then you have to upgrade Log::Report::Lexicon as well. You may need to add dependencies to that module as well. *************************************************************** __CHANGES_100 } #use Data::Dumper; #warn Dumper \%prereq; WriteMakefile ( NAME => 'Log::Report' , VERSION => $version , PREREQ_PM => \%prereq , AUTHOR => 'Mark Overmeer' , ABSTRACT => 'report a problem, pluggable handlers and language support' , LICENSE => 'perl' ); 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 = Dancer2::Config # for OODoc's oodist, POD FIRST_YEAR = 2007 EMAIL = perl@overmeer.net WEBSITE = http://perl.overmeer.net/log-report/ EXTENDS = ../LogOpt:../Print:../LogLex # 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-1.18/README0000644000175000001440000000112212705145357015040 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-1.18/META.yml0000644000175000001440000000117513002344345015426 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 Log::Report::Optional: 1.02 Scalar::Util: 0 String::Print: 0.13 Sys::Syslog: 0.27 Test::More: 0.86 version: 1.18 Log-Report-1.18/META.json0000644000175000001440000000214113002344345015570 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", "Log::Report::Optional" : "1.02", "Scalar::Util" : "0", "String::Print" : "0.13", "Sys::Syslog" : "0.27", "Test::More" : "0.86" } } }, "release_status" : "stable", "version" : "1.18" }