Log-Report-Optional-1.07/0000755000175000001440000000000014000255521015726 5ustar00markovusers00000000000000Log-Report-Optional-1.07/t/0000755000175000001440000000000014000255521016171 5ustar00markovusers00000000000000Log-Report-Optional-1.07/t/00use.t0000644000175000001440000000130714000255520017312 0ustar00markovusers00000000000000#!/usr/bin/env perl use warnings; use strict; use Test::More tests => 3; # 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/ Test::More String::Print /; 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::Util'); use_ok('Log::Report::Minimal'); use_ok('Log::Report::Optional'); Log-Report-Optional-1.07/t/50options.t0000644000175000001440000000055114000255520020216 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test loading of "Minimal" via "Optional" use Test::More tests => 5; BEGIN { use_ok('Log::Report::Optional','log-report') } my $x = __"test"; is($x, 'test', '__ returns same'); is(ref $x, '', 'not Log::Report::Message'); my @using = Log::Report::Optional->usedBy; cmp_ok(scalar @using, '==', 1, 'usedBy'); is($using[0], __PACKAGE__); Log-Report-Optional-1.07/t/21messages.t0000644000175000001440000000075014000255520020331 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test the minimal message use Test::More tests => 7; use Log::Report::Minimal 'domoor'; is(__"aap", 'aap', '__'); is(__"aap {v}", 'aap {v}', '__ no interpol'); is(__x("aap{v}noot", v => ' mies '), 'aap mies noot', '__x'); is(__xn("one {file}", "{_count} files", 3, file => 'fn'), "3 files", '__xn'); is(__nx("one {file}", "{_count} files", 1, file => 'fn'), "one fn", '__nx'); my @x = N__w"one two three"; cmp_ok(scalar @x, '==', 3, 'N__w'); is($x[-1], 'three'); Log-Report-Optional-1.07/t/05util.t0000644000175000001440000000274714000255520017511 0ustar00markovusers00000000000000#!/usr/bin/env perl use warnings; use strict; use Test::More tests => 58; use Log::Report::Util; # ## parse_locale # sub try_parse($@) { my $locale = shift; my @l = parse_locale $locale; is($l[0], $_[0], $locale); is($l[1], $_[1], ' ... territory'); is($l[2], $_[2], ' ... charset'); is($l[3], $_[3], ' ... modifier'); } try_parse('nl', 'nl'); try_parse(''); try_parse('nl_NL', 'nl', 'NL'); try_parse('nl_NL.utf-8', 'nl', 'NL', 'utf-8'); try_parse('nl_NL.utf-8@mod', 'nl', 'NL', 'utf-8', 'mod'); try_parse('nl.utf-8', 'nl', undef, 'utf-8'); try_parse('nl.utf-8@mod', 'nl', undef, 'utf-8', 'mod'); try_parse('nl_NL@mod', 'nl', 'NL', undef, 'mod'); try_parse('nl@mod', 'nl', undef, undef, 'mod'); try_parse('C', 'C'); try_parse('POSIX', 'POSIX'); # ## expand_reasons # sub try_expand($$) { my ($reasons, $expanded) = @_; my @got = expand_reasons $reasons; my $got = join ',', @got; is($got, $expanded, $reasons); } my $all = join ',', @reasons; try_expand('', ''); try_expand('TRACE', 'TRACE'); try_expand('PANIC,TRACE', 'TRACE,PANIC'); try_expand('USER', 'MISTAKE,ERROR'); try_expand('USER,PROGRAM,SYSTEM', $all); try_expand('ALL', $all); try_expand('WARNING-FAULT','WARNING,MISTAKE,ERROR,FAULT'); try_expand('-INFO','TRACE,ASSERT,INFO'); try_expand('ALERT-','ALERT,FAILURE,PANIC'); try_expand('NONE',''); try_expand([],''); try_expand(['INFO', 'ASSERT-INFO'],'ASSERT,INFO'); try_expand(undef, ''); # ## to_thml # is to_html('b&c"d'), '<a>b&c"d'; Log-Report-Optional-1.07/t/20exceptions.t0000644000175000001440000000050014000255520020673 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test the fake exceptions use Test::More tests => 3; use Log::Report::Minimal; eval "error 'help!'"; is($@, "error: help!\n", $@); { my $w; eval { local $SIG{__WARN__} = sub {$w = join ';', @_}; warning 'auch!' }; is($@, '', $@); # no die is($w, "warning: auch!\n"); } Log-Report-Optional-1.07/lib/0000755000175000001440000000000014000255521016474 5ustar00markovusers00000000000000Log-Report-Optional-1.07/lib/Log/0000755000175000001440000000000014000255521017215 5ustar00markovusers00000000000000Log-Report-Optional-1.07/lib/Log/Report/0000755000175000001440000000000014000255521020470 5ustar00markovusers00000000000000Log-Report-Optional-1.07/lib/Log/Report/Minimal.pod0000644000175000001440000000460114000255520022562 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Minimal - simulate Log::Report functions simple =head1 INHERITANCE Log::Report::Minimal is a Exporter =head1 SYNOPSIS # See Log::Report, most functions get "hollow" behavior use Log::Report::Optional mode => 'DEBUG'; =head1 DESCRIPTION This module implements the functions provided by Log::Report, but then as simple as possible: no support for translations, no dispatchers, no smart exceptions. The package uses C in an C<::Optional> way, the main script determines whether it wants the C<::Minimal> or full-blown feature set. =head1 FUNCTIONS =over 4 =item B( <[$name],$config>|<$name, 'DELETE'|'EXISTS'>|$domain ) =back =head2 Report Production and Configuration =over 4 =item B( <$type, $name, %options>|<$command, @names> ) Not supported. =item B( [$options], $reason, $message| ) Be warned that %options is a HASH here. -Option --Default errno $! or 1 is_fatal =over 2 =item errno => INTEGER =item is_fatal => BOOLEAN =back =item B(CODE, %options) =back =head2 Abbreviations for report() =over 4 =item B($message) =item B($message) =item B($message) =item B($message) =item B($message) =item B($message) =item B($message) =item B($message) =item B($message) =item B($message) =item B($message) =back =head2 Language Translations No translations, no L objects returned. =over 4 =item B($msgid) =item B($single_msgid, $plural_msgid) =item B(STRING) =item B<__>($msgid) =item B<__n>($msgid, $plural_msgid, $count, PAIRS) =item B<__nx>($msgid, $plural_msgid, $count, PAIRS) =item B<__x>($msgid, PAIRS) =item B<__xn>($single_msgid, $plural_msgid, $count, PAIRS) =back =head2 Configuration =over 4 =item $obj-EB( [$domain], %options ) See Log::Report subroutine import. =back =head1 SEE ALSO This module is part of Log-Report-Optional distribution version 1.07, built on January 15, 2021. Website: F =head1 LICENSE Copyrights 2013-2021 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-Optional-1.07/lib/Log/Report/Util.pod0000644000175000001440000001000414000255520022103 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Util - helpful routines to Log::Report =head1 INHERITANCE Log::Report::Util is a Exporter =head1 SYNOPSIS my ($language, $territory, $charset, $modifier) = parse_locale 'nl_BE.utf-8@home'; my @take = expand_reasons 'INFO-ERROR,PANIC'; =head1 DESCRIPTION This module collects a few functions and definitions which are shared between different components in the Log::Report infrastructure. They should not be needed for end-user applications, although this man-page may contain some useful background information. =head1 FUNCTIONS =head2 Reasons =over 4 =item B($reasons) Returns a sub-set of all existing message reason labels, based on the content $reasons string. The following rules apply: REASONS = BLOCK [ ',' BLOCKS ] | ARRAY-of-REASON BLOCK = '-' TO | FROM '-' TO | ONE | SOURCE FROM,TO,ONE = 'TRACE' | 'ASSERT' | ,,, | 'PANIC' SOURCE = 'USER' | 'PROGRAM' | 'SYSTEM' | 'FATAL' | 'ALL' | 'NONE' The SOURCE specification group all reasons which are usually related to the problem: report about problems caused by the user, reported by the program, or with system interaction. example: of expended REASONS WARNING-FAULT # == WARNING,MISTAKE,ERROR,FAULT WARNING,INFO # == WARNING,INFO -INFO # == TRACE-INFO ALERT- # == ALERT,FAILURE,PANIC USER # == MISTAKE,ERROR ALL # == TRACE-PANIC FATAL # == ERROR,FAULT,FAILURE,PANIC [1.07] NONE # == =item B($reason) Returns true if the $reason is severe enough to cause an exception (or program termination). =item B($name) Returns true if the STRING is one of the predefined REASONS. =item B($reason) =back =head2 Modes Run-modes are explained in Log::Report::Dispatcher. =over 4 =item B($mode) Returns something acceptable by L =item B($name|$mode) Returns the $mode as number. =item B($mode, $reason) =item B($mode, $reason) =back =head2 Other =over 4 =item B(STRING) Replace all escape characters into their readable counterpart. For instance, a new-line is replaced by backslash-n. =item B(STRING) Decompose a locale string. For simplicity of the caller's code, the capatization of the returned fields is standardized to the preferred, although the match is case- insensitive as required by the RFC. The territory in returned in capitals (ISO3166), the language is lower-case (ISO639), the script as upper-case first, the character-set as lower-case, and the modifier and variant unchanged. In LIST context, four elements are returned: language, territory, character-set (codeset), and modifier. Those four are important for the usual unix translationg infrastructure. Only the "country" is obligatory, the others can be C. It may also return C and C. In SCALAR context, a HASH is returned which can contain more information: language, script, territory, variant, codeset, and modifiers. The variant (RFC3066 is probably never used) =item B( $package, [$domain, $filename, $line] ) With $domain, $filename and $line, this registers a location where the textdomain is specified. Each $package can only belong to one $domain. Without these parameters, the registered domain for the $package is returned. =item B($string) [1.02] Escape HTML volatile characters. =item B(STRING) Replace all backslash-something escapes by their escape character. For instance, backslash-t is replaced by a tab character. =back =head1 SEE ALSO This module is part of Log-Report-Optional distribution version 1.07, built on January 15, 2021. Website: F =head1 LICENSE Copyrights 2013-2021 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-Optional-1.07/lib/Log/Report/Util.pm0000644000175000001440000001420414000255520021743 0ustar00markovusers00000000000000# Copyrights 2013-2021 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. # This code is part of distribution Log-Report-Optional. Meta-POD processed # with OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Util; use vars '$VERSION'; $VERSION = '1.07'; use base 'Exporter'; use warnings; use strict; use String::Print qw(printi); our @EXPORT = qw/ @reasons is_reason is_fatal use_errno mode_number expand_reasons mode_accepts must_show_location must_show_stack escape_chars unescape_chars to_html parse_locale pkg2domain /; # [0.994 parse_locale deprecated, but kept hidden] our @EXPORT_OK = qw/%reason_code/; #use Log::Report 'log-report'; sub N__w($) { split ' ', $_[0] } # ordered! our @reasons = N__w('TRACE ASSERT INFO NOTICE WARNING MISTAKE ERROR FAULT ALERT FAILURE PANIC'); our %reason_code; { my $i=1; %reason_code = map +($_ => $i++), @reasons } my %reason_set = ( ALL => \@reasons, FATAL => [ qw/ERROR FAULT FAILURE PANIC/ ], NONE => [ ], PROGRAM => [ qw/TRACE ASSERT INFO NOTICE WARNING PANIC/ ], SYSTEM => [ qw/FAULT ALERT FAILURE/ ], USER => [ qw/MISTAKE ERROR/ ], ); my %is_fatal = map +($_ => 1), @{$reason_set{FATAL}}; my %use_errno = map +($_ => 1), qw/FAULT ALERT FAILURE/; my %modes = (NORMAL => 0, VERBOSE => 1, ASSERT => 2, DEBUG => 3 , 0 => 0, 1 => 1, 2 => 2, 3 => 3); my @mode_accepts = ('NOTICE-', 'INFO-', 'ASSERT-', 'ALL'); # horrible mutual dependency with Log::Report(::Minimal) sub error__x($%) { if(Log::Report::Minimal->can('error')) # loaded the ::Mimimal version { Log::Report::Minimal::error(Log::Report::Minimal::__x(@_)) } else { Log::Report::error(Log::Report::__x(@_)) } } sub expand_reasons($) { my $reasons = shift or return (); $reasons = [ split m/\,/, $reasons ] if ref $reasons ne 'ARRAY'; my %r; foreach my $r (@$reasons) { if($r =~ m/^([a-z]*)\-([a-z]*)/i ) { my $begin = $reason_code{$1 || 'TRACE'}; my $end = $reason_code{$2 || 'PANIC'}; $begin && $end or error__x "unknown reason {which} in '{reasons}'" , which => ($begin ? $2 : $1), reasons => $reasons; error__x"reason '{begin}' more serious than '{end}' in '{reasons}" , begin => $1, end => $2, reasons => $reasons if $begin >= $end; $r{$_}++ for $begin..$end; } elsif($reason_code{$r}) { $r{$reason_code{$r}}++ } elsif(my $s = $reason_set{$r}) { $r{$reason_code{$_}}++ for @$s } else { error__x"unknown reason {which} in '{reasons}'" , which => $r, reasons => $reasons; } } (undef, @reasons)[sort {$a <=> $b} keys %r]; } sub is_reason($) { $reason_code{$_[0]} } sub is_fatal($) { $is_fatal{$_[0]} } sub use_errno($) { $use_errno{$_[0]} } #-------------------------- sub mode_number($) { $modes{$_[0]} } sub mode_accepts($) { $mode_accepts[$modes{$_[0]}] } sub must_show_location($$) { my ($mode, $reason) = @_; $reason eq 'ASSERT' || $reason eq 'PANIC' || ($mode==2 && $reason_code{$reason} >= $reason_code{WARNING}) || ($mode==3 && $reason_code{$reason} >= $reason_code{MISTAKE}); } sub must_show_stack($$) { my ($mode, $reason) = @_; $reason eq 'PANIC' || ($mode==2 && $reason_code{$reason} >= $reason_code{ALERT}) || ($mode==3 && $reason_code{$reason} >= $reason_code{ERROR}); } #------------------------- my %unescape = ( '\a' => "\a", '\b' => "\b", '\f' => "\f", '\n' => "\n" , '\r' => "\r", '\t' => "\t", '\"' => '"', '\\\\' => '\\' , '\e' => "\x1b", '\v' => "\x0b" ); my %escape = reverse %unescape; sub escape_chars($) { my $str = shift; $str =~ s/([\x00-\x1F\x7F"\\])/$escape{$1} || '?'/ge; $str; } sub unescape_chars($) { my $str = shift; $str =~ s/(\\.)/$unescape{$1} || $1/ge; $str; } my %tohtml = qw/ > gt < lt " quot & amp /; sub to_html($) { my $s = shift; $s =~ s/([<>"&])/\&${tohtml{$1}};/g; $s; } sub parse_locale($) { my $locale = shift; defined $locale && length $locale or return; if($locale !~ m/^ ([a-z_]+) (?: \. ([\w-]+) )? # codeset (?: \@ (\S+) )? # modifier $/ix) { # Windows Finnish_Finland.1252? $locale =~ s/.*\.//; return wantarray ? ($locale) : { language => $locale }; } my ($lang, $codeset, $modifier) = ($1, $2, $3); my @subtags = split /[_-]/, $lang; my $primary = lc shift @subtags; my $language = $primary eq 'c' ? 'C' : $primary eq 'posix' ? 'POSIX' : $primary =~ m/^[a-z]{2,3}$/ ? $primary # ISO639-1 and -2 : $primary eq 'i' && @subtags ? lc(shift @subtags) # IANA : $primary eq 'x' && @subtags ? lc(shift @subtags) # Private : error__x"unknown locale language in locale `{locale}'" , locale => $locale; my $script; $script = ucfirst lc shift @subtags if @subtags > 1 && length $subtags[0] > 3; my $territory = @subtags ? uc(shift @subtags) : undef; return ($language, $territory, $codeset, $modifier) if wantarray; +{ language => $language , script => $script , territory => $territory , codeset => $codeset , modifier => $modifier , variant => join('-', @subtags) }; } my %pkg2domain; sub pkg2domain($;$$$) { my $pkg = shift; my $d = $pkg2domain{$pkg}; @_ or return $d ? $d->[0] : 'default'; my ($domain, $fn, $line) = @_; if($d) { # registration already exists return $domain if $d->[0] eq $domain; printi "conflict: package {pkg} in {domain1} in {file1} line {line1}, but in {domain2} in {file2} line {line2}" , pkg => $pkg , domain1 => $domain, file1 => $fn, line1 => $line , domain2 => $d->[0], file2 => $d->[1], line2 => $d->[2]; } # new registration $pkg2domain{$pkg} = [$domain, $fn, $line]; $domain; } 1; Log-Report-Optional-1.07/lib/Log/Report/Minimal/0000755000175000001440000000000014000255521022056 5ustar00markovusers00000000000000Log-Report-Optional-1.07/lib/Log/Report/Minimal/Domain.pod0000644000175000001440000000311714000255520023772 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Minimal::Domain - administer one text-domain =head1 SYNOPSIS use Log::Report::Minimal::Domain; my $domain = Log::Report::Minimal::Domain->new(name => $name); # normal usage use Log::Report::Optional; # or Log::Report itself my $domain = textdomain $name; # find config textdomain $name, %configure; # set config, only once. =head1 DESCRIPTION Read L. =head1 METHODS =head2 Constructors =over 4 =item Log::Report::Minimal::Domain-EB(%options) -Option--Default name =over 2 =item name => STRING =back =back =head2 Attributes =over 4 =item $obj-EB(%options) -Option--Default where =over 2 =item where => ARRAY Specifies the location of the configuration. It is not allowed to configure a domain on more than one location. =back =item $obj-EB() =item $obj-EB() =back =head2 Action =over 4 =item $obj-EB( $msgid, [$args] ) Interpolate the keys used in C<$msgid> from the values in C<$args>. This is handled by the formatter, by default a L instance. =back =head1 SEE ALSO This module is part of Log-Report-Optional distribution version 1.07, built on January 15, 2021. Website: F =head1 LICENSE Copyrights 2013-2021 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-Optional-1.07/lib/Log/Report/Minimal/Domain.pm0000644000175000001440000000404414000255520023624 0ustar00markovusers00000000000000# Copyrights 2013-2021 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. # This code is part of distribution Log-Report-Optional. Meta-POD processed # with OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Minimal::Domain; use vars '$VERSION'; $VERSION = '1.07'; use warnings; use strict; use String::Print 'oo'; sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) } sub init($) { my ($self, $args) = @_; $self->{LRMD_name} = $args->{name} or Log::Report::panic(); $self; } #---------------- sub name() {shift->{LRMD_name}} sub isConfigured() {shift->{LRMD_where}} sub configure(%) { my ($self, %args) = @_; my $here = $args{where} || [caller]; if(my $s = $self->{LRMD_where}) { my $domain = $self->name; die "only one package can contain configuration; for $domain already in $s->[0] in file $s->[1] line $s->[2]. Now also found at $here->[1] line $here->[2]\n"; } my $where = $self->{LRMD_where} = $here; # documented in the super-class, the more useful man-page my $format = $args{formatter} || 'PRINTI'; $format = {} if $format eq 'PRINTI'; if(ref $format eq 'HASH') { my $class = delete $format->{class} || 'String::Print'; my $method = delete $format->{method} || 'sprinti'; my $sp = $class->new(%$format); $self->{LRMD_format} = sub { $sp->$method(@_) }; } elsif(ref $format eq 'CODE') { $self->{LRMD_format} = $format; } else { error __x"illegal formatter `{name}' at {fn} line {line}" , name => $format, fn => $where->[1], line => $where->[2]; } $self; } #------------------- sub interpolate(@) { my ($self, $msgid, $args) = @_; $args->{_expand} or return $msgid; my $f = $self->{LRMD_format} || $self->configure->{LRMD_format}; $f->($msgid, $args); } 1; Log-Report-Optional-1.07/lib/Log/Report/Optional.pm0000644000175000001440000000201514000255520022610 0ustar00markovusers00000000000000# Copyrights 2013-2021 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. # This code is part of distribution Log-Report-Optional. Meta-POD processed # with OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Optional; use vars '$VERSION'; $VERSION = '1.07'; use base 'Exporter'; use warnings; use strict; my ($supported, @used_by); BEGIN { if($INC{'Log/Report.pm'}) { $supported = 'Log::Report'; my $version = $Log::Report::VERSION; die "Log::Report too old for ::Optional, need at least 1.00" if $version && $version le '1.00'; } else { require Log::Report::Minimal; $supported = 'Log::Report::Minimal'; } } sub import(@) { my $class = shift; push @used_by, (caller)[0]; $supported->import('+1', @_); } sub usedBy() { @used_by } 1; Log-Report-Optional-1.07/lib/Log/Report/Optional.pod0000644000175000001440000000275214000255520022766 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Log::Report::Optional - pick Log::Report or ::Minimal =head1 INHERITANCE Log::Report::Optional is a Exporter =head1 SYNOPSIS # Use Log::Report when already loaded, otherwise Log::Report::Minimal package My::Package; use Log::Report::Optional 'my-domain'; =head1 DESCRIPTION This module will allow libraries (helper modules) to have a dependency to a small module instead of the full Log-Report distribution. The full power of C is only released when the main program uses that module. In that case, the module using the 'Optional' will also use the full Log::Report, otherwise the dressed-down L version. For the full documentation: =over 4 =item * see Log::Report when it is used by main =item * see L otherwise =back The latter provides the same functions from the former, but is the simpelest possible way. =head1 METHODS =over 4 =item Log::Report::Optional-EB() Returns the classes which loaded the optional module. =back =head1 SEE ALSO This module is part of Log-Report-Optional distribution version 1.07, built on January 15, 2021. Website: F =head1 LICENSE Copyrights 2013-2021 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-Optional-1.07/lib/Log/Report/Minimal.pm0000644000175000001440000001352314000255520022417 0ustar00markovusers00000000000000# Copyrights 2013-2021 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. # This code is part of distribution Log-Report-Optional. Meta-POD processed # with OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Minimal; use vars '$VERSION'; $VERSION = '1.07'; use base 'Exporter'; use warnings; use strict; use Log::Report::Util; use List::Util qw/first/; use Scalar::Util qw/blessed/; use Log::Report::Minimal::Domain (); ### if you change anything here, you also have to change Log::Report::Minimal my @make_msg = qw/__ __x __n __nx __xn N__ N__n N__w/; my @functions = qw/report dispatcher try textdomain/; my @reason_functions = qw/trace assert info notice warning mistake error fault alert failure panic/; our @EXPORT_OK = (@make_msg, @functions, @reason_functions); sub trace(@); sub assert(@); sub info(@); sub notice(@); sub warning(@); sub mistake(@); sub error(@); sub fault(@); sub alert(@); sub failure(@); sub panic(@); sub report(@); sub textdomain($@); sub __($); sub __x($@); sub __n($$$@); sub __nx($$$@); sub __xn($$$@); sub N__($); sub N__n($$); sub N__w(@); my ($mode, %need); sub need($) { $mode = shift; %need = map +($_ => 1), expand_reasons mode_accepts $mode; } need 'NORMAL'; my %textdomains; textdomain 'default'; sub _interpolate(@) { my ($msgid, %args) = @_; my $textdomain = $args{_domain}; unless($textdomain) { my ($pkg) = caller 1; $textdomain = pkg2domain $pkg; } (textdomain $textdomain)->interpolate($msgid, \%args); } # # Some initiations # sub textdomain($@) { if(@_==1 && blessed $_[0]) { my $domain = shift; return $textdomains{$domain->name} = $domain; } if(@_==2) { # used for 'maintenance' and testing return delete $textdomains{$_[0]} if $_[1] eq 'DELETE'; return $textdomains{$_[0]} if $_[1] eq 'EXISTS'; } my $name = shift; my $domain = $textdomains{$name} ||= Log::Report::Minimal::Domain->new(name => $name); @_ ? $domain->configure(@_, where => [caller]) : $domain; } # $^S = $EXCEPTIONS_BEING_CAUGHT; parse: undef, eval: 1, else 0 sub _report($$@) { my ($opts, $reason) = (shift, shift); # return when no-one needs it: skip unused trace() fast! my $stop = exists $opts->{is_fatal} ? $opts->{is_fatal} : is_fatal $reason; $need{$reason} || $stop or return; is_reason $reason or error __x"token '{token}' not recognized as reason", token=>$reason; $opts->{errno} ||= $!+0 || $? || 1 if use_errno($reason) && !defined $opts->{errno}; my $message = shift; @_%2 and error __x"odd length parameter list with '{msg}'", msg => $message; my $show = lc($reason).': '.$message; if($stop) { # ^S = EXCEPTIONS_BEING_CAUGHT, within eval or try $! = $opts->{errno} || 0; die "$show\n"; # call the die handler } else { warn "$show\n"; # call the warn handler } 1; } sub dispatcher($@) { panic "no dispatchers available in ".__PACKAGE__ } sub try(&@) { my $code = shift; @_ % 2 and report {}, PANIC => __x"odd length parameter list for try(): forgot the terminating ';'?"; #XXX MO: only needs the fatal subset, exclude the warns/prints eval { $code->() }; } sub report(@) { my %opt = @_ && ref $_[0] eq 'HASH' ? %{ (shift) } : (); _report \%opt, @_; } sub trace(@) {_report {}, TRACE => @_} sub assert(@) {_report {}, ASSERT => @_} sub info(@) {_report {}, INFO => @_} sub notice(@) {_report {}, NOTICE => @_} sub warning(@) {_report {}, WARNING => @_} sub mistake(@) {_report {}, MISTAKE => @_} sub error(@) {_report {}, ERROR => @_} sub fault(@) {_report {}, FAULT => @_} sub alert(@) {_report {}, ALERT => @_} sub failure(@) {_report {}, FAILURE => @_} sub panic(@) {_report {}, PANIC => @_} sub __($) { shift } sub __x($@) { @_%2 or error __x"even length parameter list for __x at {where}" , where => join(' line ', (caller)[1,2]); _interpolate @_, _expand => 1; } sub __n($$$@) { my ($single, $plural, $count) = (shift, shift, shift); _interpolate +($count==1 ? $single : $plural) , _count => $count, @_; } sub __nx($$$@) { my ($single, $plural, $count) = (shift, shift, shift); _interpolate +($count==1 ? $single : $plural) , _count => $count, _expand => 1, @_; } sub __xn($$$@) # repeated for prototype { my ($single, $plural, $count) = (shift, shift, shift); _interpolate +($count==1 ? $single : $plural) , _count => $count , _expand => 1, @_; } sub N__($) { $_[0] } sub N__n($$) {@_} sub N__w(@) {split " ", $_[0]} #------------------ sub import(@) { my $class = shift; my $to_level = @_ && $_[0] =~ m/^\+\d+$/ ? shift : 0; my $textdomain = @_%2 ? shift : 'default'; my %opts = @_; my $syntax = delete $opts{syntax} || 'SHORT'; my ($pkg, $fn, $linenr) = caller $to_level; pkg2domain $pkg, $textdomain, $fn, $linenr; my $domain = textdomain $textdomain; need delete $opts{mode} if defined $opts{mode}; my @export; if(my $in = $opts{import}) { push @export, ref $in eq 'ARRAY' ? @$in : $in; } else { push @export, @functions, @make_msg; my $syntax = delete $opts{syntax} || 'SHORT'; if($syntax eq 'SHORT') { push @export, @reason_functions } elsif($syntax ne 'REPORT' && $syntax ne 'LONG') { error __x"syntax flag must be either SHORT or REPORT, not `{flag}'" , flag => $syntax; } } $class->export_to_level(1+$to_level, undef, @export); $domain->configure(%opts, where => [$pkg, $fn, $linenr ]) if %opts; } 1; Log-Report-Optional-1.07/MANIFEST0000644000175000001440000000100414000255521017052 0ustar00markovusers00000000000000ChangeLog MANIFEST Makefile.PL README README.md lib/Log/Report/Minimal.pm lib/Log/Report/Minimal.pod lib/Log/Report/Minimal/Domain.pm lib/Log/Report/Minimal/Domain.pod lib/Log/Report/Optional.pm lib/Log/Report/Optional.pod lib/Log/Report/Util.pm lib/Log/Report/Util.pod t/00use.t t/05util.t t/20exceptions.t t/21messages.t t/50options.t xt/99pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Log-Report-Optional-1.07/xt/0000755000175000001440000000000014000255521016361 5ustar00markovusers00000000000000Log-Report-Optional-1.07/xt/99pod.t0000644000175000001440000000041614000255520017512 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-Optional-1.07/README.md0000644000175000001440000000442414000255520017210 0ustar00markovusers00000000000000# distribution Log-Report-Optional * My extended documentation: * Development via GitHub: * Download from CPAN: * Indexed from CPAN: This module will allow libraries (helper modules) to have a dependency to a small module instead of the full Log-Report distribution. The full power of "Log::Report" is only released when the main program uses that module. In that case, the module using the 'Optional' will also use the full "Log::Report", otherwise the dressed-down "Log::Report::Minimal" version. ## Development → Release Important to know, is that I use an extension on POD to write the manuals. The "raw" unprocessed version is visible on GitHub. It will run without problems, but does not contain manual-pages. Releases to CPAN are different: "raw" documentation gets removed from the code and translated into real POD and clean HTML. This reformatting is implemented with the OODoc distribution (A name I chose before OpenOffice existed, sorry for the confusion) Clone from github for the "raw" version. For instance, when you want to contribute a new feature. On github, you can find the processed version for each release. But the better source is CPAN; to get it installed simply run: ```sh cpan -i Log::Report::Optional ``` ## Contributing When you want to contribute to this module, you do not need to provide a perfect patch... actually: it is nearly impossible to create a patch which I will merge without modification. Usually, I need to adapt the style of code and documentation to my own strict rules. When you submit an extension, please contribute a set with 1. code 2. code documentation 3. regression tests in t/ **Please note:** When you contribute in any way, you agree to transfer the copyrights to Mark Overmeer (you will get the honors in the code and/or ChangeLog). You also automatically agree that your contribution is released under the same license as this project: licensed as perl itself. ## Copyright and License This project is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See Log-Report-Optional-1.07/ChangeLog0000644000175000001440000000245414000255520017504 0ustar00markovusers00000000000000========== version history of Log::Report::Optional Unless noted otherwise, these changes where initiated and applied by Mark Overmeer. version 1.07: Fri 15 Jan 09:57:35 CET 2021 Improvements: - expand_reasons 'FATAL' [Andrew Beverley] - expand_reasons 'NONE' - expand_reasons with ARRAY or undef version 1.06: Fri 2 Feb 08:53:01 CET 2018 Fixes: - fix metadata [Mohammad S Anwar] - Accidentally removed from CPAN version 1.05: Tue Jan 23 22:44:26 CET 2018 Improvements: - convert to GIT - publish via GitHUB version 1.04: Mon 30 Oct 17:37:49 CET 2017 accidentally removed 1.03 from CPAN version 1.03: Tue 27 Jun 16:39:41 CEST 2017 Fixes: - manpage, change SYNOPSYS into SYNOPSIS rt.cpan.org#113351 [Shlomi Fish] - formatter PRINTP cannot be used Improvements: - more flexible formatter construction - textdomain compatible with full implementation - changed formatter constructor to be more flexible version 1.02: Mon 18 Jan 13:53:03 CET 2016 Improvements: - add ::Util::to_html() version 1.01: Mon Mar 10 16:10:25 CET 2014 Fixes: - ::Util cannot use error or __x, mutual dependencies do not work [Patrick Goldmann] Improvements: - changed documentation style - die if Log::Report is used and too old version 1.00: Sun Jan 5 17:02:42 CET 2014 - Split-off from Log::Report Log-Report-Optional-1.07/README0000644000175000001440000000151214000255520016604 0ustar00markovusers00000000000000=== README for Log-Report-Optional version 1.07 = Generated on Fri Jan 15 10:07:28 2021 by OODoc 2.02 There are various ways to install this module: (1) if you have a command-line, you can do: perl -MCPAN -e 'install ' (2) if you use Windows, have a look at http://ppm.activestate.com/ (3) if you have downloaded this module manually (as root/administrator) gzip -d Log-Report-Optional-1.07.tar.gz tar -xf Log-Report-Optional-1.07.tar cd Log-Report-Optional-1.07 perl Makefile.PL make # optional make test # optional make install For usage, see the included manual-pages or http://search.cpan.org/dist/Log-Report-Optional-1.07/ Please report problems to http://rt.cpan.org/Dist/Display.html?Queue=Log-Report-Optional Log-Report-Optional-1.07/Makefile.PL0000644000175000001440000000252714000255520017705 0ustar00markovusers00000000000000use ExtUtils::MakeMaker; use 5.008; my $version = '1.07'; my %prereq = ( Test::More => '0.86' , String::Print => '0.91' # Optional dependency to Log::Report handled in ::Optional. It is hard # to make that work automatically, where Perl's install tools cannot # handle recursive dependencies. ); WriteMakefile ( NAME => 'Log::Report::Optional' , VERSION => $version , PREREQ_PM => \%prereq , AUTHOR => 'Mark Overmeer ' , ABSTRACT => 'Log::Report in the lightest form' , LICENSE => 'perl_5' , META_MERGE => { 'meta-spec' => { version => 2 } , resources => { repository => { type => 'git' , url => 'https://github.com/markov2/perl5-Log-Report-Optional.git' , web => 'https://github.com/markov2/perl5-Log-Report-Optional' } , homepage => 'http://perl.overmeer.net/CPAN/' , license => [ 'http://dev.perl.org/licenses/' ] } } ); sub MY::postamble { <<'__POSTAMBLE' } # for OODoc's oodist, DIST RAWDIR = ../public_html/log-report-optional/raw DISTDIR = ../public_html/log-report-optional/source # for OODoc's oodist, POD FIRST_YEAR = 2013 EMAIL = markov@cpan.org WEBSITE = http://perl.overmeer.net/CPAN/ EXTENDS = ../String-Print __POSTAMBLE Log-Report-Optional-1.07/META.yml0000644000175000001440000000137014000255521017200 0ustar00markovusers00000000000000--- abstract: 'Log::Report in the lightest form' author: - 'Mark Overmeer ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Log-Report-Optional no_index: directory: - t - inc requires: String::Print: '0.91' Test::More: '0.86' resources: homepage: http://perl.overmeer.net/CPAN/ license: http://dev.perl.org/licenses/ repository: https://github.com/markov2/perl5-Log-Report-Optional.git version: '1.07' x_serialization_backend: 'CPAN::Meta::YAML version 0.011' Log-Report-Optional-1.07/META.json0000644000175000001440000000246714000255521017360 0ustar00markovusers00000000000000{ "abstract" : "Log::Report in the lightest form", "author" : [ "Mark Overmeer " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Log-Report-Optional", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "String::Print" : "0.91", "Test::More" : "0.86" } } }, "release_status" : "stable", "resources" : { "homepage" : "http://perl.overmeer.net/CPAN/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "https://github.com/markov2/perl5-Log-Report-Optional.git", "web" : "https://github.com/markov2/perl5-Log-Report-Optional" } }, "version" : "1.07", "x_serialization_backend" : "JSON::PP version 2.94" }