diff -pruN 1.12-1/ChangeLog 1.14-1/ChangeLog --- 1.12-1/ChangeLog 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/ChangeLog 2025-09-08 13:31:48.000000000 +0000 @@ -16,6 +16,32 @@ bugs: wishlist: - let xgettext-perl produce mo files as well. +version 1.14: Mon 8 Sep 15:31:33 CEST 2025 + + Changes: + - require Perl 5.16 (2012) + + Fixes: + - fix pod2usage + github merge#3 [Sam Kington] + - understand 'use Log::Report' with minimal required version number + github merge#4 and #5 [Sam Kington] + + Improvements: + - convert to OODoc 3.03 + +version 1.13: Tue 6 May 09:49:55 CEST 2025 + + Changes: + - move Log::Report::Extract::Template to Log::Report::Template::Extract.pm + in distribution Log-Report-Template. + + Fixes: + - --no-cleanup option was broken. + + Improvements: + - ::Extract::write() passes options to ::Lexicon writers. + version 1.12: Fri 18 Apr 17:10:11 CEST 2025 Fixes: diff -pruN 1.12-1/MANIFEST 1.14-1/MANIFEST --- 1.12-1/MANIFEST 2025-04-18 15:10:25.000000000 +0000 +++ 1.14-1/MANIFEST 2025-09-08 13:31:52.000000000 +0000 @@ -2,6 +2,7 @@ ChangeLog MANIFEST Makefile.PL README +README.txt bin/xgettext-perl lib/Log/Report/Extract.pm lib/Log/Report/Extract.pod @@ -43,6 +44,7 @@ t/21pot_modif.t t/22compact.t t/30index.t t/40ppi.t +t/41ppi_imports.t t/41templ.t t/hello-world-slovak.po t/simplecal/README diff -pruN 1.12-1/META.json 1.14-1/META.json --- 1.12-1/META.json 2025-04-18 15:10:25.000000000 +0000 +++ 1.14-1/META.json 2025-09-08 13:31:51.000000000 +0000 @@ -30,6 +30,11 @@ "ExtUtils::MakeMaker" : "0" } }, + "develop" : { + "requires" : { + "OODoc" : "3.00" + } + }, "runtime" : { "requires" : { "Data::Dumper" : "0", @@ -41,26 +46,60 @@ "File::Temp" : "0", "IO::File" : "0", "List::Util" : "0", - "Log::Report" : "1.22", + "Log::Report" : "1.4", "POSIX" : "0", "Pod::Usage" : "0", "Scalar::Util" : "0", "Test::More" : "0.86" } + }, + "test" : { + "requires" : { + "Test::More" : "1", + "Test::Pod" : "1" + } } }, "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-Lexicon.git", "web" : "https://github.com/markov2/perl5-Log-Report-Lexicon" } }, - "version" : "1.12", + "version" : "1.14", + "x_oodist" : { + "email" : "markov@cpan.org", + "first_year" : 2007, + "generate" : [ + { + "format" : "pod3", + "podtail" : null + } + ], + "include" : [ + "../String-Print", + "../Log-Report-Optional" + ], + "oodoc_version" : 3.03, + "parser" : { + "pmhead" : null, + "skip_links" : [], + "syntax" : "markov" + }, + "raw" : { + "publish" : "../public_html/log-report-lexicon/raw" + }, + "release" : { + "publish" : "../public_html/log-report-lexicon/source" + }, + "tests" : {}, + "use" : [ + "../Log-Report", + "../Log-Report-Template" + ] + }, "x_serialization_backend" : "JSON::PP version 4.16" } diff -pruN 1.12-1/META.yml 1.14-1/META.yml --- 1.12-1/META.yml 2025-04-18 15:10:25.000000000 +0000 +++ 1.14-1/META.yml 2025-09-08 13:31:51.000000000 +0000 @@ -4,6 +4,8 @@ author: - 'Mark Overmeer ' build_requires: ExtUtils::MakeMaker: '0' + Test::More: '1' + Test::Pod: '1' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 @@ -27,14 +29,36 @@ requires: File::Temp: '0' IO::File: '0' List::Util: '0' - Log::Report: '1.22' + Log::Report: '1.4' POSIX: '0' Pod::Usage: '0' Scalar::Util: '0' 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-Lexicon.git -version: '1.12' +version: '1.14' +x_oodist: + email: markov@cpan.org + first_year: 2007 + generate: + - + format: pod3 + podtail: ~ + include: + - ../String-Print + - ../Log-Report-Optional + oodoc_version: 3.03 + parser: + pmhead: ~ + skip_links: [] + syntax: markov + raw: + publish: ../public_html/log-report-lexicon/raw + release: + publish: ../public_html/log-report-lexicon/source + tests: {} + use: + - ../Log-Report + - ../Log-Report-Template x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -pruN 1.12-1/Makefile.PL 1.14-1/Makefile.PL --- 1.12-1/Makefile.PL 2025-04-14 17:23:53.000000000 +0000 +++ 1.14-1/Makefile.PL 2025-09-08 13:31:48.000000000 +0000 @@ -1,71 +1,117 @@ use ExtUtils::MakeMaker; -use 5.010; +use 5.016; -my $version = '1.12'; - -my %prereq = - ( Test::More => '0.86' - , Data::Dumper => 0 - , Fcntl => 0 - , File::Basename => 0 - , File::Find => 0 - , File::Spec => 0 - , File::Temp => 0 - , IO::File => 0 - , List::Util => 0 - , Scalar::Util => 0 - , Log::Report => 1.22 - , Pod::Usage => 0 - , POSIX => 0 - , Encode => 0 - - # sometimes needed, dependencies too large - # PPI - # Locale::gettext - ); +# Use command 'oodist' to produce your whole software release. +my $version = '1.14'; +my $git = "https://github.com/markov2/perl5-Log-Report-Lexicon"; +my $publish = "../public_html/log-report-lexicon"; +my $homepage = "http://perl.overmeer.net/CPAN/"; + +my %oodist = ( + oodoc_version => 3.03, + first_year => 2007, + email => "markov\@cpan.org", + + include => [ + '../String-Print', + '../Log-Report-Optional', + ], + + use => [ + '../Log-Report', + '../Log-Report-Template', + ], + + parser => { + syntax => 'markov', + skip_links => [ ], + pmhead => undef, + }, + + tests => { + }, + + release => { + publish => "$publish/source", + }, + + raw => { + publish => "$publish/raw", + }, + + generate => [ { + # Add real pod to the releases + format => 'pod3', + podtail => undef, + }, + # You may add HTML formatters here. + # You may add exporter configurations here. + ], +); + +my %prereq = ( + 'Test::More' => '0.86', + 'Data::Dumper' => 0, + 'Fcntl' => 0, + 'File::Basename' => 0, + 'File::Find' => 0, + 'File::Spec' => 0, + 'File::Temp' => 0, + 'IO::File' => 0, + 'List::Util' => 0, + 'Scalar::Util' => 0, + 'Log::Report' => 1.40, + 'Pod::Usage' => 0, + 'POSIX' => 0, + 'Encode' => 0, + + # sometimes needed, dependencies too large + # PPI + # Locale::gettext +); $prereq{ 'Win32::TieRegistry' } = 0.24 if $^O eq 'MSWin32'; WriteMakefile - ( NAME => 'Log::Report::Lexicon' - , VERSION => $version - , PREREQ_PM => \%prereq - , EXE_FILES => [ 'bin/xgettext-perl' ] - - , AUTHOR => 'Mark Overmeer ' - , ABSTRACT => 'Log::Report translation table management' - , LICENSE => 'perl_5' - - , META_MERGE => - { 'meta-spec' => { version => 2 } - , resources => - { repository => - { type => 'git' - , url => 'https://github.com/markov2/perl5-Log-Report-Lexicon.git' - , web => 'https://github.com/markov2/perl5-Log-Report-Lexicon' - } - , 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-lexicon/raw -DISTDIR = ../public_html/log-report-lexicon/source - -# for OODoc's oodist, POD -FIRST_YEAR = 2007 -EMAIL = markov@cpan.org -WEBSITE = http://perl.overmeer.net/CPAN/ -EXTENDS = ../Log-Report-Optional:../String-Print:../Log-Report:../Log-Report-Template - -__POSTAMBLE + NAME => 'Log::Report::Lexicon', + VERSION => $version, + PREREQ_PM => \%prereq, + EXE_FILES => [ 'bin/xgettext-perl' ], + + AUTHOR => 'Mark Overmeer ', + ABSTRACT => 'Log::Report translation table management', + LICENSE => 'perl_5', + + META_MERGE => { + 'meta-spec' => { version => 2 }, + resources => { + repository => { + type => 'git', + url => "$git.git", + web => $git, + }, + homepage => $homepage, + license => [ 'http//dev.perl.org/licenses/' ], + }, + prereqs => { + develop => { + requires => { + 'OODoc' => '3.00', + } + }, + test => { + requires => { + 'Test::More' => 1.00, + 'Test::Pod' => 1.00, + } + }, + }, + + # You may use multiple set-ups, see "oodist --make" + x_oodist => \%oodist, + }; # for translation tables #linkext:: diff -pruN 1.12-1/README.txt 1.14-1/README.txt --- 1.12-1/README.txt 1970-01-01 00:00:00.000000000 +0000 +++ 1.14-1/README.txt 2025-09-08 13:27:12.000000000 +0000 @@ -0,0 +1,24 @@ +=== README for Log-Report-Lexicon version 1.14 += Generated on Mon Sep 8 15:27:12 2025 by OODoc 3.04 + +There are various ways to install this module: + + (1) if you have a command-line, you can do: + cpan -i ' + + (2) if you use Windows, have a look at https://strawberryperl.com + + (3) if you have downloaded this module manually (as root/administrator) + tar -xzf Log-Report-Lexicon-1.14.tar.gz + cd Log-Report-Lexicon-1.14 + perl Makefile.PL + make # optional + make test # optional + make install + +References: + + * For usage, see the included manual-pages or https://metacpan.org/dist/Log-Report-Lexicon + * This project has a website at http://perl.overmeer.net/CPAN/ + * The source repository can be found at https://github.com/markov2/perl5-Log-Report-Lexicon + * Please report issues via https://github.com/markov2/perl5-Log-Report-Lexicon/issues diff -pruN 1.12-1/bin/xgettext-perl 1.14-1/bin/xgettext-perl --- 1.12-1/bin/xgettext-perl 2025-04-10 08:55:41.000000000 +0000 +++ 1.14-1/bin/xgettext-perl 2025-09-08 13:22:16.000000000 +0000 @@ -20,7 +20,7 @@ my ($char_in, $char_out) = ('utf-8', 'ut my ($default_domain, $mode, $template); GetOptions - 'cleanup!' => $cleanup # kill transl from removed files, def true + 'cleanup!' => \$cleanup # kill transl from removed files, def true , 'config|c=s' => \%configs # domain configurations , 'domain|d=s' => \$default_domain # for templates , 'files-from|f=s' => \$from # file with filenames (MANIFEST?) or '-' @@ -35,14 +35,14 @@ GetOptions , 'verbose=i' => \$mode , 'version|V' => \$version , 'v+' => \$mode - or pod2usage(1); + or exit 1; if($version) { print "Log::Report $Log::Report::VERSION\n"; exit 0; } -$help && podusage(0); +$help && pod2usage(0); # Load domain information, for instance defining context_rules. The # definitions are global, so automatically find their way in the Log::Report @@ -98,14 +98,14 @@ my $extr; my %processed; if($template) -{ # process from template - eval "require Log::Report::Extract::Template"; +{ # process from template toolkit + eval "require Log::Report::Template::Extract"; panic $@ if $@; $default_domain or error __x"specify a text-domain (-d) for the templates"; - $extr = Log::Report::Extract::Template->new + $extr = Log::Report::Template::Extract->new ( lexicon => $output , charset => $char_out , domain => $default_domain @@ -144,6 +144,7 @@ else } } +warn "CLEANUP KEEP=$cleanup"; $extr->cleanup(keep => \%processed) if $cleanup; @@ -174,11 +175,11 @@ xgettext-perl - extract translatable str TEMPLATE OPTIONS --domain -d $domain domain to be used --template -t $notation how to recognize the strings to be taken - --files-match -m $regex filter filenames, default .pm and .pl + --files-match -m $regex filter filenames, default .tt and .tt2 SCRIPT OPTIONS --language -L $proglang programming language syntax (now only perl) - --files-match -m $regex filter filenames, default .tt and .tt2 + --files-match -m $regex filter filenames, default .pm and .pl =head1 DESCRIPTION @@ -198,7 +199,7 @@ context sensitive translations, which re See Log::Report::Context Say, your scripts and templates use textdomain name-spaces C -and C (plase use better names), then you can pass their +and C (please use better names), then you can pass their respective configuration files as: --config domain1=filename domain2=filename # or @@ -221,6 +222,6 @@ notation (with leading '__' to mean gett =head2 Extracting from Template::Toolkit -See L + See L =cut diff -pruN 1.12-1/debian/changelog 1.14-1/debian/changelog --- 1.12-1/debian/changelog 2025-04-24 23:07:00.000000000 +0000 +++ 1.14-1/debian/changelog 2025-10-04 21:51:25.000000000 +0000 @@ -1,3 +1,19 @@ +liblog-report-lexicon-perl (1.14-1) unstable; urgency=medium + + * Import upstream version 1.14. + * Update test dependencies. + + -- gregor herrmann Sat, 04 Oct 2025 23:51:25 +0200 + +liblog-report-lexicon-perl (1.13-1) unstable; urgency=medium + + * Import upstream version 1.13. + * Make test and runtime dependency on liblog-report-perl versioned. + * Remove «Rules-Requires-Root: no», which is the current default. + * Remove «Priority: optional», which is the current default. + + -- gregor herrmann Sat, 04 Oct 2025 23:28:22 +0200 + liblog-report-lexicon-perl (1.12-1) unstable; urgency=medium * Import upstream version 1.12. diff -pruN 1.12-1/debian/control 1.14-1/debian/control --- 1.12-1/debian/control 2025-04-24 23:07:00.000000000 +0000 +++ 1.14-1/debian/control 2025-10-04 21:51:25.000000000 +0000 @@ -1,28 +1,32 @@ Source: liblog-report-lexicon-perl +Standards-Version: 4.7.2 Maintainer: Debian Perl Group -Uploaders: gregor herrmann +Uploaders: + gregor herrmann , Section: perl Testsuite: autopkgtest-pkg-perl -Priority: optional -Build-Depends: debhelper-compat (= 13) -Build-Depends-Indep: liblog-report-perl , - libppi-perl , - locales-all , - perl -Standards-Version: 4.7.2 +Build-Depends: + debhelper-compat (= 13), +Build-Depends-Indep: + liblog-report-perl (>= 1.40) , + libppi-perl , + libtest-simple-perl , + locales-all , + perl, Vcs-Browser: https://salsa.debian.org/perl-team/modules/packages/liblog-report-lexicon-perl Vcs-Git: https://salsa.debian.org/perl-team/modules/packages/liblog-report-lexicon-perl.git Homepage: https://metacpan.org/release/Log-Report-Lexicon -Rules-Requires-Root: no Package: liblog-report-lexicon-perl Architecture: all -Depends: ${misc:Depends}, - ${perl:Depends}, - liblog-report-perl -Suggests: gettext, - liblocale-gettext-perl, - libppi-perl +Depends: + ${misc:Depends}, + ${perl:Depends}, + liblog-report-perl (>= 1.40), +Suggests: + gettext, + liblocale-gettext-perl, + libppi-perl, Description: module for Log::Report translation table management Log::Report::Lexicon contains all components of Log::Report which handle translations. diff -pruN 1.12-1/lib/Log/Report/Extract/PerlPPI.pm 1.14-1/lib/Log/Report/Extract/PerlPPI.pm --- 1.12-1/lib/Log/Report/Extract/PerlPPI.pm 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/lib/Log/Report/Extract/PerlPPI.pm 2025-09-08 13:31:48.000000000 +0000 @@ -1,13 +1,20 @@ -# Copyrights 2007-2025 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.03. -# This code is part of distribution Log-Report-Lexicon. 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. +# This code is part of Perl distribution Log-Report-Lexicon version 1.14. +# The POD got stripped from this file by OODoc version 3.04. +# For contributors see file ChangeLog. + +# This software is copyright (c) 2007-2025 by Mark Overmeer. + +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later + +#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION *** +#oodist: This file contains OODoc-style documentation which will get stripped +#oodist: during its release in the distribution. You can use this file for +#oodist: testing, however the code of this development version may be broken! package Log::Report::Extract::PerlPPI;{ -our $VERSION = '1.12'; +our $VERSION = '1.14'; } use base 'Log::Report::Extract'; @@ -19,184 +26,182 @@ use Log::Report 'log-report-lexicon'; use PPI; # See Log::Report translation markup functions -my %msgids = - # MSGIDs COUNT OPTS VARS SPLIT - ( __ => [1, 0, 0, 0, 0] - , __x => [1, 0, 1, 1, 0] - , __xn => [2, 1, 1, 1, 0] - , __nx => [2, 1, 1, 1, 0] - , __n => [2, 1, 1, 0, 0] - , N__ => [1, 0, 1, 1, 0] # may be used with opts/vars - , N__n => [2, 0, 1, 1, 0] # idem - , N__w => [1, 0, 0, 0, 1] - ); +my %msgids = ( +# MSGIDs COUNT OPTS VARS SPLIT + __ => [1, 0, 0, 0, 0], + __x => [1, 0, 1, 1, 0], + __xn => [2, 1, 1, 1, 0], + __nx => [2, 1, 1, 1, 0], + __n => [2, 1, 1, 0, 0], + N__ => [1, 0, 1, 1, 0], # may be used with opts/vars + N__n => [2, 0, 1, 1, 0], # idem + N__w => [1, 0, 0, 0, 1], +); my $quote_mistake; -{ my @q = map quotemeta, keys %msgids; - local $" = '|'; - $quote_mistake = qr/^(?:@q)\'/; +{ my @q = map quotemeta, keys %msgids; + local $" = '|'; + $quote_mistake = qr/^(?:@q)\'/; } +#-------------------- + sub process($@) -{ my ($self, $fn, %opts) = @_; +{ my ($self, $fn, %opts) = @_; - my $charset = $opts{charset} || 'iso-8859-1'; + my $charset = $opts{charset} || 'iso-8859-1'; # $charset eq 'iso-8859-1' # or error __x"PPI only supports iso-8859-1 (latin-1) on the moment"; - my $doc = PPI::Document->new($fn, readonly => 1) - or fault __x"cannot read perl from file {filename}", filename => $fn; + my $doc = PPI::Document->new($fn, readonly => 1) + or fault __x"cannot read perl from file {filename}", filename => $fn; - my @childs = $doc->schildren; - if(@childs==1 && ref $childs[0] eq 'PPI::Statement') - { info __x"no Perl in file {filename}", filename => $fn; - return 0; - } - - info __x"processing file {fn} in {charset}", fn=> $fn, charset => $charset; - my ($pkg, $include, $domain, $msgs_found) = ('main', 0, undef, 0); - - NODE: - foreach my $node ($doc->schildren) - { if($node->isa('PPI::Statement::Package')) - { $pkg = $node->namespace; - - # special hack needed for module Log::Report itself - if($pkg eq 'Log::Report') - { ($include, $domain) = (1, 'log-report'); - $self->_reset($domain, $fn); - } - else { ($include, $domain) = (0, undef) } - next NODE; - } + my @childs = $doc->schildren; + if(@childs==1 && ref $childs[0] eq 'PPI::Statement') + { info __x"no Perl in file {filename}", filename => $fn; + return 0; + } + + info __x"processing file {fn} in {charset}", fn=> $fn, charset => $charset; + my ($pkg, $include, $domain, $msgs_found) = ('main', 0, undef, 0); + +NODE: + foreach my $node ($doc->schildren) + { if($node->isa('PPI::Statement::Package')) + { $pkg = $node->namespace; + + # special hack needed for module Log::Report itself + if($pkg eq 'Log::Report') + { ($include, $domain) = (1, 'log-report'); + $self->_reset($domain, $fn); + } + else { ($include, $domain) = (0, undef) } + next NODE; + } # Take domains which are as first parameter after 'use Log::Report' - if($node->isa('PPI::Statement::Include')) - { $node->type eq 'use' - or next NODE; - - my $module = $node->module; - $module eq 'Log::Report' || $module eq 'Dancer2::Plugin::LogReport' - or next NODE; - - $include++; - my $dom = ($node->schildren)[2]; - $domain - = $dom->isa('PPI::Token::Quote') ? $dom->string - : $dom->isa('PPI::Token::QuoteLike::Words') ? ($dom->literal)[0] - : undef; - - $self->_reset($domain, $fn) - if defined $domain; - } - - $node->find_any( sub { - # look for the special translation markers - $_[1]->isa('PPI::Token::Word') or return 0; - - my $node = $_[1]; - my $word = $node->content; - if($word =~ $quote_mistake) - { warning __x"use double quotes not single, in {string} on {file} line {line}" - , string => $word, fn => $fn, line => $node->location->[0]; - return 0; - } + if($node->isa('PPI::Statement::Include')) + { $node->type eq 'use' + or next NODE; + + my $module = $node->module; + $module eq 'Log::Report' || $module eq 'Dancer2::Plugin::LogReport' + or next NODE; + + $include++; + if(my $dom = ($node->arguments)[0]) { + $domain + = $dom->isa('PPI::Token::Quote') ? $dom->string + : $dom->isa('PPI::Token::QuoteLike::Words') ? ($dom->literal)[0] + : undef; + } + + $self->_reset($domain, $fn) + if defined $domain; + } + + $node->find_any( sub { + # look for the special translation markers + $_[1]->isa('PPI::Token::Word') or return 0; + + my $node = $_[1]; + my $word = $node->content; + if($word =~ $quote_mistake) + { warning __x"use double quotes not single, in {string} on {file} line {line}", + string => $word, fn => $fn, line => $node->location->[0]; + return 0; + } - my $def = $msgids{$word} # get __() description - or return 0; + my $def = $msgids{$word} # get __() description + or return 0; # Avoid the declaration of the conversion routines in Log::Report $domain ne 'log-report' || ! $node->parent->isa('PPI::Statement::Sub') or return 0; - my @msgids = $self->_get($node, $domain, $word, $def) - or return 0; - - my ($nr_msgids, $has_count, $has_opts, $has_vars,$do_split) = @$def; - - my $line = $node->location->[0]; - unless($domain) - { mistake __x"no text-domain for translatable at {fn} line {line}", fn => $fn, line => $line; - return 0; - } - - my @records = $do_split - ? (map +[$_], map {split} @msgids) # Bulk conversion strings - : \@msgids; + my @msgids = $self->_get($node, $domain, $word, $def) + or return 0; - $msgs_found += @records; - $self->store($domain, $fn, $line, @$_) for @records; + my ($nr_msgids, $has_count, $has_opts, $has_vars,$do_split) = @$def; - 0; # don't collect - }); - } + my $line = $node->location->[0]; + unless($domain) + { mistake __x"no text-domain for translatable at {fn} line {line}", fn => $fn, line => $line; + return 0; + } + + my @records = $do_split + ? (map +[$_], map { split } @msgids) # Bulk conversion strings + : \@msgids; + + $msgs_found += @records; + $self->store($domain, $fn, $line, @$_) for @records; + + 0; # don't collect + }); + } - $msgs_found; + $msgs_found; } sub _get($$$$) -{ my ($self, $node, $domain, $function, $def) = @_; - my ($nr_msgids, $has_count, $opts, $vars, $split) = @$def; - my $list_only = ($nr_msgids > 1) || $has_count || $opts || $vars; - my $expand = $opts || $vars; - - my @msgids; - my $first = $node->snext_sibling; - $first = $first->schild(0) - if $first->isa('PPI::Structure::List'); - - $first = $first->schild(0) - if $first->isa('PPI::Statement::Expression'); - - my $line; - while(defined $first && $nr_msgids > @msgids) - { my $msgid; - my $next = $first->snext_sibling; - my $sep = $next && $next->isa('PPI::Token::Operator') ? $next : ''; - $line = $first->location->[0]; - - if($first->isa('PPI::Token::Quote')) - { last if $sep !~ m/^ (?: | \=\> | [,;:] ) $/x; - $msgid = $first->string; - - if( $first->isa("PPI::Token::Quote::Double") - || $first->isa("PPI::Token::Quote::Interpolate")) - { mistake __x - "do not interpolate in msgid (found '{var}' in line {line})" - , var => $1, line => $line - if $first->string =~ m/(? $line, error => $@ if $@; - } - } - elsif($first->isa('PPI::Token::Word')) - { last if $sep ne '=>'; - $msgid = $first->content; - } - else {last} - - mistake __x "new-line is added automatically (found in line {line})" - , line => $line if !$split && $msgid =~ s/(?snext_sibling; - } - @msgids or return (); - my $next = $first->snext_sibling; - if($has_count && !$next) - { error __x"count missing in {function} in line {line}" - , function => $function, line => $line; - } +{ my ($self, $node, $domain, $function, $def) = @_; + my ($nr_msgids, $has_count, $opts, $vars, $split) = @$def; + my $list_only = ($nr_msgids > 1) || $has_count || $opts || $vars; + my $expand = $opts || $vars; + + my @msgids; + my $first = $node->snext_sibling; + $first = $first->schild(0) + if $first->isa('PPI::Structure::List'); + + $first = $first->schild(0) + if $first->isa('PPI::Statement::Expression'); + + my $line; + while(defined $first && $nr_msgids > @msgids) + { my $msgid; + my $next = $first->snext_sibling; + my $sep = $next && $next->isa('PPI::Token::Operator') ? $next : ''; + $line = $first->location->[0]; + + if($first->isa('PPI::Token::Quote')) + { last if $sep !~ m/^ (?: | \=\> | [,;:] ) $/x; + $msgid = $first->string; + + if( $first->isa("PPI::Token::Quote::Double") + || $first->isa("PPI::Token::Quote::Interpolate")) + { $first->string !~ m/(? $1, line => $line; + + # content string is uninterpreted, warnings to screen + $msgid = eval "qq{$msgid}"; + error __x "string is incorrect at line {line}: {error}", line => $line, error => $@ if $@; + } + } + elsif($first->isa('PPI::Token::Word')) + { last if $sep ne '=>'; + $msgid = $first->content; + } + else { last } + + $split || $msgid !~ s/(? $line; + + push @msgids, $msgid; + last if $nr_msgids==@msgids || !$sep; + + $first = $sep->snext_sibling; + } + @msgids or return (); + my $next = $first->snext_sibling; + + !$has_count || $next + or error __x"count missing in {function} in line {line}", function => $function, line => $line; - @msgids; + @msgids; } 1; diff -pruN 1.12-1/lib/Log/Report/Extract/PerlPPI.pod 1.14-1/lib/Log/Report/Extract/PerlPPI.pod --- 1.12-1/lib/Log/Report/Extract/PerlPPI.pod 2025-04-18 15:10:21.000000000 +0000 +++ 1.14-1/lib/Log/Report/Extract/PerlPPI.pod 2025-09-08 13:31:48.000000000 +0000 @@ -11,15 +11,15 @@ Log::Report::Extract::PerlPPI - Collect =head1 SYNOPSIS - my $ppi = Log::Report::Extract::PerlPPI->new - ( lexicon => '/usr/share/locale' + my $ppi = Log::Report::Extract::PerlPPI->new( + lexicon => '/usr/share/locale', ); - $ppi->process('lib/My/Pkg.pm'); # call for each .pm file - $ppi->showStats; # optional - $ppi->write; + $ppi->process('lib/My/Pkg.pm'); # call for each .pm file + $ppi->showStats; # optional + $ppi->write; - # See script xgettext-perl - bin/xgettext-perl -p $lexdir @source_dirs + # See script xgettext-perl + bin/xgettext-perl -p $lexdir @source_dirs =head1 DESCRIPTION @@ -37,7 +37,7 @@ applications which can hand po-files, fo Do not forget to add the new po-file to your distribution (MANIFEST) Extends L<"DESCRIPTION" in Log::Report::Extract|Log::Report::Extract/"DESCRIPTION">. - + =head2 The extraction process All pm-files need to be processed in one go: no incremental processing! @@ -59,7 +59,7 @@ will get disabled, not removed. New msg =head3 What is extracted? This script will extract the msgids used in C<__()>, C<__x()>, C<__xn()>, -and C<__n()> (implemented by L) For instance +and C<__n()> (implemented by Log::Report) For instance __x"msgid", @more __x'msgid', @more <--- no! syntax error! @@ -86,14 +86,14 @@ values of C<$format>. =head1 METHODS Extends L<"METHODS" in Log::Report::Extract|Log::Report::Extract/"METHODS">. - + =head2 Constructors Extends L<"Constructors" in Log::Report::Extract|Log::Report::Extract/"Constructors">. - + =over 4 -=item Log::Report::Extract::PerlPPI-EB(%options) +=item $class-EB(%options) Inherited, see L @@ -102,7 +102,7 @@ Inherited, see L. - + =over 4 =item $obj-EB($domain, $pot, %options) @@ -130,7 +130,7 @@ Inherited, see L. - + =over 4 =item $obj-EB(%options) @@ -139,9 +139,10 @@ Inherited, see LB($filename, %options) -Update the domains mentioned in the $filename. All textdomains defined +Update the domains mentioned in the C<$filename>. All textdomains defined in the file will get updated automatically, but not written before all files where processed. +Improves base, see L -Option --Default charset 'iso-8859-1' @@ -160,22 +161,73 @@ Inherited, see L -=item $obj-EB( [$domain] ) +=item $obj-EB( [$domain], %options ) Inherited, see L =back +=head1 DIAGNOSTICS + +=over 4 + +=item Error: PPI only supports iso-8859-1 (latin-1) on the moment + +Cast by process() + +=item Fault: cannot create lexicon directory $dir: $! + +Cast by new() + +=item Fault: cannot read perl from file $filename: $! + +Cast by process() + +=item Error: count missing in $function in line $line + +Cast by process() + +=item Error: extractions require an explicit lexicon directory + +Cast by new() + +=item Info: no Perl in file $filename + +Cast by process() + +=item Error: no context tags allowed in plural `$msgid' + +Cast by store() + +=item Info: processing file $fn in $charset + +Cast by process() + +=item Info: starting new textdomain $domain, template in $filename + +Cast by write() + +=item Error: string is incorrect at line $line: $error + +Cast by process() + +=item Warning: use double quotes not single, in $string on $file line $line + +Cast by process() + +=back + =head1 SEE ALSO -This module is part of Log-Report-Lexicon distribution version 1.12, -built on April 18, 2025. Website: F +This module is part of Log-Report-Lexicon version 1.14, +built on September 08, 2025. Website: F =head1 LICENSE -Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. +For contributors see file ChangeLog. + +This software is copyright (c) 2007-2025 by Mark Overmeer. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. -See F +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff -pruN 1.12-1/lib/Log/Report/Extract.pm 1.14-1/lib/Log/Report/Extract.pm --- 1.12-1/lib/Log/Report/Extract.pm 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/lib/Log/Report/Extract.pm 2025-09-08 13:31:48.000000000 +0000 @@ -1,13 +1,20 @@ -# Copyrights 2007-2025 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.03. -# This code is part of distribution Log-Report-Lexicon. 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. +# This code is part of Perl distribution Log-Report-Lexicon version 1.14. +# The POD got stripped from this file by OODoc version 3.04. +# For contributors see file ChangeLog. + +# This software is copyright (c) 2007-2025 by Mark Overmeer. + +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later + +#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION *** +#oodist: This file contains OODoc-style documentation which will get stripped +#oodist: during its release in the distribution. You can use this file for +#oodist: testing, however the code of this development version may be broken! package Log::Report::Extract;{ -our $VERSION = '1.12'; +our $VERSION = '1.14'; } @@ -18,218 +25,205 @@ use Log::Report 'log-report-lexicon'; use Log::Report::Lexicon::Index (); use Log::Report::Lexicon::POT (); +#-------------------- sub new(@) -{ my $class = shift; - (bless {}, $class)->init( {@_} ); +{ my $class = shift; + (bless {}, $class)->init( {@_} ); } sub init($) -{ my ($self, $args) = @_; - my $lexi = $args->{lexicon} || $args->{lexicons} - or error __"extractions require an explicit lexicon directory"; +{ my ($self, $args) = @_; + my $lexi = $args->{lexicon} || $args->{lexicons} + or error __"extractions require an explicit lexicon directory"; - -d $lexi or mkdir $lexi - or fault __x"cannot create lexicon directory {dir}", dir => $lexi; + -d $lexi or mkdir $lexi + or fault __x"cannot create lexicon directory {dir}", dir => $lexi; - $self->{LRE_index} = Log::Report::Lexicon::Index->new($lexi); - $self->{LRE_charset} = $args->{LRE_charset} || 'utf-8'; - $self->{LRE_domains} = {}; - $self; + $self->{LRE_index} = Log::Report::Lexicon::Index->new($lexi); + $self->{LRE_charset} = $args->{LRE_charset} || 'utf-8'; + $self->{LRE_domains} = {}; + $self; } -#--------------- +#-------------------- -sub index() {shift->{LRE_index}} -sub charset() {shift->{LRE_charset}} -sub domains() {sort keys %{shift->{LRE_domains}}} +sub index() { $_[0]->{LRE_index} } +sub charset() { $_[0]->{LRE_charset} } +sub domains() {sort keys %{ $_[0]->{LRE_domains}} } sub pots($) -{ my ($self, $domain) = @_; - my $r = $self->{LRE_domains}{$domain}; - $r ? @$r : (); +{ my ($self, $domain) = @_; + my $r = $self->{LRE_domains}{$domain}; + $r ? @$r : (); } sub addPot($$%) -{ my ($self, $domain, $pot) = @_; - push @{$self->{LRE_domains}{$domain}}, ref $pot eq 'ARRAY' ? @$pot : $pot - if $pot; +{ my ($self, $domain, $pot) = @_; + push @{$self->{LRE_domains}{$domain}}, ref $pot eq 'ARRAY' ? @$pot : $pot + if $pot; } -#--------------- +#-------------------- sub process($@) -{ my ($self, $fn, %opts) = @_; - panic "not implemented"; +{ my ($self, $fn, %opts) = @_; + panic "not implemented"; } sub cleanup(%) -{ my ($self, %args) = @_; - my $keep = $args{keep} || {}; - $keep = +{ map +($_ => 1), @$keep } - if ref $keep eq 'ARRAY'; - - foreach my $domain ($self->domains) - { $_->keepReferencesTo($keep) for $self->pots($domain); - } +{ my ($self, %args) = @_; + my $keep = $args{keep} || {}; + $keep = +{ map +($_ => 1), @$keep } + if ref $keep eq 'ARRAY'; + + foreach my $domain ($self->domains) + { $_->keepReferencesTo($keep) for $self->pots($domain); + } } sub showStats(;$) -{ my $self = shift; - my @domains = @_ ? @_ : $self->domains; +{ my $self = shift; + my @domains = @_ ? @_ : $self->domains; - dispatcher needs => 'INFO' - or return; + dispatcher needs => 'INFO' + or return; - foreach my $domain (@domains) - { my $pots = $self->{LRE_domains}{$domain} or next; - my ($msgids, $fuzzy, $inactive) = (0, 0, 0); - - foreach my $pot (@$pots) - { my $stats = $pot->stats; - next unless $stats->{fuzzy} || $stats->{inactive}; - - $msgids = $stats->{msgids}; - next if $msgids == $stats->{fuzzy}; # ignore the template - - notice __x - "{domain}: {fuzzy%3d} fuzzy, {inact%3d} inactive in {filename}" - , domain => $domain, fuzzy => $stats->{fuzzy} - , inact => $stats->{inactive}, filename => $pot->filename; - - $fuzzy += $stats->{fuzzy}; - $inactive += $stats->{inactive}; - } - - if($fuzzy || $inactive) - { info __xn -"{domain}: one file with {ids} msgids, {f} fuzzy and {i} inactive translations" -, "{domain}: {_count} files each {ids} msgids, {f} fuzzy and {i} inactive translations in total" - , scalar(@$pots), domain => $domain - , f => $fuzzy, ids => $msgids, i => $inactive - } - else - { info __xn - "{domain}: one file with {ids} msgids" - , "{domain}: {_count} files with each {ids} msgids" - , scalar(@$pots), domain => $domain, ids => $msgids; - } - } -} + foreach my $domain (@domains) + { my $pots = $self->{LRE_domains}{$domain} or next; + my ($msgids, $fuzzy, $inactive) = (0, 0, 0); + + foreach my $pot (@$pots) + { my $stats = $pot->stats; + next unless $stats->{fuzzy} || $stats->{inactive}; + + $msgids = $stats->{msgids}; + next if $msgids == $stats->{fuzzy}; # ignore the template + notice __x"{domain}: {fuzzy%3d} fuzzy, {inact%3d} inactive in {filename}", + domain => $domain, fuzzy => $stats->{fuzzy}, inact => $stats->{inactive}, filename => $pot->filename; -sub write(;$) -{ my ($self, $domain) = @_; - unless(defined $domain) # write all - { $self->write($_) for $self->domains; - return; - } - - my $pots = delete $self->{LRE_domains}{$domain} - or return; # nothing found - - for my $pot (@$pots) - { $pot->updated; - $pot->write; - } + $fuzzy += $stats->{fuzzy}; + $inactive += $stats->{inactive}; + } - $self; + if($fuzzy || $inactive) + { info __xn"{domain}: one file with {ids} msgids, {f} fuzzy and {i} inactive translations", + "{domain}: {_count} files each {ids} msgids, {f} fuzzy and {i} inactive translations in total", + scalar(@$pots), domain => $domain, f => $fuzzy, ids => $msgids, i => $inactive; + } + else + { info __xn"{domain}: one file with {ids} msgids", "{domain}: {_count} files with each {ids} msgids", + scalar(@$pots), domain => $domain, ids => $msgids; + } + } } -sub DESTROY() {shift->write} -sub _reset($$) -{ my ($self, $domain, $fn) = @_; +sub write(;$%) +{ my $self = shift; + my ($domain, %args) = @_ % 2 ? @_ : (undef, @_); + + unless(defined $domain) # write all + { $self->write($_) for $self->domains; + return; + } + + my $pots = delete $self->{LRE_domains}{$domain} + or return; # nothing found - my $pots = $self->{LRE_domains}{$domain} - ||= $self->_read_pots($domain); + for my $pot (@$pots) + { $pot->updated; + $pot->write(%args); + } - $_->removeReferencesTo($fn) for @$pots; + $self; +} + +sub DESTROY() { $_[0]->write } + +sub _reset($$) +{ my ($self, $domain, $fn) = @_; + my $pots = $self->{LRE_domains}{$domain} ||= $self->_read_pots($domain); + $_->removeReferencesTo($fn) for @$pots; } sub _read_pots($) -{ my ($self, $domain) = @_; +{ my ($self, $domain) = @_; + + my $index = $self->index; + my $charset = $self->charset; + my @pots = map Log::Report::Lexicon::POT->read($_, charset=> $charset), $index->list($domain); + + trace __xn"found one pot file for domain {domain}", "found {_count} pot files for domain {domain}", @pots, domain => $domain; - my $index = $self->index; - my $charset = $self->charset; + return \@pots + if @pots; - my @pots = map Log::Report::Lexicon::POT->read($_, charset=> $charset), - $index->list($domain); + # new text-domain found, start template + my $fn = $index->addFile("$domain.$charset.po"); + info __x"starting new textdomain {domain}, template in {filename}", domain => $domain, filename => $fn; - trace __xn "found one pot file for domain {domain}" - , "found {_count} pot files for domain {domain}" - , @pots, domain => $domain; - - return \@pots - if @pots; - - # new text-domain found, start template - my $fn = $index->addFile("$domain.$charset.po"); - info __x"starting new textdomain {domain}, template in {filename}" - , domain => $domain, filename => $fn; - - my $pot = Log::Report::Lexicon::POT->new - ( textdomain => $domain - , filename => $fn - , charset => $charset - , version => 0.01 - ); + my $pot = Log::Report::Lexicon::POT->new( + textdomain => $domain, + filename => $fn, + charset => $charset, + version => 0.01 + ); - [ $pot ]; + [ $pot ]; } sub store($$$$;$) -{ my ($self, $domain, $fn, $linenr, $msgid, $plural) = @_; +{ my ($self, $domain, $fn, $linenr, $msgid, $plural) = @_; - my $textdomain = textdomain $domain; - my $context = $textdomain->contextRules; + my $textdomain = textdomain $domain; + my $context = $textdomain->contextRules; - foreach my $pot ($self->pots($domain)) - { my ($stripped, $msgctxts); - if($context) - { my $lang = $pot->language || 'en'; - ($stripped, $msgctxts) = $context->expand($msgid, $lang); - - if($plural && $plural =~ m/\{[^}]*\<\w+/) - { error __x"no context tags allowed in plural `{msgid}'" - , msgid => $plural; - } - } - else - { $stripped = $msgid; - } - - $msgctxts && @$msgctxts - or $msgctxts = [undef]; - - MSGCTXT: - foreach my $msgctxt (@$msgctxts) - { -#warn "($stripped, $msgctxt)"; - if(my $po = $pot->msgid($stripped, $msgctxt)) - { $po->addReferences( ["$fn:$linenr"]); - $po->plural($plural) if $plural; - next MSGCTXT; - } - - my $format = $stripped =~ m/\{/ ? 'perl-brace' : 'perl'; - my $po = Log::Report::Lexicon::PO->new - ( msgid => $stripped - , msgid_plural => $plural - , msgctxt => $msgctxt - , fuzzy => 1 - , format => $format - , references => [ "$fn:$linenr" ] - ); - - $pot->add($po); - } - } + foreach my $pot ($self->pots($domain)) + { my ($stripped, $msgctxts); + if($context) + { my $lang = $pot->language || 'en'; + ($stripped, $msgctxts) = $context->expand($msgid, $lang); + + if($plural && $plural =~ m/\{[^}]*\<\w+/) + { error __x"no context tags allowed in plural `{msgid}'", msgid => $plural; + } + } + else + { $stripped = $msgid; + } + + $msgctxts && @$msgctxts + or $msgctxts = [undef]; + + MSGCTXT: + foreach my $msgctxt (@$msgctxts) + { + if(my $po = $pot->msgid($stripped, $msgctxt)) + { $po->addReferences( ["$fn:$linenr"]); + $po->plural($plural) if $plural; + next MSGCTXT; + } + + my $format = $stripped =~ m/\{/ ? 'perl-brace' : 'perl'; + my $po = Log::Report::Lexicon::PO->new( + msgid => $stripped, + msgid_plural => $plural, + msgctxt => $msgctxt, + fuzzy => 1, + format => $format, + references => [ "$fn:$linenr" ] + ); + + $pot->add($po); + } + } } 1; diff -pruN 1.12-1/lib/Log/Report/Extract.pod 1.14-1/lib/Log/Report/Extract.pod --- 1.12-1/lib/Log/Report/Extract.pod 2025-04-18 15:10:21.000000000 +0000 +++ 1.14-1/lib/Log/Report/Extract.pod 2025-09-08 13:31:48.000000000 +0000 @@ -8,11 +8,10 @@ Log::Report::Extract - Collect translata Log::Report::Extract is extended by Log::Report::Extract::PerlPPI - Log::Report::Extract::Template =head1 SYNOPSIS - # See the extensions + # See the extensions =head1 DESCRIPTION @@ -28,7 +27,9 @@ translations exist yet, one CB(%options) +=item $class-EB(%options) + +Z<> -Option --Default charset 'utf-8' @@ -55,6 +56,8 @@ this will be the directory where an CB($domain, $pot, %options) +Z<> + =item $obj-EB() Returns the character-set used inside the POT files. @@ -71,7 +74,7 @@ the files in the lexicon directory tree. =item $obj-EB($domain) Returns the list of L objects which contain -the tables for $domain. +the tables for C<$domain>. =back @@ -97,7 +100,7 @@ names, or a HASH where the keys are the =item $obj-EB($filename, %options) -Update the domains mentioned in the $filename. All text-domains defined +Update the domains mentioned in the C<$filename>. All text-domains defined in the file will get updated automatically, but should not written before all files are processed. @@ -113,32 +116,57 @@ notice and info. This could be syslog. dispatchers in your program, the level of detail get controlled by the 'mode': - use Log::Report mode => 'DEBUG'; # or 'VERBOSE' + use Log::Report mode => 'DEBUG'; # or 'VERBOSE' =item $obj-EB( $domain, $filename, $linenr, $context, $msg, [$msg_plural] ) -Register the existence of a ($msg, $msg_plural) in all POTs of -the $domain. +Register the existence of a (C<$msg>, C<$msg_plural>) in all POTs of +the C<$domain>. -=item $obj-EB( [$domain] ) +=item $obj-EB( [$domain], %options ) -Update the information of the files related to $domain, by default all +Update the information of the files related to C<$domain>, by default all processed DOMAINS. -All information known about the written $domain is removed from the cache. +All information known about the written C<$domain> is removed from the cache. +The C<%options> are passed to the C of the specific lexicon +manager. + +=back + +=head1 DIAGNOSTICS + +=over 4 + +=item Fault: cannot create lexicon directory $dir: $! + +Cast by new() + +=item Error: extractions require an explicit lexicon directory + +Cast by new() + +=item Error: no context tags allowed in plural `$msgid' + +Cast by store() + +=item Info: starting new textdomain $domain, template in $filename + +Cast by write() =back =head1 SEE ALSO -This module is part of Log-Report-Lexicon distribution version 1.12, -built on April 18, 2025. Website: F +This module is part of Log-Report-Lexicon version 1.14, +built on September 08, 2025. Website: F =head1 LICENSE -Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. +For contributors see file ChangeLog. + +This software is copyright (c) 2007-2025 by Mark Overmeer. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. -See F +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff -pruN 1.12-1/lib/Log/Report/Lexicon/Index.pm 1.14-1/lib/Log/Report/Lexicon/Index.pm --- 1.12-1/lib/Log/Report/Lexicon/Index.pm 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon/Index.pm 2025-09-08 13:31:48.000000000 +0000 @@ -1,13 +1,25 @@ -# Copyrights 2007-2025 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.03. +# This code is part of Perl distribution Log-Report-Lexicon version 1.14. +# The POD got stripped from this file by OODoc version 3.04. +# For contributors see file ChangeLog. + +# This software is copyright (c) 2007-2025 by Mark Overmeer. + +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later + +#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION *** +#oodist: This file contains OODoc-style documentation which will get stripped +#oodist: during its release in the distribution. You can use this file for +#oodist: testing, however the code of this development version may be broken! +#oorestyle: old style disclaimer to be removed. + # This code is part of distribution Log-Report-Lexicon. 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::Lexicon::Index;{ -our $VERSION = '1.12'; +our $VERSION = '1.14'; } @@ -22,8 +34,8 @@ use File::Find (); sub _understand_file_format($) { $_[0] =~ qr/\.(?:gmo|mo|po)$/i } sub _find($$) -{ my ($index, $name) = (shift, lc shift); - $index->{"$name.mo"} || $index->{"$name.gmo"} || $index->{"$name.po"}; # prefer mo +{ my ($index, $name) = (shift, lc shift); + $index->{"$name.mo"} || $index->{"$name.gmo"} || $index->{"$name.po"}; # prefer mo } # On windows, other locale names are used. They will get translated @@ -31,124 +43,123 @@ sub _find($$) my $locale_unifier; if($^O eq 'MSWin32') -{ require Log::Report::Win32Locale; - Log::Report::Win32Locale->import; - $locale_unifier = sub { iso_locale($_[0]) }; +{ require Log::Report::Win32Locale; + Log::Report::Win32Locale->import; + $locale_unifier = sub { iso_locale($_[0]) }; } else -{ # some UNIXes do not understand "POSIX" - $locale_unifier = sub { uc $_[0] eq 'POSIX' ? 'c' : lc $_[0] }; +{ # some UNIXes do not understand "POSIX" + $locale_unifier = sub { uc $_[0] eq 'POSIX' ? 'c' : lc $_[0] }; } +#-------------------- sub new($;@) -{ my ($class, $dir) = (shift, shift); - bless {dir => $dir, @_}, $class; # dir before first argument. +{ my ($class, $dir) = (shift, shift); + bless +{ dir => $dir, @_ }, $class; # dir before first argument. } -#------------------- +#-------------------- sub directory() { $_[0]->{dir} } -#------------------- +#-------------------- -sub index() -{ my $self = shift; - return $self->{index} if exists $self->{index}; - - my $dir = $self->directory; - my $strip_dir = qr!\Q$dir/!; - - $self->{index} = {}; - File::Find::find - ( +{ wanted => sub - { -f && !m[/\.] && _understand_file_format($_) or return 1; - (my $key = $_) =~ s/$strip_dir//; - $self->addFile($key, $_); - 1; - } - , follow => 1 - , no_chdir => 1 - , follow_skip => 2 - } , $dir - ); +sub index() +{ my $self = shift; + return $self->{index} if exists $self->{index}; + + my $dir = $self->directory; + my $strip_dir = qr!\Q$dir/!; + + $self->{index} = {}; + File::Find::find( +{ + wanted => sub { + -f && !m[/\.] && _understand_file_format($_) or return 1; + (my $key = $_) =~ s/$strip_dir//; + $self->addFile($key, $_); + 1; + }, + follow => 1, + no_chdir => 1, + follow_skip => 2 + }, $dir); - $self->{index}; + $self->{index}; } sub addFile($;$) -{ my ($self, $base, $abs) = @_; - $abs ||= File::Spec->catfile($self->directory, $base); - $base =~ s!\\!/!g; # dos->unix - $self->{index}{lc $base} = $abs; +{ my ($self, $base, $abs) = @_; + $abs ||= File::Spec->catfile($self->directory, $base); + $base =~ s!\\!/!g; # dos->unix + $self->{index}{lc $base} = $abs; } sub find($$) -{ my $self = shift; - my $domain = lc shift; - my $locale = $locale_unifier->(shift); - - my $index = $self->index; - keys %$index or return undef; - - my ($lang, $terr, $cs, $modif) = parse_locale $locale; - unless(defined $lang) - { defined $locale or $locale = ''; - # avoid problem with recursion, not translatable! - print STDERR "illegal locale $locale, when looking for $domain"; - return undef; - } - - $terr = defined $terr ? '_'.$terr : ''; - $cs = defined $cs ? '.'.$cs : ''; - $modif = defined $modif ? '@'.$modif : ''; - - (my $normcs = $cs) =~ s/[^a-z0-9]//g; - if(length $normcs) - { $normcs = "iso$normcs" if $normcs !~ /[^0-9-]/; - $normcs = '.'.$normcs; - } - - my $fn; - for my $f ("/lc_messages/$domain", "/$domain") - { $fn - ||= _find($index, "$lang$terr$cs$modif$f") - || _find($index, "$lang$terr$normcs$modif$f") - || _find($index, "$lang$terr$modif$f") - || _find($index, "$lang$modif$f") - || _find($index, "$lang$f"); - } - - $fn - || _find($index, "$domain/$lang$terr$cs$modif") - || _find($index, "$domain/$lang$terr$normcs$modif") - || _find($index, "$domain/$lang$terr$modif") - || _find($index, "$domain/$lang$cs$modif") - || _find($index, "$domain/$lang$normcs$modif") - || _find($index, "$domain/$lang$modif") - || _find($index, "$domain/$lang"); +{ my $self = shift; + my $domain = lc shift; + my $locale = $locale_unifier->(shift); + + my $index = $self->index; + keys %$index or return undef; + + my ($lang, $terr, $cs, $modif) = parse_locale $locale; + unless(defined $lang) + { defined $locale or $locale = ''; + # avoid problem with recursion, not translatable! + print STDERR "illegal locale $locale, when looking for $domain"; + return undef; + } + + $terr = defined $terr ? '_'.$terr : ''; + $cs = defined $cs ? '.'.$cs : ''; + $modif = defined $modif ? '@'.$modif : ''; + + (my $normcs = $cs) =~ s/[^a-z0-9]//g; + if(length $normcs) + { $normcs = "iso$normcs" if $normcs !~ /[^0-9-]/; + $normcs = '.'.$normcs; + } + + my $fn; + for my $f ("/lc_messages/$domain", "/$domain") + { $fn + ||= _find($index, "$lang$terr$cs$modif$f") + || _find($index, "$lang$terr$normcs$modif$f") + || _find($index, "$lang$terr$modif$f") + || _find($index, "$lang$modif$f") + || _find($index, "$lang$f"); + } + + $fn + || _find($index, "$domain/$lang$terr$cs$modif") + || _find($index, "$domain/$lang$terr$normcs$modif") + || _find($index, "$domain/$lang$terr$modif") + || _find($index, "$domain/$lang$cs$modif") + || _find($index, "$domain/$lang$normcs$modif") + || _find($index, "$domain/$lang$modif") + || _find($index, "$domain/$lang"); } sub list($;$) -{ my $self = shift; - my $domain = lc shift; - my $filter = shift; - my $index = $self->index; - my @list = map $index->{$_}, grep m!\b\Q$domain\E\b!, keys %$index; +{ my $self = shift; + my $domain = lc shift; + my $filter = shift; + my $index = $self->index; + my @list = map $index->{$_}, grep m!\b\Q$domain\E\b!, keys %$index; - defined $filter - or return @list; + defined $filter + or return @list; - $filter = qr/\.\Q$filter\E$/i - if defined $filter && ref $filter ne 'Regexp'; + $filter = qr/\.\Q$filter\E$/i + if defined $filter && ref $filter ne 'Regexp'; - grep $_ =~ $filter, @list; + grep $_ =~ $filter, @list; } -#------------------------------------- - +#-------------------- 1; diff -pruN 1.12-1/lib/Log/Report/Lexicon/Index.pod 1.14-1/lib/Log/Report/Lexicon/Index.pod --- 1.12-1/lib/Log/Report/Lexicon/Index.pod 2025-04-18 15:10:21.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon/Index.pod 2025-09-08 13:31:48.000000000 +0000 @@ -6,8 +6,8 @@ Log::Report::Lexicon::Index - search thr =head1 SYNOPSIS - my $index = Log::Report::Lexicon::Index->new($directory); - my $fn = $index->find('my-domain', 'nl_NL.utf-8'); + my $index = Log::Report::Lexicon::Index->new($directory); + my $fn = $index->find('my-domain', 'nl_NL.utf-8'); =head1 DESCRIPTION @@ -22,12 +22,12 @@ created. =over 4 -=item Log::Report::Lexicon::Index-EB($directory, %options) +=item $class-EB($directory, %options) Create an index for a certain directory. If the directory does not exist or is empty, then the object will still be created. -All files the $directory tree which are recognized as an translation table +All files the C<$directory> tree which are recognized as an translation table format which is understood will be listed. Momentarily, those are: =over @@ -59,9 +59,9 @@ Returns the directory name. =item $obj-EB( $basename, [$absolute] ) -Add a certain file to the index. This method returns the $absolute +Add a certain file to the index. This method returns the C<$absolute> path to that file, which must be used to access it. When not explicitly -specified, the $absolute path will be calculated. +specified, the C<$absolute> path will be calculated. =item $obj-EB($textdomain, $locale) @@ -69,7 +69,7 @@ Lookup the best translation table, accor in chapter L, below. Returned is a filename, or C if nothing is defined for the -$locale (there is no default on this level). +C<$locale> (there is no default on this level). =item $obj-EB() @@ -82,9 +82,9 @@ filename, and the value the case-sensiti Returned is a list of filenames which is used to update the list of MSGIDs when source files have changed. All translation files which -belong to a certain $domain are listed. +belong to a certain C<$domain> are listed. -The $extension filter can be used to reduce the filenames further, for +The C<$extension> filter can be used to reduce the filenames further, for instance to select only C, C or C files, and ignore readme's. Use an string, without dot and interpreted case-insensitive, or a regular expression. @@ -124,15 +124,15 @@ textdomain C. The translatio (locale for Dutch spoken in The Netherlands, utf-8 encoded text file). The default location for the translation table is under - ~perl5.8.8/Some/Module/messages/ + ~perl5.8.8/Some/Module/messages/ for instance - ~perl5.8.8/Some/Module/messages/nl-NL.utf-8/LC_MESSAGES/my-domain.po + ~perl5.8.8/Some/Module/messages/nl-NL.utf-8/LC_MESSAGES/my-domain.po There are alternatives, as described in L, for instance - ~perl5.8.8/Some/Module/messages/my-domain/nl-NL.utf-8.po - ~perl5.8.8/Some/Module/messages/my-domain/nl.po + ~perl5.8.8/Some/Module/messages/my-domain/nl-NL.utf-8.po + ~perl5.8.8/Some/Module/messages/my-domain/nl.po =head2 Locale search @@ -205,14 +205,15 @@ from you [please help improve this]), an =head1 SEE ALSO -This module is part of Log-Report-Lexicon distribution version 1.12, -built on April 18, 2025. Website: F +This module is part of Log-Report-Lexicon version 1.14, +built on September 08, 2025. Website: F =head1 LICENSE -Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. +For contributors see file ChangeLog. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. -See F +This software is copyright (c) 2007-2025 by Mark Overmeer. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff -pruN 1.12-1/lib/Log/Report/Lexicon/MOTcompact.pm 1.14-1/lib/Log/Report/Lexicon/MOTcompact.pm --- 1.12-1/lib/Log/Report/Lexicon/MOTcompact.pm 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon/MOTcompact.pm 2025-09-08 13:31:48.000000000 +0000 @@ -1,13 +1,20 @@ -# Copyrights 2007-2025 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.03. -# This code is part of distribution Log-Report-Lexicon. 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. +# This code is part of Perl distribution Log-Report-Lexicon version 1.14. +# The POD got stripped from this file by OODoc version 3.04. +# For contributors see file ChangeLog. + +# This software is copyright (c) 2007-2025 by Mark Overmeer. + +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later + +#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION *** +#oodist: This file contains OODoc-style documentation which will get stripped +#oodist: during its release in the distribution. You can use this file for +#oodist: testing, however the code of this development version may be broken! package Log::Report::Lexicon::MOTcompact;{ -our $VERSION = '1.12'; +our $VERSION = '1.14'; } use base 'Log::Report::Lexicon::Table'; @@ -16,170 +23,161 @@ use warnings; use strict; use Log::Report 'log-report-lexicon'; -use Fcntl qw(SEEK_SET); -use Encode qw(find_encoding); +use Fcntl qw/SEEK_SET/; +use Encode qw/find_encoding/; use constant MAGIC_NUMBER => 0x95_04_12_DE; +#-------------------- sub read($@) -{ my ($class, $fn, %args) = @_; +{ my ($class, $fn, %args) = @_; - my $charset = $args{charset}; - $charset = $1 - if !$charset && $fn =~ m!\.([\w-]+)(?:\@[^/\\]+)?\.g?mo$!i; - - my $enc; - if(defined $charset) - { $enc = find_encoding($charset) - or error __x"unsupported explicit charset {charset} for {fn}" - , charset => $charset, fn => $fn; - } - - my (%index, %locs); - my %self = - +( index => \%index # fully prepared ::PO objects - , locs => \%locs # know where to find it - , filename => $fn - ); - my $self = bless \%self, $class; - - my $fh; - open $fh, "<:raw", $fn - or fault __x"cannot read mo from file {fn}", fn => $fn; - - # The magic number will tell us the byte-order - # See http://www.gnu.org/software/gettext/manual/html_node/MO-Files.html - # Found in a bug-report that msgctxt are prepended to the msgid with - # a separating EOT (4) - my ($magic, $superblock, $originals, $translations); - CORE::read $fh, $magic, 4 - or fault __x"cannot read magic from {fn}", fn => $fn; - - my $byteorder - = $magic eq pack('V', MAGIC_NUMBER) ? 'V' - : $magic eq pack('N', MAGIC_NUMBER) ? 'N' - : error __x"unsupported file type (magic number is {magic%x})" - , magic => $magic; - - # The superblock contains pointers to strings - CORE::read $fh, $superblock, 6*4 # 6 times a 32 bit int - or fault __x"cannot read superblock from {fn}", fn => $fn; - - my ( $format_rev, $nr_strings, $offset_orig, $offset_trans - , $size_hash, $offset_hash ) = unpack $byteorder x 6, $superblock; - - # warn "($format_rev, $nr_strings, $offset_orig, $offset_trans - # , $size_hash, $offset_hash)"; - - # Read location of all originals - seek $fh, $offset_orig, SEEK_SET - or fault __x"cannot seek to {loc} in {fn} for originals" - , loc => $offset_orig, fn => $fn; - - CORE::read $fh, $originals, $nr_strings*8 # each string 2*4 bytes - or fault __x"cannot read originals from {fn}, need {size} at {loc}" - , fn => $fn, loc => $offset_orig, size => $nr_strings*4; - - my @origs = unpack $byteorder.'*', $originals; - - # Read location of all translations - seek $fh, $offset_trans, SEEK_SET - or fault __x"cannot seek to {loc} in {fn} for translations" - , loc => $offset_orig, fn => $fn; - - CORE::read $fh, $translations, $nr_strings*8 # each string 2*4 bytes - or fault __x"cannot read translations from {fn}, need {size} at {loc}" - , fn => $fn, loc => $offset_trans, size => $nr_strings*4; - - my @trans = unpack $byteorder.'*', $translations; - - # We need the originals as index to the translations (unless there - # is a HASH build-in... which is not defined) - # The strings are strictly ordered, the spec tells me, to allow binary - # search. Better swiftly process the whole block into a hash. - my ($orig_start, $orig_end) = ($origs[1], $origs[-1]+$origs[-2]); - - seek $fh, $orig_start, SEEK_SET - or fault __x"cannot seek to {loc} in {fn} for msgid strings" - , loc => $orig_start, fn => $fn; - - my ($orig_block, $trans_block); - my $orig_block_size = $orig_end - $orig_start; - CORE::read $fh, $orig_block, $orig_block_size - or fault __x"cannot read msgids from {fn}, need {size} at {loc}" - , fn => $fn, loc => $orig_start, size => $orig_block_size; - - my ($trans_start, $trans_end) = ($trans[1], $trans[-1]+$trans[-2]); - seek $fh, $trans_start, SEEK_SET - or fault __x"cannot seek to {loc} in {fn} for transl strings" - , loc => $trans_start, fn => $fn; - - my $trans_block_size = $trans_end - $trans_start; - CORE::read $fh, $trans_block, $trans_block_size - or fault __x"cannot read translations from {fn}, need {size} at {loc}" - , fn => $fn, loc => $trans_start, size => $trans_block_size; - - while(@origs) - { my ($id_len, $id_loc) = (shift @origs, shift @origs); - my $msgid_b = substr $orig_block, $id_loc-$orig_start, $id_len; - my $msgctxt_b = $msgid_b =~ s/(.*)\x04// ? $1 : ''; - - my ($trans_len, $trans_loc) = (shift @trans, shift @trans); - my $msgstr_b = substr $trans_block, $trans_loc - $trans_start, $trans_len; - - unless(defined $charset) - { $msgid_b eq '' - or error __x"the header is not the first entry, needed for charset in {fn}", fn => $fn; - - $charset = $msgstr_b =~ m/^content-type:.*?charset=["']?([\w-]+)/mi - ? $1 : error __x"cannot detect charset in {fn}", fn => $fn; - trace "auto-detected charset $charset for $fn"; - - $enc = find_encoding($charset) - or error __x"unsupported charset {charset} in {fn}" - , charset => $charset, fn => $fn; - } - - my $msgid = $enc->decode($msgid_b); - my $msgctxt = $enc->decode($msgctxt_b); - my @msgstr = map $enc->decode($_), split /\0x00/, $msgstr_b; - $index{"$msgid#$msgctxt"} = @msgstr > 1 ? \@msgstr : $msgstr[0]; - } - - close $fh - or failure __x"failed reading from file {fn}", fn => $fn; - - $self->{origcharset} = $charset; - $self->setupPluralAlgorithm; - $self; + my $charset = $args{charset}; + $charset = $1 + if !$charset && $fn =~ m!\.([\w-]+)(?:\@[^/\\]+)?\.g?mo$!i; + + my $enc; + if(defined $charset) + { $enc = find_encoding($charset) + or error __x"unsupported explicit charset {charset} for {fn}", charset => $charset, fn => $fn; + } + + my (%index, %locs); + my %self = +( + index => \%index, # fully prepared ::PO objects + locs => \%locs, # know where to find it + filename => $fn, + ); + my $self = bless \%self, $class; + + my $fh; + open $fh, "<:raw", $fn + or fault __x"cannot read mo from file {fn}", fn => $fn; + + # The magic number will tell us the byte-order + # See http://www.gnu.org/software/gettext/manual/html_node/MO-Files.html + # Found in a bug-report that msgctxt are prepended to the msgid with + # a separating EOT (4) + my ($magic, $superblock, $originals, $translations); + CORE::read $fh, $magic, 4 + or fault __x"cannot read magic from {fn}", fn => $fn; + + my $byteorder + = $magic eq pack('V', MAGIC_NUMBER) ? 'V' + : $magic eq pack('N', MAGIC_NUMBER) ? 'N' + : error __x"unsupported file type (magic number is {magic%x})", magic => $magic; + + # The superblock contains pointers to strings + CORE::read $fh, $superblock, 6*4 # 6 times a 32 bit int + or fault __x"cannot read superblock from {fn}", fn => $fn; + + my ($format_rev, $nr_strings, $offset_orig, $offset_trans, $size_hash, $offset_hash) = + unpack $byteorder x 6, $superblock; + + # warn "($format_rev, $nr_strings, $offset_orig, $offset_trans + # , $size_hash, $offset_hash)"; + + # Read location of all originals + seek $fh, $offset_orig, SEEK_SET + or fault __x"cannot seek to {loc} in {fn} for originals", loc => $offset_orig, fn => $fn; + + CORE::read $fh, $originals, $nr_strings*8 # each string 2*4 bytes + or fault __x"cannot read originals from {fn}, need {size} at {loc}", fn => $fn, loc => $offset_orig, size => $nr_strings*4; + + my @origs = unpack $byteorder.'*', $originals; + + # Read location of all translations + seek $fh, $offset_trans, SEEK_SET + or fault __x"cannot seek to {loc} in {fn} for translations", loc => $offset_orig, fn => $fn; + + CORE::read $fh, $translations, $nr_strings*8 # each string 2*4 bytes + or fault __x"cannot read translations from {fn}, need {size} at {loc}", fn => $fn, loc => $offset_trans, size => $nr_strings*4; + + my @trans = unpack $byteorder.'*', $translations; + + # We need the originals as index to the translations (unless there + # is a HASH build-in... which is not defined) + # The strings are strictly ordered, the spec tells me, to allow binary + # search. Better swiftly process the whole block into a hash. + my ($orig_start, $orig_end) = ($origs[1], $origs[-1]+$origs[-2]); + + seek $fh, $orig_start, SEEK_SET + or fault __x"cannot seek to {loc} in {fn} for msgid strings", loc => $orig_start, fn => $fn; + + my ($orig_block, $trans_block); + my $orig_block_size = $orig_end - $orig_start; + CORE::read $fh, $orig_block, $orig_block_size + or fault __x"cannot read msgids from {fn}, need {size} at {loc}", fn => $fn, loc => $orig_start, size => $orig_block_size; + + my ($trans_start, $trans_end) = ($trans[1], $trans[-1]+$trans[-2]); + seek $fh, $trans_start, SEEK_SET + or fault __x"cannot seek to {loc} in {fn} for transl strings", loc => $trans_start, fn => $fn; + + my $trans_block_size = $trans_end - $trans_start; + CORE::read $fh, $trans_block, $trans_block_size + or fault __x"cannot read translations from {fn}, need {size} at {loc}", fn => $fn, loc => $trans_start, size => $trans_block_size; + + while(@origs) + { my ($id_len, $id_loc) = (shift @origs, shift @origs); + my $msgid_b = substr $orig_block, $id_loc-$orig_start, $id_len; + my $msgctxt_b = $msgid_b =~ s/(.*)\x04// ? $1 : ''; + + my ($trans_len, $trans_loc) = (shift @trans, shift @trans); + my $msgstr_b = substr $trans_block, $trans_loc - $trans_start, $trans_len; + + unless(defined $charset) + { $msgid_b eq '' + or error __x"the header is not the first entry, needed for charset in {fn}", fn => $fn; + + $charset = $msgstr_b =~ m/^content-type:.*?charset=["']?([\w-]+)/mi ? $1 + : error __x"cannot detect charset in {fn}", fn => $fn; + + trace "auto-detected charset $charset for $fn"; + + $enc = find_encoding($charset) + or error __x"unsupported charset {charset} in {fn}", charset => $charset, fn => $fn; + } + + my $msgid = $enc->decode($msgid_b); + my $msgctxt = $enc->decode($msgctxt_b); + my @msgstr = map $enc->decode($_), split /\0x00/, $msgstr_b; + $index{"$msgid#$msgctxt"} = @msgstr > 1 ? \@msgstr : $msgstr[0]; + } + + close $fh + or failure __x"failed reading from file {fn}", fn => $fn; + + $self->{origcharset} = $charset; + $self->setupPluralAlgorithm; + $self; } -#--------- +#-------------------- -sub index() {shift->{index}} -sub filename() {shift->{filename}} -sub originalCharset() {shift->{origcharset}} +sub index() { $_[0]->{index} } +sub filename() { $_[0]->{filename} } +sub originalCharset() { $_[0]->{origcharset} } -#--------------- +#-------------------- sub msgid($;$) -{ my ($self, $msgid, $msgctxt) = @_; - my $tag = $msgid.'#'.($msgctxt//''); - $self->{index}{$tag}; +{ my ($self, $msgid, $msgctxt) = @_; + my $tag = $msgid.'#'.($msgctxt//''); + $self->{index}{$tag}; } sub msgstr($;$$) -{ my $po = $_[0]->msgid($_[1], $_[3]) - or return undef; +{ my $po = $_[0]->msgid($_[1], $_[3]) + or return undef; - ref $po # no plurals defined - or return $po; + ref $po # no plurals defined + or return $po; - # speed!!! - $po->[$_[0]->{algo}->(defined $_[2] ? $_[2] : 1)] - || $po->[$_[0]->{algo}->(1)]; + # speed!!! + $po->[$_[0]->{algo}->(defined $_[2] ? $_[2] : 1)] + || $po->[$_[0]->{algo}->(1)]; } 1; diff -pruN 1.12-1/lib/Log/Report/Lexicon/MOTcompact.pod 1.14-1/lib/Log/Report/Lexicon/MOTcompact.pod --- 1.12-1/lib/Log/Report/Lexicon/MOTcompact.pod 2025-04-18 15:10:21.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon/MOTcompact.pod 2025-09-08 13:31:48.000000000 +0000 @@ -11,12 +11,12 @@ Log::Report::Lexicon::MOTcompact - use t =head1 SYNOPSIS - # using a MO table efficiently - my $mot = Log::Report::Lexicon::MOTcompact->read('mo/nl.mo') - or die; + # using a MO table efficiently + my $mot = Log::Report::Lexicon::MOTcompact->read('mo/nl.mo') + or die; - my $header = $mot->msgid(''); - print $mot->msgstr($msgid, 3); + my $header = $mot->msgid(''); + print $mot->msgstr($msgid, 3); =head1 DESCRIPTION @@ -29,31 +29,31 @@ speed for memory. That may change again To get a MO file, you first need a PO file. Then run F, which is part of the gnu gettext package. - msgfmt -cv -o $domain.mo $domain.po + msgfmt -cv -o $domain.mo $domain.po - # -c = --check-format & --check-header & --check-domain - # -v = --verbose - # -o = --output-file + # -c = --check-format & --check-header & --check-domain + # -v = --verbose + # -o = --output-file Extends L<"DESCRIPTION" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"DESCRIPTION">. - + =head1 METHODS Extends L<"METHODS" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"METHODS">. - + =head2 Constructors Extends L<"Constructors" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Constructors">. - + =over 4 -=item Log::Report::Lexicon::MOTcompact-EB(%options) +=item $class-EB(%options) Inherited, see L -=item Log::Report::Lexicon::MOTcompact-EB($filename, %options) +=item $class-EB($filename, %options) -Read the MOT table information from $filename. +Read the MOT table information from C<$filename>. -Option --Default charset @@ -72,7 +72,7 @@ taken from the "Content-Type" field in t =head2 Attributes Extends L<"Attributes" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Attributes">. - + =over 4 =item $obj-EB() @@ -94,30 +94,32 @@ converted into utf8 before you use them =head2 Managing PO's Extends L<"Managing PO's" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Managing PO's">. - + =head3 Translation Extends L<"Translation" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Translation">. - + =over 4 =item $obj-EB( STRING, [$msgctxt] ) -Lookup the translations with the STRING. Returns a SCALAR, when only +Lookup the translations with the C. Returns a SCALAR, when only one translation is known, and an ARRAY when we have plural forms. Returns C when the translation is not defined. +Improves base, see L =item $obj-EB( $msgid, [$count, $msgctxt] ) -Returns the translated string for $msgid. When not specified, $count is 1 +Returns the translated string for C<$msgid>. When not specified, C<$count> is 1 (the singular form). +Improves base, see L =back =head3 Administration Extends L<"Administration" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Administration">. - + =over 4 =item $obj-EB($po) @@ -150,20 +152,95 @@ Inherited, see L +This module is part of Log-Report-Lexicon version 1.14, +built on September 08, 2025. Website: F =head1 LICENSE -Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. +For contributors see file ChangeLog. + +This software is copyright (c) 2007-2025 by Mark Overmeer. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. -See F +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff -pruN 1.12-1/lib/Log/Report/Lexicon/PO.pm 1.14-1/lib/Log/Report/Lexicon/PO.pm --- 1.12-1/lib/Log/Report/Lexicon/PO.pm 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon/PO.pm 2025-09-08 13:31:48.000000000 +0000 @@ -1,13 +1,20 @@ -# Copyrights 2007-2025 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.03. -# This code is part of distribution Log-Report-Lexicon. 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. +# This code is part of Perl distribution Log-Report-Lexicon version 1.14. +# The POD got stripped from this file by OODoc version 3.04. +# For contributors see file ChangeLog. + +# This software is copyright (c) 2007-2025 by Mark Overmeer. + +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later + +#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION *** +#oodist: This file contains OODoc-style documentation which will get stripped +#oodist: during its release in the distribution. You can use this file for +#oodist: testing, however the code of this development version may be broken! package Log::Report::Lexicon::PO;{ -our $VERSION = '1.12'; +our $VERSION = '1.14'; } @@ -21,30 +28,33 @@ use Log::Report::Lexicon::POTcompact (); *_escape = \&Log::Report::Lexicon::POTcompact::_escape; *_unescape = \&Log::Report::Lexicon::POTcompact::_unescape; +sub flat(@) { grep defined, ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_ } + +#-------------------- sub new(@) -{ my $class = shift; - (bless {}, $class)->init( {@_} ); +{ my $class = shift; + (bless {}, $class)->init( {@_} ); } sub init($) -{ my ($self, $args) = @_; - defined($self->{msgid} = delete $args->{msgid}) - or error "no msgid defined for PO"; - - $self->{plural} = delete $args->{msgid_plural}; - $self->{msgstr} = delete $args->{msgstr}; - $self->{msgctxt} = delete $args->{msgctxt}; - - $self->addComment(delete $args->{comment}); - $self->addAutomatic(delete $args->{automatic}); - $self->fuzzy(delete $args->{fuzzy}); - - $self->{refs} = {}; - $self->addReferences(delete $args->{references}) - if defined $args->{references}; +{ my ($self, $args) = @_; + defined($self->{msgid} = delete $args->{msgid}) + or error __"no msgid defined for PO"; + + $self->{plural} = delete $args->{msgid_plural}; + $self->{msgstr} = delete $args->{msgstr}; + $self->{msgctxt} = delete $args->{msgctxt}; + + $self->addComment(delete $args->{comment}); + $self->addAutomatic(delete $args->{automatic}); + $self->fuzzy(delete $args->{fuzzy}); + + $self->{refs} = {}; + $self->addReferences(delete $args->{references}) + if defined $args->{references}; - $self; + $self; } # only for internal usage @@ -52,320 +62,313 @@ sub _fast_new($) { bless $_[1], $_[0] } #-------------------- -sub msgid() {shift->{msgid}} -sub msgctxt() {shift->{msgctxt}} +sub msgid() { $_[0]->{msgid} } +sub msgctxt() { $_[0]->{msgctxt} } sub plural(;$) -{ my $self = shift; - @_ or return $self->{plural}; - - if(my $m = $self->{msgstr}) - { # prepare msgstr list for multiple translations. - $self->{msgstr} = [ $m ] if defined $m && !ref $m; - } +{ my $self = shift; + @_ or return $self->{plural}; - $self->{plural} = shift; + if(my $m = $self->{msgstr}) + { # prepare msgstr list for multiple translations. + $self->{msgstr} = [ $m ] if defined $m && !ref $m; + } + + $self->{plural} = shift; } sub msgstr($;$) -{ my $self = shift; - my $m = $self->{msgstr}; +{ my $self = shift; + my $m = $self->{msgstr}; - unless($self->{plural}) - { $self->{msgstr} = $_[1] if @_==2; - return $m; - } + unless($self->{plural}) + { $self->{msgstr} = $_[1] if @_==2; + return $m; + } - my $index = shift || 0; - @_ ? $m->[$index] = shift : $m->[$index]; + my $index = shift || 0; + @_ ? $m->[$index] = shift : $m->[$index]; } sub comment(@) -{ my $self = shift; - @_ or return $self->{comment}; - $self->{comment} = ''; - $self->addComment(@_); +{ my $self = shift; + @_ or return $self->{comment}; + $self->{comment} = ''; + $self->addComment(@_); } sub addComment(@) -{ my $self = shift; - my $comment = $self->{comment}; - foreach my $line (ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_) - { defined $line or next; - $line =~ s/[\r\n]+/\n/; # cleanup line-endings - $comment .= $line; - } - - # be sure there is a \n at the end - $comment =~ s/\n?\z/\n/ if defined $comment; - $self->{comment} = $comment; +{ my $self = shift; + my @lines = flat @_; + my $comment = $self->{comment}; + + foreach my $line (@lines) + { defined $line or next; + $line =~ s/[\r\n]+/\n/; # cleanup line-endings + $comment .= $line; + } + + # be sure there is a \n at the end + $comment =~ s/\n?\z/\n/ if defined $comment; + $self->{comment} = $comment; } sub automatic(@) -{ my $self = shift; - @_ or return $self->{automatic}; - $self->{automatic} = ''; - $self->addAutomatic(@_); +{ my $self = shift; + @_ or return $self->{automatic}; + $self->{automatic} = ''; + $self->addAutomatic(@_); } sub addAutomatic(@) -{ my $self = shift; - my $auto = $self->{automatic}; - foreach my $line (ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_) - { defined $line or next; - $line =~ s/[\r\n]+/\n/; # cleanup line-endings - $auto .= $line; - } +{ my $self = shift; + my @lines = flat @_; + + my $auto = $self->{automatic}; + foreach my $line (@lines) + { $line =~ s/[\r\n]+/\n/; # cleanup line-endings + $auto .= $line; + } - $auto =~ s/\n?\z/\n/ if defined $auto; # be sure there is a \n at the end - $self->{automatic} = $auto; + $auto =~ s/\n?\z/\n/ if defined $auto; # be sure there is a \n at the end + $self->{automatic} = $auto; } sub references(@) -{ my $self = shift; - if(@_) - { $self->{refs} = {}; - $self->addReferences(@_); - } +{ my $self = shift; + if(@_) + { $self->{refs} = +{ }; + $self->addReferences(@_); + } - keys %{$self->{refs}}; + keys %{$self->{refs}}; } sub addReferences(@) -{ my $self = shift; - my $refs = $self->{refs} ||= {}; - @_ or return $refs; - - $refs->{$_}++ - for @_ > 1 ? @_ # list - : ref $_[0] eq 'ARRAY' ? @{$_[0]} # array - : split " ",$_[0]; # scalar - $refs; +{ my $self = shift; + my $refs = $self->{refs} ||= {}; + + my @new = @_==1 && defined $_[0] && ref $_[0] ne 'ARRAY' ? split(" ", $_[0]) : flat @_; + $refs->{$_}++ for @new; + $refs; } sub removeReferencesTo($) -{ my $refs = $_[0]->{refs}; - my $match = qr/^\Q$_[1]\E\:[0-9]+$/; - $_ =~ $match && delete $refs->{$_} - for keys %$refs; +{ my $refs = $_[0]->{refs}; + my $match = qr/^\Q$_[1]\E\:[0-9]+$/; + $_ =~ $match && delete $refs->{$_} + for keys %$refs; - scalar keys %$refs; + scalar keys %$refs; } sub keepReferencesTo($) -{ my $refs = shift->{refs}; - my $keep = shift; +{ my $refs = shift->{refs}; + my $keep = shift; - foreach my $ref (keys %$refs) - { (my $fn = $ref) =~ s/\:[0-9]+$//; - $keep->{$fn} or delete $refs->{$ref}; - } + foreach my $ref (keys %$refs) + { (my $fn = $ref) =~ s/\:[0-9]+$//; + $keep->{$fn} or delete $refs->{$ref}; + } - scalar keys %$refs; + scalar keys %$refs; } sub isActive() { $_[0]->{msgid} eq '' || keys %{$_[0]->{refs}} } -sub fuzzy(;$) {my $self = shift; @_ ? $self->{fuzzy} = shift : $self->{fuzzy}} +sub fuzzy(;$) { my $self = shift; @_ ? $self->{fuzzy} = shift : $self->{fuzzy} } sub format(@) -{ my $format = shift->{format}; - return $format->{ (shift) } - if @_==1 && !ref $_[0]; # language - - my @pairs = @_ > 1 ? @_ : ref $_[0] eq 'ARRAY' ? @{$_[0]} : %{$_[0]}; - while(@pairs) - { my($k, $v) = (shift @pairs, shift @pairs); - $format->{$k} = $v; - } - $format; +{ my $format = shift->{format}; + return $format->{ (shift) } + if @_==1 && !ref $_[0]; # language + + my @pairs = ref $_[0] eq 'HASH' ? %{$_[0]} : flat @_; + while(@pairs) + { my($k, $v) = (shift @pairs, shift @pairs); + $format->{$k} = $v; + } + $format; } + sub addFlags($) -{ my $self = shift; - local $_ = shift; - my $where = shift; - - s/^\s+//; - s/\s*$//; - foreach my $flag (split /\s*\,\s*/) - { if($flag eq 'fuzzy') { $self->fuzzy(1) } - elsif($flag =~ m/^no-(.*)-format$/) { $self->format($1, 0) } - elsif($flag =~ m/^(.*)-format$/) { $self->format($1, 1) } - else - { warning __x"unknown flag {flag} ignored", flag => $flag; - } - } - $_; +{ my $self = shift; + local $_ = shift; + my $where = shift; + + s/^\s+//; + s/\s*$//; + foreach my $flag (split /\s*\,\s*/) + { if($flag eq 'fuzzy') { $self->fuzzy(1) } + elsif($flag =~ m/^no-(.*)-format$/) { $self->format($1, 0) } + elsif($flag =~ m/^(.*)-format$/) { $self->format($1, 1) } + else + { warning __x"unknown flag {flag} ignored", flag => $flag; + } + } + $_; } +#-------------------- + sub fromText($$) -{ my $class = shift; - my @lines = split /[\r\n]+/, shift; - my $where = shift || ' unknown location'; - - my $self = bless {}, $class; - - # translations which are not used anymore are escaped with #~ - # however, we just say: no references found. - s/^\#\~\s+// for @lines; - - my $last; # used for line continuations - foreach (@lines) - { s/\r?\n$//; - if( s/^\#(.)\s?// ) - { if($1 =~ /\s/) { $self->addComment($_) } - elsif($1 eq '.' ) { $self->addAutomatic($_) } - elsif($1 eq ':' ) { $self->addReferences($_) } - elsif($1 eq ',' ) { $self->addFlags($_) } - else - { warning __x"unknown comment type '{cmd}' at {where}" - , cmd => "#$1", where => $where; - } - undef $last; - } - elsif( s/^\s*(\w+)\s+// ) - { my $cmd = $1; - my $string = _unescape($_,$where); - - if($cmd eq 'msgid') - { $self->{msgid} = $string; - $last = \($self->{msgid}); - } - elsif($cmd eq 'msgid_plural') - { $self->{plural} = $string; - $last = \($self->{plural}); - } - elsif($cmd eq 'msgstr') - { $self->{msgstr} = $string; - $last = \($self->{msgstr}); - } - elsif($cmd eq 'msgctxt') - { $self->{msgctxt} = $string; - $last = \($self->{msgctxt}); - } - else - { warning __x"do not understand command '{cmd}' at {where}" - , cmd => $cmd, where => $where; - undef $last; - } - } - elsif( s/^\s*msgstr\[(\d+)\]\s*// ) - { my $nr = $1; - $self->{msgstr}[$nr] = _unescape($_,$where); - } - elsif( m/^\s*\"/ ) - { if(defined $last) { $$last .= _unescape($_,$where) } - else - { warning __x"quoted line is not a continuation at {where}" - , where => $where; - } - } - else - { warning __x"do not understand line at {where}:\n {line}" - , where => $where, line => $_; - } - } +{ my $class = shift; + my @lines = split /[\r\n]+/, shift; + my $where = shift || ' unknown location'; + + my $self = bless +{}, $class; + + # translations which are not used anymore are escaped with #~ + # however, we just say: no references found. + s/^\#\~\s+// for @lines; + + my $last; # used for line continuations + foreach (@lines) + { s/\r?\n$//; + if( s/^\#(.)\s?// ) + { if($1 =~ /\s/) { $self->addComment($_) } + elsif($1 eq '.' ) { $self->addAutomatic($_) } + elsif($1 eq ':' ) { $self->addReferences($_) } + elsif($1 eq ',' ) { $self->addFlags($_) } + else + { warning __x"unknown comment type '{cmd}' at {where}", cmd => "#$1", where => $where; + } + undef $last; + } + elsif( s/^\s*(\w+)\s+// ) + { my $cmd = $1; + my $string = _unescape($_,$where); + + if($cmd eq 'msgid') + { $self->{msgid} = $string; + $last = \($self->{msgid}); + } + elsif($cmd eq 'msgid_plural') + { $self->{plural} = $string; + $last = \($self->{plural}); + } + elsif($cmd eq 'msgstr') + { $self->{msgstr} = $string; + $last = \($self->{msgstr}); + } + elsif($cmd eq 'msgctxt') + { $self->{msgctxt} = $string; + $last = \($self->{msgctxt}); + } + else + { warning __x"do not understand command '{cmd}' at {where}", cmd => $cmd, where => $where; + undef $last; + } + } + elsif( s/^\s*msgstr\[(\d+)\]\s*// ) + { my $nr = $1; + $self->{msgstr}[$nr] = _unescape($_,$where); + } + elsif( m/^\s*\"/ ) + { if(defined $last) { $$last .= _unescape($_, $where) } + else + { warning __x"quoted line is not a continuation at {where}", where => $where; + } + } + else + { warning __x"do not understand line at {where}:\n {line}", where => $where, line => $_; + } + } - defined $self->{msgid} - or warning __x"no msgid in block {where}", where => $where; + defined $self->{msgid} + or warning __x"no msgid in block {where}", where => $where; - $self; + $self; } sub toString(@) -{ my ($self, %args) = @_; - my $nplurals = $args{nr_plurals}; - my @record; - - my $comment = $self->comment; - if(defined $comment && length $comment) - { $comment =~ s/^/# /gm; - push @record, $comment; - } - - my $auto = $self->automatic; - if(defined $auto && length $auto) - { $auto =~ s/^/#. /gm; - push @record, $auto; - } - - my @refs = sort $self->references; - my $msgid = $self->{msgid} || ''; - my $active = $msgid eq '' || @refs ? '' : '#~ '; - - while(@refs) - { my $line = '#:'; - $line .= ' '.shift @refs - while @refs && length($line) + length($refs[0]) < 80; - push @record, "$line\n"; - } - - my @flags = $self->{fuzzy} ? 'fuzzy' : (); - - push @flags, ($self->{format}{$_} ? '' : 'no-') . $_ . '-format' - for sort keys %{$self->{format}}; - - push @record, "#, ". join(", ", @flags) . "\n" - if @flags; - - my $msgctxt = $self->{msgctxt}; - if(defined $msgctxt && length $msgctxt) - { push @record, "${active}msgctxt "._escape($msgctxt, "\n$active")."\n"; - } - push @record, "${active}msgid "._escape($msgid, "\n$active")."\n"; - - my $msgstr = $self->{msgstr} || []; - my @msgstr = ref $msgstr ? @$msgstr : $msgstr; - my $plural = $self->{plural}; - if(defined $plural) - { push @record - , "${active}msgid_plural " . _escape($plural, "\n$active") . "\n"; - - push @msgstr, '' - while defined $nplurals && @msgstr < $nplurals; - - if(defined $nplurals && @msgstr > $nplurals) - { warning __x"too many plurals for '{msgid}'", msgid => $msgid; - $#msgstr = $nplurals -1; - } - - $nplurals ||= 2; - for(my $nr = 0; $nr < $nplurals; $nr++) - { push @record, "${active}msgstr[$nr] " - . _escape($msgstr[$nr], "\n$active") . "\n"; - } - } - else - { warning __x"no plurals for '{msgid}'", msgid => $msgid - if @msgstr > 1; - - push @record - , "${active}msgstr " . _escape($msgstr[0], "\n$active") . "\n"; - } +{ my ($self, %args) = @_; + my $nplurals = $args{nr_plurals}; + my @record; + + my $comment = $self->comment; + if(defined $comment && length $comment) + { $comment =~ s/^/# /gm; + push @record, $comment; + } + + my $auto = $self->automatic; + if(defined $auto && length $auto) + { $auto =~ s/^/#. /gm; + push @record, $auto; + } + + my @refs = sort $self->references; + my $msgid = $self->{msgid} || ''; + my $active = $msgid eq '' || @refs ? '' : '#~ '; + + while(@refs) + { my $line = '#:'; + $line .= ' '.shift @refs while @refs && length($line) + length($refs[0]) < 80; + push @record, "$line\n"; + } + + my @flags = $self->{fuzzy} ? 'fuzzy' : (); + + push @flags, ($self->{format}{$_} ? '' : 'no-') . $_ . '-format' + for sort keys %{$self->{format}}; + + push @record, "#, ". join(", ", @flags) . "\n" + if @flags; + + my $msgctxt = $self->{msgctxt}; + if(defined $msgctxt && length $msgctxt) + { push @record, "${active}msgctxt "._escape($msgctxt, "\n$active")."\n"; + } + push @record, "${active}msgid "._escape($msgid, "\n$active")."\n"; + + my $msgstr = $self->{msgstr} || []; + my @msgstr = ref $msgstr ? @$msgstr : $msgstr; + my $plural = $self->{plural}; + if(defined $plural) + { push @record, "${active}msgid_plural " . _escape($plural, "\n$active") . "\n"; + + push @msgstr, '' + while defined $nplurals && @msgstr < $nplurals; + + if(defined $nplurals && @msgstr > $nplurals) + { warning __x"too many plurals for '{msgid}'", msgid => $msgid; + $#msgstr = $nplurals -1; + } + + $nplurals ||= 2; + for(my $nr = 0; $nr < $nplurals; $nr++) + { push @record, "${active}msgstr[$nr] " . _escape($msgstr[$nr], "\n$active") . "\n"; + } + } + else + { warning __x"no plurals for '{msgid}'", msgid => $msgid if @msgstr > 1; + push @record, "${active}msgstr " . _escape($msgstr[0], "\n$active") . "\n"; + } - join '', @record; + join '', @record; } sub useless() -{ my $self = shift; - ! $self->references && ! $self->msgstr(0); +{ my $self = shift; + ! $self->references && ! $self->msgstr(0); } *unused = \&useless; # before <1.02 diff -pruN 1.12-1/lib/Log/Report/Lexicon/PO.pod 1.14-1/lib/Log/Report/Lexicon/PO.pod --- 1.12-1/lib/Log/Report/Lexicon/PO.pod 2025-04-18 15:10:21.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon/PO.pod 2025-09-08 13:31:48.000000000 +0000 @@ -17,7 +17,9 @@ records are kept in a POT file, implemen =over 4 -=item Log::Report::Lexicon::PO-EB(%options) +=item $class-EB(%options) + +Z<> -Option --Default automatic "" @@ -96,43 +98,43 @@ Parse a "flags" line. =item $obj-EB(STRING|LIST|ARRAY) -The STRING is a blank separated list of LOCATIONS. The LIST and -ARRAY contain separate LOCATIONs. A LOCATION is of the form +The C is a blank separated list of LOCATIONS. The C and +C contain separate LOCATIONs. A LOCATION is of the form C. Returns the internal HASH with references. =item $obj-EB( [LIST|ARRAY|STRING] ) -Returns a STRING which contains the cleaned paragraph of automatically +Returns a C which contains the cleaned paragraph of automatically added comments. If an argument is specified, it will replace the current comment. =item $obj-EB( [LIST|ARRAY|STRING] ) -Returns a STRING which contains the cleaned paragraph of translator's +Returns a C which contains the cleaned paragraph of translator's comment. If an argument is specified, it will replace the current comment. =item $obj-EB( $language | ) -When one $language is specified, it looks whether a C<$language-format> or -C is present in the line of FLAGS. This will return -C<1> (true) in the first case, C<0> (false) in the second case. It will -return C (also false) in case that both are not present. +When one C<$language> is specified, it looks whether a "language-format" or +"no-language-format" is present in the line of FLAGS. This will return +C<1> (C) in the first case, C<0> (C) in the second case. It will +return C (also C) in case that both are not present. -You can also specify PAIRS: the key is a language name, and the +You can also specify C: the key is a language name, and the value is either C<0>, C<1>, or C. example: use of format() - # getters - if($po->format('c')) ... - unless($po->format('perl-brace')) ... - if(defined $po->format('java')) ... - - # setters - $po->format(java => 1); # results in 'java-format' - $po->format(java => 0); # results in 'no-java-format' - $po->format(java => undef); # results in '' + # getters + if($po->format('c')) ... + unless($po->format('perl-brace')) ... + if(defined $po->format('java')) ... + + # setters + $po->format(java => 1); # results in 'java-format' + $po->format(java => 0); # results in 'no-java-format' + $po->format(java => undef); # results in '' =item $obj-EB( [BOOLEAN] ) @@ -144,7 +146,7 @@ Returns whether the translation has any =item $obj-EB($table) -Remove all references which are not found as key in the hash $table. +Remove all references which are not found as key in the hash C<$table>. Returns the number of references left. =item $obj-EB() @@ -157,8 +159,8 @@ Returns the actual msgid, which cannot b =item $obj-EB( [$index, [STRING]] ) -With a STRING, a new translation will be set. Without STRING, a -lookup will take place. When no plural is defined, the $index is +With a C, a new translation will be set. Without C, a +lookup will take place. When no plural is defined, the C<$index> is ignored. =item $obj-EB( [STRING] ) @@ -169,11 +171,11 @@ Returns the actual msgid_plural, which c Returns an unsorted list of LOCATIONS. When options are specified, then those will be used to replace all currently defined references. -Returns the unsorted LIST of references. +Returns the unsorted C of references. =item $obj-EB($filename) -Remove all the references to the indicate $filename from the list. Returns +Remove all the references to the indicate C<$filename> from the list. Returns the number of refs left. =back @@ -182,10 +184,10 @@ the number of refs left. =over 4 -=item Log::Report::Lexicon::PO-EB( STRING, [$where] ) +=item $class-EB( STRING, [$where] ) -Parse the STRING into a new PO object. The $where string should explain -the location of the STRING, to be used in error messages. +Parse the C into a new PO object. The C<$where> string should explain +the location of the C, to be used in error messages. =item $obj-EB(%options) @@ -210,16 +212,59 @@ behavior is attempted. =back +=head1 DIAGNOSTICS + +=over 4 + +=item Warning: do not understand command '$cmd' at $where + +Cast by fromText() + +=item Warning: do not understand line at $where:\n $line + +Cast by fromText() + +=item Error: no msgid defined for PO + +Cast by new() + +=item Warning: no msgid in block $where + +Cast by fromText() + +=item Warning: no plurals for '$msgid' + +Cast by toString() + +=item Warning: quoted line is not a continuation at $where + +Cast by fromText() + +=item Warning: too many plurals for '$msgid' + +Cast by toString() + +=item Warning: unknown comment type '$cmd' at $where + +Cast by fromText() + +=item Warning: unknown flag $flag ignored + +Cast by addFlags() + +=back + =head1 SEE ALSO -This module is part of Log-Report-Lexicon distribution version 1.12, -built on April 18, 2025. Website: F +This module is part of Log-Report-Lexicon version 1.14, +built on September 08, 2025. Website: F =head1 LICENSE -Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. +For contributors see file ChangeLog. + +This software is copyright (c) 2007-2025 by Mark Overmeer. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. -See F +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff -pruN 1.12-1/lib/Log/Report/Lexicon/POT.pm 1.14-1/lib/Log/Report/Lexicon/POT.pm --- 1.12-1/lib/Log/Report/Lexicon/POT.pm 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon/POT.pm 2025-09-08 13:31:48.000000000 +0000 @@ -1,13 +1,26 @@ -# Copyrights 2007-2025 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.03. +# This code is part of Perl distribution Log-Report-Lexicon version 1.14. +# The POD got stripped from this file by OODoc version 3.04. +# For contributors see file ChangeLog. + +# This software is copyright (c) 2007-2025 by Mark Overmeer. + +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later + +#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION *** +#oodist: This file contains OODoc-style documentation which will get stripped +#oodist: during its release in the distribution. You can use this file for +#oodist: testing, however the code of this development version may be broken! +#oorestyle: old style disclaimer to be removed. +#oorestyle: not found P for method filename($filename) + # This code is part of distribution Log-Report-Lexicon. 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::Lexicon::POT;{ -our $VERSION = '1.12'; +our $VERSION = '1.14'; } use base 'Log::Report::Lexicon::Table'; @@ -25,246 +38,242 @@ use Encode qw/decode/; use constant MSGID_HEADER => ''; +#-------------------- sub init($) -{ my ($self, $args) = @_; +{ my ($self, $args) = @_; - $self->{LRLP_fn} = $args->{filename}; - $self->{LRLP_index} = $args->{index} || {}; - $self->{LRLP_charset} = $args->{charset} || 'UTF-8'; - - my $version = $args->{version}; - my $domain = $args->{textdomain} - or error __"textdomain parameter is required"; - - my $forms = $args->{plural_forms}; - unless($forms) - { my $nrplurals = $args->{nr_plurals} || 2; - my $algo = $args->{plural_alg} || 'n!=1'; - $forms = "nplurals=$nrplurals; plural=($algo);"; - } - - $self->_createHeader - ( project => $domain . (defined $version ? " $version" : '') - , forms => $forms - , charset => $args->{charset} - , date => $args->{date} - ); + $self->{LRLP_fn} = $args->{filename}; + $self->{LRLP_index} = $args->{index} || {}; + $self->{LRLP_charset} = $args->{charset} || 'UTF-8'; + + my $version = $args->{version}; + my $domain = $args->{textdomain} + or error __"textdomain parameter is required"; + + my $forms = $args->{plural_forms}; + unless($forms) + { my $nrplurals = $args->{nr_plurals} || 2; + my $algo = $args->{plural_alg} || 'n!=1'; + $forms = "nplurals=$nrplurals; plural=($algo);"; + } + + $self->_createHeader( + project => $domain . (defined $version ? " $version" : ''), + forms => $forms, + charset => $args->{charset}, + date => $args->{date} + ); - $self->setupPluralAlgorithm; - $self; + $self->setupPluralAlgorithm; + $self; } sub read($@) -{ my ($class, $fn, %args) = @_; - my $self = bless {LRLP_index => {}}, $class; +{ my ($class, $fn, %args) = @_; + my $self = bless {LRLP_index => {}}, $class; - my $charset = $args{charset}; - $charset = $1 - if !$charset && $fn =~ m!\.([\w-]+)(?:\@[^/\\]+)?\.po$!i; - - my $fh; - if(defined $charset) - { open $fh, "<:encoding($charset):crlf", $fn - or fault __x"cannot read in {cs} from file {fn}" - , cs => $charset, fn => $fn; - } - else - { open $fh, '<:raw:crlf', $fn - or fault __x"cannot read from file {fn} (unknown charset)", fn=>$fn; - } - - local $/ = "\n\n"; - my $linenr = 1; # $/ frustrates $fh->input_line_number - while(1) - { my $location = "$fn line $linenr"; - my $block = <$fh>; - defined $block or last; - - $linenr += $block =~ tr/\n//; - - $block =~ s/\s+\z//s; - length $block or last; - - unless($charset) - { $charset = $block =~ m/\"content-type:.*?charset=["']?([\w-]+)/mi - ? $1 : error __x"cannot detect charset in {fn}", fn => $fn; - trace "auto-detected charset $charset for $fn"; - binmode $fh, ":encoding($charset):crlf"; - - $block = decode $charset, $block - or error __x"unsupported charset {charset} in {fn}" - , charset => $charset, fn => $fn; - } - - my $po = Log::Report::Lexicon::PO->fromText($block, $location); - $self->add($po) if $po; - } + my $charset = $args{charset}; + $charset = $1 + if !$charset && $fn =~ m!\.([\w-]+)(?:\@[^/\\]+)?\.po$!i; + + my $fh; + if(defined $charset) + { open $fh, "<:encoding($charset):crlf", $fn + or fault __x"cannot read in {cs} from file {fn}", cs => $charset, fn => $fn; + } + else + { open $fh, '<:raw:crlf', $fn + or fault __x"cannot read from file {fn} (unknown charset)", fn=>$fn; + } + + local $/ = "\n\n"; + my $linenr = 1; # $/ frustrates $fh->input_line_number + while(1) + { my $location = "$fn line $linenr"; + my $block = <$fh>; + defined $block or last; + + $linenr += $block =~ tr/\n//; + + $block =~ s/\s+\z//s; + length $block or last; + + unless($charset) + { $charset = $block =~ m/\"content-type:.*?charset=["']?([\w-]+)/mi ? $1 + : error __x"cannot detect charset in {fn}", fn => $fn; + + trace "auto-detected charset $charset for $fn"; + binmode $fh, ":encoding($charset):crlf"; + + $block = decode $charset, $block + or error __x"unsupported charset {charset} in {fn}", charset => $charset, fn => $fn; + } + + my $po = Log::Report::Lexicon::PO->fromText($block, $location); + $self->add($po) if $po; + } - close $fh - or fault __x"failed reading from file {fn}", fn => $fn; + close $fh + or fault __x"failed reading from file {fn}", fn => $fn; - $self->{LRLP_fn} = $fn; - $self->{LRLP_charset} = $charset; + $self->{LRLP_fn} = $fn; + $self->{LRLP_charset} = $charset; - $self->setupPluralAlgorithm; - $self; + $self->setupPluralAlgorithm; + $self; } + sub write($@) -{ my $self = shift; - my $file = @_%2 ? shift : $self->filename; - my %args = @_; +{ my $self = shift; + my $file = @_%2 ? shift : $self->filename; + my %args = @_; - defined $file - or error __"no filename or file-handle specified for PO"; + defined $file + or error __"no filename or file-handle specified for PO"; - my $need_refs = $args{only_active}; - my @opt = (nr_plurals => $self->nrPlurals); + my $need_refs = $args{only_active}; + my @opt = (nr_plurals => $self->nrPlurals); - my $fh; - if(ref $file) { $fh = $file } - else - { my $layers = '>:encoding('.$self->charset.')'; - open $fh, $layers, $file - or fault __x"cannot write to file {fn} with {layers}" - , fn => $file, layers => $layers; - } + my $fh; + if(ref $file) { $fh = $file } + else + { my $layers = '>:encoding('.$self->charset.')'; + open $fh, $layers, $file + or fault __x"cannot write to file {fn} with {layers}", fn => $file, layers => $layers; + } - $fh->print($self->msgid(MSGID_HEADER)->toString(@opt)); - my $index = $self->index; - foreach my $msgid (sort keys %$index) - { next if $msgid eq MSGID_HEADER; + $fh->print($self->msgid(MSGID_HEADER)->toString(@opt)); + my $index = $self->index; + foreach my $msgid (sort keys %$index) + { next if $msgid eq MSGID_HEADER; - my $rec = $index->{$msgid}; - my @recs = blessed $rec ? $rec # one record with $msgid - : @{$rec}{sort keys %$rec}; # multiple records, msgctxt + my $rec = $index->{$msgid}; + my @recs = blessed $rec ? $rec # one record with $msgid + : @{$rec}{sort keys %$rec}; # multiple records, msgctxt - foreach my $po (@recs) - { next if $po->useless; - next if $need_refs && !$po->references; - $fh->print("\n", $po->toString(@opt)); - } - } + foreach my $po (@recs) + { next if $po->useless; + next if $need_refs && !$po->references; + $fh->print("\n", $po->toString(@opt)); + } + } - $fh->close - or failure __x"write errors for file {fn}", fn => $file; + $fh->close + or failure __x"write errors for file {fn}", fn => $file; - $self; + $self; } -#----------------------- +#-------------------- -sub charset() {shift->{LRLP_charset}} -sub index() {shift->{LRLP_index}} -sub filename() {shift->{LRLP_fn}} +sub charset() { $_[0]->{LRLP_charset} } +sub index() { $_[0]->{LRLP_index} } +sub filename() { $_[0]->{LRLP_fn} } -sub language() { shift->filename =~ m![/\\](\w+)[^/\\]*$! ? $1 : undef } +sub language() { $_[0]->filename =~ m![/\\](\w+)[^/\\]*$! ? $1 : undef } -#----------------------- +#-------------------- sub msgid($;$) -{ my ($self, $msgid, $msgctxt) = @_; - my $msgs = $self->index->{$msgid} or return; +{ my ($self, $msgid, $msgctxt) = @_; + my $msgs = $self->index->{$msgid} or return; - return $msgs - if blessed $msgs - && (!$msgctxt || $msgctxt eq $msgs->msgctxt); + return $msgs + if blessed $msgs + && (!$msgctxt || $msgctxt eq $msgs->msgctxt); - $msgs->{$msgctxt}; + $msgs->{$msgctxt}; } sub msgstr($;$$) -{ my ($self, $msgid, $count, $msgctxt) = @_; - my $po = $self->msgid($msgid, $msgctxt) - or return undef; +{ my ($self, $msgid, $count, $msgctxt) = @_; + my $po = $self->msgid($msgid, $msgctxt) + or return undef; - $count //= 1; - $po->msgstr($self->pluralIndex($count)); + $count //= 1; + $po->msgstr($self->pluralIndex($count)); } sub add($) -{ my ($self, $po) = @_; - my $msgid = $po->msgid; - my $index = $self->index; - - my $h = $index->{$msgid}; - $h or return $index->{$msgid} = $po; - - $h = $index->{$msgid} = +{ ($h->msgctxt // '') => $h } - if blessed $h; - - my $ctxt = $po->msgctxt // ''; - error __x"translation already exists for '{msgid}' with '{ctxt}" - , msgid => $msgid, ctxt => $ctxt - if $h->{$ctxt}; +{ my ($self, $po) = @_; + my $msgid = $po->msgid; + my $index = $self->index; + + my $h = $index->{$msgid}; + $h or return $index->{$msgid} = $po; + + $h = $index->{$msgid} = +{ ($h->msgctxt // '') => $h } + if blessed $h; + + my $ctxt = $po->msgctxt // ''; + error __x"translation already exists for '{msgid}' with '{ctxt}", msgid => $msgid, ctxt => $ctxt + if $h->{$ctxt}; - $h->{$ctxt} = $po; + $h->{$ctxt} = $po; } sub translations(;$) -{ my $self = shift; - @_ or return map +(blessed $_ ? $_ : values %$_) - , values %{$self->index}; +{ my $self = shift; + @_ or return map +(blessed $_ ? $_ : values %$_), values %{$self->index}; - error __x"the only acceptable parameter is 'ACTIVE', not '{p}'", p => $_[0] - if $_[0] ne 'ACTIVE'; + error __x"the only acceptable parameter is 'ACTIVE', not '{p}'", p => $_[0] + if $_[0] ne 'ACTIVE'; - grep $_->isActive, $self->translations; + grep $_->isActive, $self->translations; } sub _now() { strftime "%Y-%m-%d %H:%M%z", localtime } sub header($;$) -{ my ($self, $field) = (shift, shift); - my $header = $self->msgid(MSGID_HEADER) - or error __x"no header defined in POT for file {fn}" - , fn => $self->filename; - - if(!@_) - { my $text = $header->msgstr(0) || ''; - return $text =~ m/^\Q$field\E\:\s*([^\n]*?)\;?\s*$/im ? $1 : undef; - } - - my $content = shift; - my $text = $header->msgstr(0); - - for($text) - { if(defined $content) - { s/^\Q$field\E\:([^\n]*)/$field: $content/im # change - || s/\z/$field: $content\n/; # new - } - else - { s/^\Q$field\E\:[^\n]*\n?//im; # remove - } - } +{ my ($self, $field) = (shift, shift); + my $header = $self->msgid(MSGID_HEADER) + or error __x"no header defined in POT for file {fn}", fn => $self->filename; + + if(!@_) + { my $text = $header->msgstr(0) || ''; + return $text =~ m/^\Q$field\E\:\s*([^\n]*?)\;?\s*$/im ? $1 : undef; + } + + my $content = shift; + my $text = $header->msgstr(0); + + for($text) + { if(defined $content) + { s/^\Q$field\E\:([^\n]*)/$field: $content/im # change + || s/\z/$field: $content\n/; # new + } + else + { s/^\Q$field\E\:[^\n]*\n?//im; # remove + } + } - $header->msgstr(0, $text); - $content; + $header->msgstr(0, $text); + $content; } sub updated(;$) -{ my $self = shift; - my $date = shift || _now; - $self->header('PO-Revision-Date', $date); - $date; +{ my $self = shift; + my $date = shift || _now; + $self->header('PO-Revision-Date', $date); + $date; } ### internal sub _createHeader(%) -{ my ($self, %args) = @_; - my $date = $args{date} || _now; +{ my ($self, %args) = @_; + my $date = $args{date} || _now; - my $header = Log::Report::Lexicon::PO->new - ( msgid => MSGID_HEADER, msgstr => <<__CONFIG); + my $header = Log::Report::Lexicon::PO->new(msgid => MSGID_HEADER, msgstr => <<__CONFIG); Project-Id-Version: $args{project} Report-Msgid-Bugs-To: POT-Creation-Date: $date @@ -277,38 +286,38 @@ Content-Transfer-Encoding: 8bit Plural-Forms: $args{forms} __CONFIG - my $version = $Log::Report::VERSION || '0.0'; - $header->addAutomatic("Header generated with ".__PACKAGE__." $version\n"); + my $version = $Log::Report::VERSION || '0.0'; + $header->addAutomatic("Header generated with ".__PACKAGE__." $version\n"); - $self->index->{&MSGID_HEADER} = $header - if $header; + $self->index->{&MSGID_HEADER} = $header + if $header; - $header; + $header; } sub removeReferencesTo($) -{ my ($self, $filename) = @_; - sum map $_->removeReferencesTo($filename), $self->translations; +{ my ($self, $filename) = @_; + sum map $_->removeReferencesTo($filename), $self->translations; } sub keepReferencesTo($) -{ my ($self, $keep) = @_; - sum map $_->keepReferencesTo($keep), $self->translations; +{ my ($self, $keep) = @_; + sum map $_->keepReferencesTo($keep), $self->translations; } sub stats() -{ my $self = shift; - my %stats = (msgids => 0, fuzzy => 0, inactive => 0); - foreach my $po ($self->translations) - { next if $po->msgid eq MSGID_HEADER; - $stats{msgids}++; - $stats{fuzzy}++ if $po->fuzzy; - $stats{inactive}++ if !$po->isActive && !$po->useless; - } - \%stats; +{ my $self = shift; + my %stats = (msgids => 0, fuzzy => 0, inactive => 0); + foreach my $po ($self->translations) + { next if $po->msgid eq MSGID_HEADER; + $stats{msgids}++; + $stats{fuzzy}++ if $po->fuzzy; + $stats{inactive}++ if !$po->isActive && !$po->useless; + } + \%stats; } 1; diff -pruN 1.12-1/lib/Log/Report/Lexicon/POT.pod 1.14-1/lib/Log/Report/Lexicon/POT.pod --- 1.12-1/lib/Log/Report/Lexicon/POT.pod 2025-04-18 15:10:21.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon/POT.pod 2025-09-08 13:31:48.000000000 +0000 @@ -11,28 +11,27 @@ Log::Report::Lexicon::POT - manage PO fi =head1 SYNOPSIS - # this is usually not for end-users, See ::Extract::PerlPPI - # using a PO table + # this is usually not for end-users, See ::Extract::PerlPPI + # using a PO table - my $pot = Log::Report::Lexicon::POT - ->read('po/nl.po', charset => 'utf-8') - or die; - - my $po = $pot->msgid('msgid'); - my $po = $pot->msgid($msgid, $msgctxt); - print $pot->nrPlurals; - print $pot->msgstr('msgid', 3); - print $pot->msgstr($msgid, 3, $msgctxt); - $pot->write; # update the file - - # fill the table, by calling the next a lot - my $po = Log::Report::Lexicon::PO->new(...); - $pot->add($po); - - # creating a PO table - $pot->write('po/nl.po') + my $pot = Log::Report::Lexicon::POT->read('po/nl.po', charset => 'utf-8') or die; + my $po = $pot->msgid('msgid'); + my $po = $pot->msgid($msgid, $msgctxt); + print $pot->nrPlurals; + print $pot->msgstr('msgid', 3); + print $pot->msgstr($msgid, 3, $msgctxt); + $pot->write; # update the file + + # fill the table, by calling the next a lot + my $po = Log::Report::Lexicon::PO->new(...); + $pot->add($po); + + # creating a PO table + $pot->write('po/nl.po') + or die; + =head1 DESCRIPTION This module is reading, extending, and writing POT files. POT files @@ -47,18 +46,18 @@ sincere simplification. Each PO record L. Extends L<"DESCRIPTION" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"DESCRIPTION">. - + =head1 METHODS Extends L<"METHODS" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"METHODS">. - + =head2 Constructors Extends L<"Constructors" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Constructors">. - + =over 4 -=item Log::Report::Lexicon::POT-EB(%options) +=item $class-EB(%options) Create a new POT file. The initial header is generated for you, but it can be changed using the L method. @@ -118,9 +117,9 @@ PO files. =back -=item Log::Report::Lexicon::POT-EB($filename, %options) +=item $class-EB($filename, %options) -Read the POT information from $filename. +Read the POT information from C<$filename>. -Option --Default charset @@ -136,7 +135,7 @@ this explicitly. =item $obj-EB( [$filename|$fh], %options ) -When you pass an open $fh, you are yourself responsible that +When you pass an open C<$fh>, you are yourself responsible that the correct character-encoding (binmode) is set. When the write followed a L or the filename was explicitly set with L, then you may omit the first parameter. @@ -159,7 +158,7 @@ commented out (marked with '#~') but lef =head2 Attributes Extends L<"Attributes" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Attributes">. - + =over 4 =item $obj-EB() @@ -169,7 +168,7 @@ to be aware of Perl's internal encoding =item $obj-EB() -Returns the $filename, as derived from L or specified during +Returns the filename, as derived from L or specified during initiation with L. =item $obj-EB() @@ -187,17 +186,17 @@ Returns the language code, which is deri =head2 Managing PO's Extends L<"Managing PO's" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Managing PO's">. - + =over 4 =item $obj-EB($table) -Remove all references which are not found as key in the hash $table. +Remove all references which are not found as key in the hash C<$table>. Returns the number of references left. =item $obj-EB($filename) -Remove all the references to the indicate $filename from all defined +Remove all the references to the indicate C<$filename> from all defined translations. Returns the number of refs left. =item $obj-EB() @@ -206,7 +205,7 @@ Returns a HASH with some statistics abou =item $obj-EB( [$date] ) -Replace the "PO-Revision-Date" with the specified $date, or the current +Replace the "PO-Revision-Date" with the specified C<$date>, or the current moment. =back @@ -214,41 +213,45 @@ moment. =head3 Translation Extends L<"Translation" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Translation">. - + =over 4 =item $obj-EB( STRING, [$msgctxt] ) -Lookup the L with the STRING. If you +Lookup the L with the C. If you want to add a new translation, use L. Returns C when not defined. +Improves base, see L =item $obj-EB( $msgid, [$count, [$msgctxt]] ) -Returns the translated string for $msgid. When $count is not specified or +Returns the translated string for C<$msgid>. When C<$count> is not specified or C, the translation string related to "1" is returned. +Improves base, see L =back =head3 Administration Extends L<"Administration" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Administration">. - + =over 4 =item $obj-EB($po) -Add the information from a $po into this POT. If the msgid of the $po +Add the information from a C<$po> into this POT. If the msgid of the C<$po> is already known, that is an error. +Improves base, see L =item $obj-EB
( [$field, [$content]] ) The translation of a blank MSGID is used to store a MIME header, which -contains some meta-data. When only a $field is specified, that content is -looked-up (case-insensitive) and returned. When a $content is specified, +contains some meta-data. When only a C<$field> is specified, that content is +looked-up (case-insensitive) and returned. When a C<$content> is specified, the knowledge will be stored. In latter case, the header structure -may get created. When the $content is set to C, the field will +may get created. When the C<$content> is set to C, the field will be removed. +Improves base, see L =item $obj-EB() @@ -267,6 +270,7 @@ Inherited, see L objects. When the string C<$active> is given as parameter, only objects which have references are returned. +Improves base, see L =back @@ -274,28 +278,78 @@ references are returned. =over 4 +=item Error: cannot detect charset in $fn + +Cast by read() + +=item Fault: cannot read from file $fn (unknown charset): $! + +Cast by read() + +=item Fault: cannot read in $cs from file $fn: $! + +Cast by read() + +=item Fault: cannot write to file $fn with $layers: $! + +Cast by write() + +=item Fault: failed reading from file $fn: $! + +Cast by read() + +=item Error: invalid plural-form algorithm '$alg' + +Cast by setupPluralAlgorithm() + =item Error: no filename or file-handle specified for PO When a PO file is written, then a filename or file-handle must be specified explicitly, or set beforehand using the L method, or known because the write follows a L of the file. +Cast by write() + +=item Error: no filename or file-handle specified for PO -=item Error: only acceptable parameter is 'ACTIVE' +Cast by write() + +=item Error: no header defined in POT for file $fn + +Cast by header() =item Error: textdomain parameter is required +Cast by new() + +=item Error: the only acceptable parameter is 'ACTIVE', not '$p' + +Cast by translations() + +=item Error: there is no Plural-Forms field in the header, but needed + +Cast by pluralIndex() + +=item Error: translation already exists for '$msgid' with '$ctxt + +Cast by add() + +=item Error: unsupported charset $charset in $fn + +Cast by read() + =back =head1 SEE ALSO -This module is part of Log-Report-Lexicon distribution version 1.12, -built on April 18, 2025. Website: F +This module is part of Log-Report-Lexicon version 1.14, +built on September 08, 2025. Website: F =head1 LICENSE -Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. +For contributors see file ChangeLog. + +This software is copyright (c) 2007-2025 by Mark Overmeer. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. -See F +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff -pruN 1.12-1/lib/Log/Report/Lexicon/POTcompact.pm 1.14-1/lib/Log/Report/Lexicon/POTcompact.pm --- 1.12-1/lib/Log/Report/Lexicon/POTcompact.pm 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon/POTcompact.pm 2025-09-08 13:31:48.000000000 +0000 @@ -1,13 +1,20 @@ -# Copyrights 2007-2025 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.03. -# This code is part of distribution Log-Report-Lexicon. 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. +# This code is part of Perl distribution Log-Report-Lexicon version 1.14. +# The POD got stripped from this file by OODoc version 3.04. +# For contributors see file ChangeLog. + +# This software is copyright (c) 2007-2025 by Mark Overmeer. + +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later + +#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION *** +#oodist: This file contains OODoc-style documentation which will get stripped +#oodist: during its release in the distribution. You can use this file for +#oodist: testing, however the code of this development version may be broken! package Log::Report::Lexicon::POTcompact;{ -our $VERSION = '1.12'; +our $VERSION = '1.14'; } use base 'Log::Report::Lexicon::Table'; @@ -23,101 +30,101 @@ use Encode qw/find_encoding/ sub _unescape($$); sub _escape($$); +#-------------------- sub read($@) -{ my ($class, $fn, %args) = @_; +{ my ($class, $fn, %args) = @_; + my $charset = $args{charset}; - my $self = bless {}, $class; + my $self = bless +{}, $class; - my $charset = $args{charset}; - - # Try to pick-up charset from the filename (which may contain a modifier) - $charset = $1 - if !$charset && $fn =~ m!\.([\w-]+)(?:\@[^/\\]+)?\.po$!i; - - my $fh; - if($charset) - { open $fh, "<:encoding($charset):crlf", $fn - or fault __x"cannot read in {charset} from file {fn}" - , charset => $charset, fn => $fn; - } - else - { open $fh, '<:raw:crlf', $fn - or fault __x"cannot read from file {fn} (unknown charset)", fn=>$fn; - } - - # Speed! - my $msgctxt = ''; - my ($last, $msgid, @msgstr); - my $index = $self->{index} ||= {}; + # Try to pick-up charset from the filename (which may contain a modifier) + $charset = $1 + if !$charset && $fn =~ m!\.([\w-]+)(?:\@[^/\\]+)?\.po$!i; + + my $fh; + if($charset) + { open $fh, "<:encoding($charset):crlf", $fn + or fault __x"cannot read in {charset} from file {fn}", charset => $charset, fn => $fn; + } + else + { open $fh, '<:raw:crlf', $fn + or fault __x"cannot read from file {fn} (unknown charset)", fn=>$fn; + } + + # Speed! + my $msgctxt = ''; + my ($last, $msgid, @msgstr); + my $index = $self->{index} ||= {}; my $add = sub { - unless($charset) - { $msgid eq '' - or error __x"header not found for charset in {fn}", fn => $fn; - $charset = $msgstr[0] =~ m/^content-type:.*?charset=["']?([\w-]+)/mi - ? $1 : error __x"cannot detect charset in {fn}", fn => $fn; - my $enc = find_encoding($charset) - or error __x"unsupported charset {charset} in {fn}" - , charset => $charset, fn => $fn; - - trace "auto-detected charset $charset for $fn"; - binmode $fh, ":encoding($charset):crlf"; - - $_ = $enc->decode($_) for @msgstr, $msgctxt; - } - - $index->{"$msgid#$msgctxt"} = @msgstr > 1 ? [@msgstr] : $msgstr[0]; - ($msgctxt, $msgid, @msgstr) = (''); - }; - - LINE: - while(my $line = $fh->getline) - { next if substr($line, 0, 1) eq '#'; - - if($line =~ m/^\s*$/) # blank line starts new - { $add->() if @msgstr; - next LINE; - } - - if($line =~ s/^msgctxt\s+//) - { $msgctxt = _unescape $line, $fn; - $last = \$msgctxt; - } - elsif($line =~ s/^msgid\s+//) - { $msgid = _unescape $line, $fn; - $last = \$msgid; - } - elsif($line =~ s/^msgstr\[(\d+)\]\s*//) - { $last = \($msgstr[$1] = _unescape $line, $fn); - } - elsif($line =~ s/^msgstr\s+//) - { $msgstr[0] = _unescape $line, $fn; - $last = \$msgstr[0]; - } - elsif($last && $line =~ m/^\s*\"/) - { $$last .= _unescape $line, $fn; - } - } - $add->() if @msgstr; # don't forget the last - - close $fh - or failure __x"failed reading from file {fn}", fn => $fn; - - $self->{origcharset} = $charset; - $self->{filename} = $fn; - $self->setupPluralAlgorithm; - $self; + unless($charset) + { $msgid eq '' + or error __x"header not found for charset in {fn}", fn => $fn; + + $charset = $msgstr[0] =~ m/^content-type:.*?charset=["']?([\w-]+)/mi ? $1 + : error __x"cannot detect charset in {fn}", fn => $fn; + + my $enc = find_encoding($charset) + or error __x"unsupported charset {charset} in {fn}", charset => $charset, fn => $fn; + + trace "auto-detected charset $charset for $fn"; + binmode $fh, ":encoding($charset):crlf"; + + $_ = $enc->decode($_) for @msgstr, $msgctxt; + } + + $index->{"$msgid#$msgctxt"} = @msgstr > 1 ? [@msgstr] : $msgstr[0]; + ($msgctxt, $msgid, @msgstr) = (''); + }; + + LINE: + while(my $line = $fh->getline) + { next if substr($line, 0, 1) eq '#'; + + if($line =~ m/^\s*$/) # blank line starts new + { $add->() if @msgstr; + next LINE; + } + + if($line =~ s/^msgctxt\s+//) + { $msgctxt = _unescape $line, $fn; + $last = \$msgctxt; + } + elsif($line =~ s/^msgid\s+//) + { $msgid = _unescape $line, $fn; + $last = \$msgid; + } + elsif($line =~ s/^msgstr\[(\d+)\]\s*//) + { $last = \($msgstr[$1] = _unescape $line, $fn); + } + elsif($line =~ s/^msgstr\s+//) + { $msgstr[0] = _unescape $line, $fn; + $last = \$msgstr[0]; + } + elsif($last && $line =~ m/^\s*\"/) + { $$last .= _unescape $line, $fn; + } + } + $add->() if @msgstr; # don't forget the last + + close $fh + or failure __x"failed reading from file {fn}", fn => $fn; + + $self->{origcharset} = $charset; + $self->{filename} = $fn; + $self->setupPluralAlgorithm; + $self; } -#------------------ +#-------------------- -sub filename() {shift->{filename}} -sub originalCharset() {shift->{origcharset}} +sub filename() { $_[0]->{filename} } +sub originalCharset() { $_[0]->{origcharset} } -#------------------ +#-------------------- -sub index() {shift->{index}} +sub index() { $_[0]->{index} } # The index is a HASH with "$msg#$msgctxt" keys. If there is no # $msgctxt, then there still is the # @@ -125,18 +132,19 @@ sub index() {shift->{index}} sub msgid($) { $_[0]->{index}{$_[1].'#'.($_[2]//'')} } + # speed!!! sub msgstr($;$$) -{ my ($self, $msgid, $count, $ctxt) = @_; +{ my ($self, $msgid, $count, $ctxt) = @_; - $ctxt //= ''; - my $po = $self->{index}{"$msgid#$ctxt"} - or return undef; + $ctxt //= ''; + my $po = $self->{index}{"$msgid#$ctxt"} + or return undef; - ref $po # no plurals defined - or return $po; + ref $po # no plurals defined + or return $po; - $po->[$self->{algo}->($count // 1)] || $po->[$self->{algo}->(1)]; + $po->[$self->{algo}->($count // 1)] || $po->[$self->{algo}->(1)]; } # @@ -144,20 +152,19 @@ sub msgstr($;$$) # sub _unescape($$) -{ unless( $_[0] =~ m/^\s*\"(.*)\"\s*$/ ) - { warning __x"string '{text}' not between quotes at {location}" - , text => $_[0], location => $_[1]; - return $_[0]; - } - unescape_chars $1; +{ unless( $_[0] =~ m/^\s*\"(.*)\"\s*$/ ) + { warning __x"string '{text}' not between quotes at {location}", text => $_[0], location => $_[1]; + return $_[0]; + } + unescape_chars $1; } sub _escape($$) -{ my @escaped = map { '"' . escape_chars($_) . '"' } - defined $_[0] && length $_[0] ? split(/(?<=\n)/, $_[0]) : ''; +{ my @escaped = map { '"' . escape_chars($_) . '"' } + defined $_[0] && length $_[0] ? split(/(?<=\n)/, $_[0]) : ''; - unshift @escaped, '""' if @escaped > 1; - join $_[1], @escaped; + unshift @escaped, '""' if @escaped > 1; + join $_[1], @escaped; } 1; diff -pruN 1.12-1/lib/Log/Report/Lexicon/POTcompact.pod 1.14-1/lib/Log/Report/Lexicon/POTcompact.pod --- 1.12-1/lib/Log/Report/Lexicon/POTcompact.pod 2025-04-18 15:10:21.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon/POTcompact.pod 2025-09-08 13:31:48.000000000 +0000 @@ -11,12 +11,12 @@ Log::Report::Lexicon::POTcompact - use t =head1 SYNOPSIS - # using a PO table efficiently - my $pot = Log::Report::Lexicon::POTcompact->read('po/nl.po') - or die; + # using a PO table efficiently + my $pot = Log::Report::Lexicon::POTcompact->read('po/nl.po') + or die; - my $header = $pot->msgid(''); - print $pot->msgstr('msgid', 3); + my $header = $pot->msgid(''); + print $pot->msgstr('msgid', 3); =head1 DESCRIPTION @@ -32,24 +32,24 @@ If you like to change the content of PO L. Extends L<"DESCRIPTION" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"DESCRIPTION">. - + =head1 METHODS Extends L<"METHODS" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"METHODS">. - + =head2 Constructors Extends L<"Constructors" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Constructors">. - + =over 4 -=item Log::Report::Lexicon::POTcompact-EB(%options) +=item $class-EB(%options) Inherited, see L -=item Log::Report::Lexicon::POTcompact-EB($filename, %options) +=item $class-EB($filename, %options) -Read the POT table information from $filename, as compact as possible. +Read the POT table information from C<$filename>, as compact as possible. Comments, plural-form, and such are lost on purpose: they are not needed for translations. @@ -70,7 +70,7 @@ field in the po-file header. =head2 Attributes Extends L<"Attributes" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Attributes">. - + =over 4 =item $obj-EB() @@ -87,30 +87,32 @@ get translated into utf8 before being us =head2 Managing PO's Extends L<"Managing PO's" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Managing PO's">. - + =head3 Translation Extends L<"Translation" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Translation">. - + =over 4 =item $obj-EB( STRING, [$msgctxt] ) -Lookup the translations with the STRING. Returns a SCALAR, when only +Lookup the translations with the C. Returns a SCALAR, when only one translation is known, and an ARRAY wherein there are multiple. Returns C when the translation is not defined. +Improves base, see L =item $obj-EB( $msgid, [$count, [$msgctxt] ) -Returns the translated string for $msgid. When not specified, $count is 1 +Returns the translated string for C<$msgid>. When not specified, C<$count> is 1 (the single form). +Improves base, see L =back =head3 Administration Extends L<"Administration" in Log::Report::Lexicon::Table|Log::Report::Lexicon::Table/"Administration">. - + =over 4 =item $obj-EB($po) @@ -143,20 +145,55 @@ Inherited, see L +This module is part of Log-Report-Lexicon version 1.14, +built on September 08, 2025. Website: F =head1 LICENSE -Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. +For contributors see file ChangeLog. + +This software is copyright (c) 2007-2025 by Mark Overmeer. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. -See F +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff -pruN 1.12-1/lib/Log/Report/Lexicon/Table.pm 1.14-1/lib/Log/Report/Lexicon/Table.pm --- 1.12-1/lib/Log/Report/Lexicon/Table.pm 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon/Table.pm 2025-09-08 13:31:48.000000000 +0000 @@ -1,13 +1,20 @@ -# Copyrights 2007-2025 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.03. -# This code is part of distribution Log-Report-Lexicon. 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. +# This code is part of Perl distribution Log-Report-Lexicon version 1.14. +# The POD got stripped from this file by OODoc version 3.04. +# For contributors see file ChangeLog. + +# This software is copyright (c) 2007-2025 by Mark Overmeer. + +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later + +#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION *** +#oodist: This file contains OODoc-style documentation which will get stripped +#oodist: during its release in the distribution. You can use this file for +#oodist: testing, however the code of this development version may be broken! package Log::Report::Lexicon::Table;{ -our $VERSION = '1.12'; +our $VERSION = '1.14'; } @@ -16,22 +23,19 @@ use strict; use Log::Report 'log-report-lexicon'; -use POSIX qw/strftime/; -use IO::File (); -use List::Util qw/sum/; - +#-------------------- sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) } -sub init($) {shift} +sub init($) { $_[0] } -#----------------------- +#-------------------- -#----------------------- +#-------------------- sub msgid($;$) {panic "not implemented"} sub msgstr($;$$) {panic "not implemented"} -#------------------ +#-------------------- sub add($) {panic "not implemented"} @@ -40,36 +44,36 @@ sub translations(;$) {panic "not impleme sub pluralIndex($) -{ my ($self, $count) = @_; - my $algo = $self->{algo} - or error __x"there is no Plural-Forms field in the header, but needed"; +{ my ($self, $count) = @_; + my $algo = $self->{algo} + or error __x"there is no Plural-Forms field in the header, but needed"; - $algo->($count); + $algo->($count); } sub setupPluralAlgorithm() -{ my $self = shift; - my $forms = $self->header('Plural-Forms') or return; +{ my $self = shift; + my $forms = $self->header('Plural-Forms') or return; - my $alg = $forms =~ m/plural\=([n%!=><\s\d|&?:()]+)/ ? $1 : "n!=1"; - $alg =~ s/\bn\b/(\$_[0])/g; - my $code = eval "sub(\$) {$alg}"; - $@ and error __x"invalid plural-form algorithm '{alg}'", alg => $alg; - $self->{algo} = $code; + my $alg = $forms =~ m/plural\=([n%!=><\s\d|&?:()]+)/ ? $1 : "n!=1"; + $alg =~ s/\bn\b/(\$_[0])/g; + my $code = eval "sub(\$) {$alg}"; + $@ and error __x"invalid plural-form algorithm '{alg}'", alg => $alg; + $self->{algo} = $code; - $self->{nplurals} = $forms =~ m/\bnplurals\=(\d+)/ ? $1 : 2; - $self; + $self->{nplurals} = $forms =~ m/\bnplurals\=(\d+)/ ? $1 : 2; + $self; } -sub nrPlurals() {shift->{nplurals}} +sub nrPlurals() { $_[0]->{nplurals} } sub header($@) -{ my ($self, $field) = @_; - my $header = $self->msgid('') or return; - $header =~ m/^\Q$field\E\:\s*([^\n]*?)\;?\s*$/im ? $1 : undef; +{ my ($self, $field) = @_; + my $header = $self->msgid('') or return; + $header =~ m/^\Q$field\E\:\s*([^\n]*?)\;?\s*$/im ? $1 : undef; } 1; diff -pruN 1.12-1/lib/Log/Report/Lexicon/Table.pod 1.14-1/lib/Log/Report/Lexicon/Table.pod --- 1.12-1/lib/Log/Report/Lexicon/Table.pod 2025-04-18 15:10:21.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon/Table.pod 2025-09-08 13:31:48.000000000 +0000 @@ -14,8 +14,7 @@ Log::Report::Lexicon::Table - generic in =head1 SYNOPSIS # use one of the extensions, for instance: - my $pot = Log::Report::Lexicon::POT - ->read('po/nl.po', charset => 'utf-8') + my $pot = Log::Report::Lexicon::POT->read('po/nl.po', charset => 'utf-8') or panic; =head1 DESCRIPTION @@ -49,7 +48,9 @@ super efficient. =over 4 -=item Log::Report::Lexicon::Table-EB(%options) +=item $class-EB(%options) + +Z<> =back @@ -63,12 +64,12 @@ super efficient. =item $obj-EB( STRING, [$msgctxt] ) -Lookup the L with the STRING. +Lookup the L with the C. Returns C when not defined. =item $obj-EB( $msgid, [$count, $msgctxt] ) -Returns the translated string for $msgid. When not specified, $count is 1. +Returns the translated string for C<$msgid>. When not specified, C<$count> is 1. =back @@ -78,13 +79,13 @@ Returns the translated string for $msgid =item $obj-EB($po) -Add the information from a $po into this POT. If the msgid of the $po +Add the information from a C<$po> into this POT. If the msgid of the C<$po> is already known, that is an error. =item $obj-EB
($field) The translation of a blank MSGID is used to store a MIME header, which -contains some meta-data. The $field value is looked-up (case-insensitive) +contains some meta-data. The C<$field> value is looked-up (case-insensitive) and returned. =item $obj-EB() @@ -93,7 +94,7 @@ Returns the number of plurals, when not =item $obj-EB($count) -Returns the msgstr index used to translate a value of $count. +Returns the msgstr index used to translate a value of C<$count>. =item $obj-EB() @@ -103,7 +104,7 @@ C header field. [1.09] Th when not used. A full list of plural forms per language can be found at -F +L =item $obj-EB( [$active] ) @@ -117,20 +118,31 @@ references are returned. =over 4 +=item Error: invalid plural-form algorithm '$alg' + +Cast by setupPluralAlgorithm() + =item Error: only acceptable parameter is 'ACTIVE' +Cast by translations() + +=item Error: there is no Plural-Forms field in the header, but needed + +Cast by pluralIndex() + =back =head1 SEE ALSO -This module is part of Log-Report-Lexicon distribution version 1.12, -built on April 18, 2025. Website: F +This module is part of Log-Report-Lexicon version 1.14, +built on September 08, 2025. Website: F =head1 LICENSE -Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. +For contributors see file ChangeLog. + +This software is copyright (c) 2007-2025 by Mark Overmeer. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. -See F +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff -pruN 1.12-1/lib/Log/Report/Lexicon.pm 1.14-1/lib/Log/Report/Lexicon.pm --- 1.12-1/lib/Log/Report/Lexicon.pm 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon.pm 2025-09-08 13:31:48.000000000 +0000 @@ -1,13 +1,20 @@ -# Copyrights 2007-2025 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.03. -# This code is part of distribution Log-Report-Lexicon. 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. +# This code is part of Perl distribution Log-Report-Lexicon version 1.14. +# The POD got stripped from this file by OODoc version 3.04. +# For contributors see file ChangeLog. + +# This software is copyright (c) 2007-2025 by Mark Overmeer. + +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later + +#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION *** +#oodist: This file contains OODoc-style documentation which will get stripped +#oodist: during its release in the distribution. You can use this file for +#oodist: testing, however the code of this development version may be broken! package Log::Report::Lexicon;{ -our $VERSION = '1.12'; +our $VERSION = '1.14'; } @@ -16,16 +23,15 @@ use strict; use Log::Report 'log-report-lexicon'; +#-------------------- sub new(@) -{ my $class = shift; - (bless {}, $class)->init( {@_} ); +{ my $class = shift; + (bless {}, $class)->init( +{ @_ } ); } sub init($) { shift } # $self, $args -#-------------- - -#-------------- +#-------------------- 1; diff -pruN 1.12-1/lib/Log/Report/Lexicon.pod 1.14-1/lib/Log/Report/Lexicon.pod --- 1.12-1/lib/Log/Report/Lexicon.pod 2025-04-18 15:10:21.000000000 +0000 +++ 1.14-1/lib/Log/Report/Lexicon.pod 2025-09-08 13:31:48.000000000 +0000 @@ -10,15 +10,15 @@ Log::Report::Lexicon - translation compo This module is the main extry point for the distribution, but has currently no further use. This distribution contains all components -of L which handle translations. +of Log::Report which handle translations. If you do not need translations, you do not need to install this module. -When you use L and need to add translations, it may be +When you use Log::Report and need to add translations, it may be very little work: when you nicely wrote texts in the advised message format like - print __x"Greetings to you, {name}", name => $name; - fault __x"cannot open file {filename}", filename => $fn; + print __x"Greetings to you, {name}", name => $name; + fault __x"cannot open file {filename}", filename => $fn; then all is in perfect condition to introduce translations: it requires very little to no additions to the existing code! @@ -41,7 +41,7 @@ Translation table administration, in PO Translation table file file administration, understanding locales, domains, and attributes in the filenames. -=item * L +=item * Log::Report::Translator The run-time component of translations. @@ -53,7 +53,9 @@ The run-time component of translations. =over 4 -=item Log::Report::Lexicon-EB(%options) +=item $class-EB(%options) + +Z<> =back @@ -61,14 +63,15 @@ The run-time component of translations. =head1 SEE ALSO -This module is part of Log-Report-Lexicon distribution version 1.12, -built on April 18, 2025. Website: F +This module is part of Log-Report-Lexicon version 1.14, +built on September 08, 2025. Website: F =head1 LICENSE -Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. +For contributors see file ChangeLog. + +This software is copyright (c) 2007-2025 by Mark Overmeer. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. -See F +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff -pruN 1.12-1/lib/Log/Report/Translator/Context.pm 1.14-1/lib/Log/Report/Translator/Context.pm --- 1.12-1/lib/Log/Report/Translator/Context.pm 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/lib/Log/Report/Translator/Context.pm 2025-09-08 13:31:48.000000000 +0000 @@ -1,13 +1,20 @@ -# Copyrights 2007-2025 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.03. -# This code is part of distribution Log-Report-Lexicon. 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. +# This code is part of Perl distribution Log-Report-Lexicon version 1.14. +# The POD got stripped from this file by OODoc version 3.04. +# For contributors see file ChangeLog. + +# This software is copyright (c) 2007-2025 by Mark Overmeer. + +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later + +#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION *** +#oodist: This file contains OODoc-style documentation which will get stripped +#oodist: during its release in the distribution. You can use this file for +#oodist: testing, however the code of this development version may be broken! package Log::Report::Translator::Context;{ -our $VERSION = '1.12'; +our $VERSION = '1.14'; } @@ -16,140 +23,140 @@ use strict; use Log::Report 'log-report-lexicon'; +#-------------------- sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) } sub init($) -{ my ($self, $args) = @_; - $self->{LRTC_rules} = $self->_context_table($args->{rules} || {}); - $self; +{ my ($self, $args) = @_; + $self->{LRTC_rules} = $self->_context_table($args->{rules} || {}); + $self; } -#------- +#-------------------- -sub rules() {shift->{LRTC_rules}} +sub rules() { $_[0]->{LRTC_rules} } + +#-------------------- -#------- sub _strip_ctxt_spec($) -{ my $msgid = shift; - my @tags; - while($msgid =~ s/\{ ([^<}]*) \<(\w+) ([^}]*) \}/ - length "$1$3" ? "{$1$3}" : ''/xe) - { push @tags, $2; - } - ($msgid, [sort @tags]); +{ my $msgid = shift; + my @tags; + while($msgid =~ s/\{ ([^<}]*) \<(\w+) ([^}]*) \}/ length "$1$3" ? "{$1$3}" : ''/xe) + { push @tags, $2; + } + ($msgid, [sort @tags]); } sub ctxtFor($$;$) -{ my ($self, $msg, $lang, $def_context) = @_; - my $rawid = $msg->msgid; - my ($msgid, $tags) = _strip_ctxt_spec $rawid; - @$tags or return ($msgid, undef); +{ my ($self, $msg, $lang, $def_context) = @_; + my $rawid = $msg->msgid; + my ($msgid, $tags) = _strip_ctxt_spec $rawid; + @$tags or return ($msgid, undef); - my $maps = $self->rules; - $lang =~ s/_.*//; + my $maps = $self->rules; + $lang =~ s/_.*//; - my $msg_context = $self->needDecode($rawid, $msg->context || {}); - $def_context ||= {}; + my $msg_context = $self->needDecode($rawid, $msg->context || {}); + $def_context ||= {}; #use Data::Dumper; #warn "context = ", Dumper $msg, $msg_context, $def_context; - my @c; - foreach my $tag (@$tags) - { my $map = $maps->{$tag} - or error __x"no context definition for `{tag}' in `{msgid}'" - , tag => $tag, msgid => $rawid; - - my $set = $map->{$lang} || $map->{default}; - next if $set eq 'IGNORE'; - - my $v = $msg_context->{$tag} || $def_context->{$tag}; - unless($v) - { warning __x"no value for tag `{tag}' in the context", tag => $tag; - ($v) = keys %$set; - } - unless($set->{$v}) - { warning __x"unknown alternative `{alt}' for tag `{tag}' in context of `{msgid}'" - , alt => $v, tag => $tag, msgid => $rawid; - ($v) = keys %$set; - } + my @c; + foreach my $tag (@$tags) + { my $map = $maps->{$tag} + or error __x"no context definition for `{tag}' in `{msgid}'", tag => $tag, msgid => $rawid; + + my $set = $map->{$lang} || $map->{default}; + next if $set eq 'IGNORE'; + + my $v = $msg_context->{$tag} || $def_context->{$tag}; + unless($v) + { warning __x"no value for tag `{tag}' in the context", tag => $tag; + ($v) = keys %$set; + } + unless($set->{$v}) + { warning __x"unknown alternative `{alt}' for tag `{tag}' in context of `{msgid}'", alt => $v, tag => $tag, msgid => $rawid; + ($v) = keys %$set; + } - push @c, "$tag=$set->{$v}"; - } + push @c, "$tag=$set->{$v}"; + } - my $msgctxt = join ' ', sort @c; - ($msgid, $msgctxt); + my $msgctxt = join ' ', sort @c; + ($msgid, $msgctxt); } + sub needDecode($@) -{ my ($thing, $source) = (shift, shift); - return +{@_} if @_ > 1; - my $c = shift; - return $c if !defined $c || ref $c eq 'HASH'; - - my %c; - foreach (ref $c eq 'ARRAY' ? @$c : (split /[\s,]+/, $c)) - { my ($kw, $val) = split /\=/, $_, 2; - defined $val - or error __x"tags value must have form `a=b', found `{this}' in `{source}'" - , this => $_, source => $source; - $c{$kw} = $val; - } - \%c; +{ my ($thing, $source) = (shift, shift); + return +{@_} if @_ > 1; + my $c = shift; + return $c if !defined $c || ref $c eq 'HASH'; + + my %c; + foreach (ref $c eq 'ARRAY' ? @$c : (split /[\s,]+/, $c)) + { my ($kw, $val) = split /\=/, $_, 2; + defined $val + or error __x"tags value must have form `a=b', found `{this}' in `{source}'", this => $_, source => $source; + $c{$kw} = $val; + } + \%c; } sub expand($$@) -{ my ($self, $raw, $lang) = @_; - my ($msgid, $tags) = _strip_ctxt_spec $raw; +{ my ($self, $raw, $lang) = @_; + my ($msgid, $tags) = _strip_ctxt_spec $raw; + + $lang =~ s/_.*//; + + my $maps = $self->rules; + my @options = []; - $lang =~ s/_.*//; + foreach my $tag (@$tags) + { my $map = $maps->{$tag} + or error __x"unknown context tag '{tag}' used in '{msgid}'", tag => $tag, msgid => $msgid; + my $set = $map->{$lang} || $map->{default}; - my $maps = $self->rules; - my @options = []; + my %uniq = map +("$tag=$_" => 1), values %$set; + my @oldopt = @options; + @options = (); - foreach my $tag (@$tags) - { my $map = $maps->{$tag} - or error __x"unknown context tag '{tag}' used in '{msgid}'" - , tag => $tag, msgid => $msgid; - my $set = $map->{$lang} || $map->{default}; - - my %uniq = map +("$tag=$_" => 1), values %$set; - my @oldopt = @options; - @options = (); - - foreach my $alt (keys %uniq) - { push @options, map +[ @$_, $alt ], @oldopt; - } - } + foreach my $alt (keys %uniq) + { push @options, map +[ @$_, $alt ], @oldopt; + } + } - ($msgid, [sort map join(' ', @$_), @options]); + ($msgid, [sort map join(' ', @$_), @options]); } sub _context_table($) -{ my ($self, $rules) = @_; - my %rules; - foreach my $tag (keys %$rules) - { my $d = $rules->{$tag}; - $d = +{ alternatives => $d } if ref $d eq 'ARRAY'; - my %simple; - my $default = $d->{default} || {}; # default map - if(my $alt = $d->{alternatives}) # simpelest map - { $default = +{ map +($_ => $_), @$alt }; - } - $simple{default} = $default; - foreach my $set (keys %$d) - { next if $set eq 'default' || $set eq 'alternatives'; - my %set = (%$default, %{$d->{$set}}); - $simple{$_} = \%set for split /\,/, $set; # table per lang - } - $rules{$tag} = \%simple; - } +{ my ($self, $rules) = @_; + my %rules; + foreach my $tag (keys %$rules) + { my $d = $rules->{$tag}; + $d = +{ alternatives => $d } if ref $d eq 'ARRAY'; + + my %simple; + my $default = $d->{default} || {}; # default map + if(my $alt = $d->{alternatives}) # simpelest map + { $default = +{ map +($_ => $_), @$alt }; + } + + $simple{default} = $default; + foreach my $set (keys %$d) + { next if $set eq 'default' || $set eq 'alternatives'; + my %set = (%$default, %{$d->{$set}}); + $simple{$_} = \%set for split /\,/, $set; # table per lang + } + $rules{$tag} = \%simple; + } - \%rules; + \%rules; } -#------------ +#-------------------- 1; diff -pruN 1.12-1/lib/Log/Report/Translator/Context.pod 1.14-1/lib/Log/Report/Translator/Context.pod --- 1.12-1/lib/Log/Report/Translator/Context.pod 2025-04-18 15:10:21.000000000 +0000 +++ 1.14-1/lib/Log/Report/Translator/Context.pod 2025-09-08 13:31:48.000000000 +0000 @@ -7,8 +7,8 @@ Log::Report::Translator::Context - handl =head1 SYNOPSIS # usually, the context information is in a separate file - textdomain 'my-domain' - , config => $filename; + textdomain 'my-domain', + config => $filename; =head1 DESCRIPTION @@ -22,23 +22,23 @@ For instance, two libraries used in the componentent within a single library both want to used the same default text (which usually is very short) - char * t1 = pgettext('interface', 'None'); - char * t2 = pgettext('selections', 'None'); + char * t1 = pgettext('interface', 'None'); + char * t2 = pgettext('selections', 'None'); Some translation setups use the library name consequently as msgctxt. But, the name "context" is pretending much more power than the gettext libraries are capable of: it usually only behaves like a namespace. -For L, the power of "context" is extended with selecting +For Log::Report, the power of "context" is extended with selecting between alternatives for the use of a msgid B. For instance, the gender of the user of the website determines whether `he' or `she' needs to be used in the translation. In this example, the gender is set as context keyword in the message: - my ($name, $sex) = ('Jack', 'male'); - print __x"{name $name - , _context => "gender=$sex"; + my ($name, $sex) = ('Jack', 'male'); + print __x"{name $name, + _context => "gender=$sex"; =head1 METHODS @@ -46,7 +46,9 @@ the gender is set as context keyword in =over 4 -=item Log::Report::Translator::Context-EB(%options) +=item $class-EB(%options) + +Z<> -Option--Default rules {} @@ -76,8 +78,8 @@ Returns a HASH to the simplified context =item $obj-EB( $message, $lang, [$context] ) Returns a pair of the MSGID stripped from context markup, and the -context evaluated into the msgctxt string. The $message is a -L object. The $context is the default context +context evaluated into the msgctxt string. The C<$message> is a +Log::Report::Message object. The C<$context> is the default context for a certain textdomain. my ($msgid, $msgctxt) = $context->ctxtFor($msg, $lang, $context); @@ -85,14 +87,12 @@ for a certain textdomain. =item $obj-EB($msgid, $language, %options) Expand the context settings into all possible combinations which need -translations in the PO file. This may depend on the $language. -The $msgid is used in error messages. - -=item $obj-EB($source, STRING|ARRAY|HASH|PAIRS) +translations in the PO file. This may depend on the C<$language>. +The C<$msgid> is used in error messages. -=item Log::Report::Translator::Context-EB($source, STRING|ARRAY|HASH|PAIRS) +=item $any-EB($source, STRING|ARRAY|HASH|PAIRS) -Converts the context settings passed with the MSGID, into a HASH which will +Converts the context settings passed with the MSGID, into a C which will be matched to the context providers. =back @@ -108,8 +108,8 @@ For instance, two libraries used in the componentent within a single library both want to used the same default text (which usually is very short) - char * t1 = pgettext('interface', 'None'); - char * t2 = pgettext('selections', 'None'); + char * t1 = pgettext('interface', 'None'); + char * t2 = pgettext('selections', 'None'); Some translation setups use the library name consequently as msgctxt. But, the name "context" is pretending much more power than the gettext @@ -117,28 +117,28 @@ libraries are capable of: it usually onl =head2 Contexts in Log::Report -For L, the power of "context" is extended with selecting +For Log::Report, the power of "context" is extended with selecting between alternatives for the use of a msgid B. For instance, the gender of the user of the website determines whether `he' or `she' needs to be used in the translation. In this example, the gender is set as context keyword in the message: - my ($name, $sex) = ('Jack', 'male'); - print __x"{name $name - , _context => "gender=$sex"; + my ($name, $sex) = ('Jack', 'male'); + print __x"{name $name, + _context => "gender=$sex"; This would also be possible in traditional gettext, although probably rarely used. A complication is that the scripts to maintain the po tables are not too smart; do not understand complex code constructs. Probably this would beed needed: - if(sex==MALE) - { printf pgettext('male', "%s found his key\n", name); - } - else - { printf pgettext('female', "%s found her key\n", name); - } + if(sex==MALE) + { printf pgettext('male', "%s found his key\n", name); + } + else + { printf pgettext('female', "%s found her key\n", name); + } =head2 Using context_rules @@ -171,14 +171,14 @@ For instance, the gender of the user of `he' or `she' needs to be used. In this example, the gender is set as context keyword in the message: - $name = 'Jack'; - print __x"{name} found her key", name => $name; + $name = 'Jack'; + print __x"{name} found her key", name => $name; You may try to solve this via: - my ($name, $gender) = ('Jack', 'male'); - print __x"{name} found {personal} key", name => $name - , personal => ($gender eq 'male' ? 'his' : 'her'); # No! + my ($name, $gender) = ('Jack', 'male'); + print __x"{name} found {personal} key", name => $name, + personal => ($gender eq 'male' ? 'his' : 'her'); # No! This does not translate! For one, you would need to translate C and C to the language as well. But in some languages, the differences @@ -186,24 +186,24 @@ between addressed genders have more impa So, Log::Report translations add extra syntax: - my ($name, $gender) = ('Jack', 'male'); - print __x"{name $name - , _context => "gender=$gender"; + my ($name, $gender) = ('Jack', 'male'); + print __x"{name $name, + _context => "gender=$gender"; The C marking tells the translation table builder (xgettext-perl) and the translation handler that there is a context active. Now, the English PO-file has - # gender alternatives 'male' and 'female' + # gender alternatives 'male' and 'female' - msgctxt "gender=male" - msgid "{name} found his key" - msgstr "{name} found his key" - - msgctxt "gender=female" - msgid "{name} found his key" - msgstr "{name} found her key" + msgctxt "gender=male" + msgid "{name} found his key" + msgstr "{name} found his key" + + msgctxt "gender=female" + msgid "{name} found his key" + msgstr "{name} found her key" To make this work, both the application and the C script must share information to understand which genders are available. See @@ -211,16 +211,16 @@ the section on "Configuration" below. Another example: - print __x"greetings{ \@context; -Probably the +Probably the my %context = (gender => 'male', agegroup => 'adult', married => 'yes'); my %context = qw/gender male agegroup adult married yes/; _context => \%context; -Standard gettext only allows a single keyword (=string) +Standard gettext only allows a single keyword (=string) C permits you to set-up a context for a whole text-domain, which means that multiple context rules may be active at any moment. @@ -259,17 +259,17 @@ the log messages may need to show that d collect (or pass on) the hostname when throwing the error... something like this: - # can I access $vhost easily? - error __x"For {host}, login failed for {user}" - , host => $vhost->name, user => $user; + # can I access $vhost easily? + error __x"For {host}, login failed for {user}", + host => $vhost->name, user => $user; Via contexts: - # when you know the vhost: (max once per request) - textdomain->setContext(host => $vhost->name); # or updateContext + # when you know the vhost: (max once per request) + textdomain->setContext(host => $vhost->name); # or updateContext - # until you reconfigure the context - error __x"For {_context.host}, login failed for {user}", user => $user; + # until you reconfigure the context + error __x"For {_context.host}, login failed for {user}", user => $user; The context values are always available for interpolation. @@ -297,14 +297,14 @@ chosen. In the simplest form, the msgctxt field contains a single keyword (not containing a comma). - msgctxt "gender=male" + msgctxt "gender=male" But you can do more. B that most (all?) existing tools which smartly edit PO-files do not understand these constructs: they see the msgctxt as dump string without meaning. - msgctxt "agegroup=baby,agegroup=grandparent" # baby OR grandparent - msgctxt "gender=male agegroup=adult" # both male AND adult + msgctxt "agegroup=baby,agegroup=grandparent" # baby OR grandparent + msgctxt "gender=male agegroup=adult" # both male AND adult So, a comma separated list of alternatives. If any matches, then the rule is selected. @@ -322,12 +322,12 @@ Therefore, we need a map-file. The context maps are included in a configuration file which is passed to xgettext-perl and to the program which uses contexts. -See L. +See Log::Report::Domain subroutine readConfig. Example of such configuration file: (JSON syntax and Perl syntax) - === JSON === ==== Perl === - { { + === JSON === ==== Perl == = + {{ "context_rules" : { context_rules => { "gender" : [ gender => [ "male", 'male', @@ -389,19 +389,46 @@ the third gender. If you are not interested for a certain tag, then put it on 'IGNORE' as default or for your language. - "default" : "IGNORE", default => 'IGNORE' - "nl": "IGNORE" nl => 'IGNORE' + "default" : "IGNORE", default => 'IGNORE' + "nl": "IGNORE" nl => 'IGNORE' + +=head1 DIAGNOSTICS + +=over 4 + +=item Error: no context definition for `$tag' in `$msgid' + +Cast by ctxtFor() + +=item Warning: no value for tag `$tag' in the context + +Cast by ctxtFor() + +=item Error: tags value must have form `a=b', found `$this' in `$source' + +Cast by needDecode() + +=item Warning: unknown alternative `$alt' for tag `$tag' in context of `$msgid' + +Cast by ctxtFor() + +=item Error: unknown context tag '$tag' used in '$msgid' + +Cast by expand() + +=back =head1 SEE ALSO -This module is part of Log-Report-Lexicon distribution version 1.12, -built on April 18, 2025. Website: F +This module is part of Log-Report-Lexicon version 1.14, +built on September 08, 2025. Website: F =head1 LICENSE -Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. +For contributors see file ChangeLog. + +This software is copyright (c) 2007-2025 by Mark Overmeer. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. -See F +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff -pruN 1.12-1/lib/Log/Report/Translator/Gettext.pm 1.14-1/lib/Log/Report/Translator/Gettext.pm --- 1.12-1/lib/Log/Report/Translator/Gettext.pm 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/lib/Log/Report/Translator/Gettext.pm 2025-09-08 13:31:48.000000000 +0000 @@ -1,13 +1,20 @@ -# Copyrights 2007-2025 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.03. -# This code is part of distribution Log-Report-Lexicon. 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. +# This code is part of Perl distribution Log-Report-Lexicon version 1.14. +# The POD got stripped from this file by OODoc version 3.04. +# For contributors see file ChangeLog. + +# This software is copyright (c) 2007-2025 by Mark Overmeer. + +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later + +#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION *** +#oodist: This file contains OODoc-style documentation which will get stripped +#oodist: during its release in the distribution. You can use this file for +#oodist: testing, however the code of this development version may be broken! package Log::Report::Translator::Gettext;{ -our $VERSION = '1.12'; +our $VERSION = '1.14'; } use base 'Log::Report::Translator'; @@ -19,26 +26,26 @@ use Log::Report 'log-report-lexicon'; use Locale::gettext; +#-------------------- sub translate($;$$) -{ my ($msg, $lang, $ctxt) = @_; +{ my ($msg, $lang, $ctxt) = @_; #XXX MO: how to use $lang when specified? - my $domain = $msg->{_textdomain}; - load_domain $domain; + my $domain = $msg->{_textdomain}; + load_domain $domain; - my $count = $msg->{_count}; + my $count = $msg->{_count}; - defined $count - ? ( defined $msg->{_category} - ? dcngettext($domain, $msg->{_msgid}, $msg->{_plural}, $count - , $msg->{_category}) - : dngettext($domain, $msg->{_msgid}, $msg->{_plural}, $count) - ) - : ( defined $msg->{_category} - ? dcgettext($domain, $msg->{_msgid}, $msg->{_category}) - : dgettext($domain, $msg->{_msgid}) - ); + defined $count + ? ( defined $msg->{_category} + ? dcngettext($domain, $msg->{_msgid}, $msg->{_plural}, $count, $msg->{_category}) + : dngettext($domain, $msg->{_msgid}, $msg->{_plural}, $count) + ) + : ( defined $msg->{_category} + ? dcgettext($domain, $msg->{_msgid}, $msg->{_category}) + : dgettext($domain, $msg->{_msgid}) + ); } 1; diff -pruN 1.12-1/lib/Log/Report/Translator/Gettext.pod 1.14-1/lib/Log/Report/Translator/Gettext.pod --- 1.12-1/lib/Log/Report/Translator/Gettext.pod 2025-04-18 15:10:21.000000000 +0000 +++ 1.14-1/lib/Log/Report/Translator/Gettext.pod 2025-09-08 13:31:48.000000000 +0000 @@ -11,22 +11,22 @@ Log::Report::Translator::Gettext - the G =head1 SYNOPSIS - # normal use (end-users view) + # normal use (end-users view) - textdomain 'my-domain' - , translator => Log::Report::Translator::Gettext->new; + textdomain 'my-domain', + translator => Log::Report::Translator::Gettext->new; - print __"Hello World\n"; # language determined by environment + print __"Hello World\n"; # language determined by environment - # internal use + # internal use - my $msg = Log::Report::Message->new - ( _msgid => "Hello World\n" - , _textdomain => 'my-domain' - ); + my $msg = Log::Report::Message->new( + _msgid => "Hello World\n", + _textdomain => 'my-domain', + ); - print Log::Report::Translator::Gettext->new - ->translate($msg, 'nl-BE'); + print Log::Report::Translator::Gettext->new + ->translate($msg, 'nl-BE'); =head1 DESCRIPTION @@ -42,22 +42,29 @@ handling functions ngettext(), dngettext later you will probably also need bind_textdomain_codeset() which is also only available on certain systems. -Extends L<"DESCRIPTION" in Log::Report::Translator|Log::Report::Translator/"DESCRIPTION">. - =head1 METHODS -Extends L<"METHODS" in Log::Report::Translator|Log::Report::Translator/"METHODS">. - +=head2 Translating + +=over 4 + +=item $obj-EB($msg, $lang, $ctxt) + +Z<> + +=back + =head1 SEE ALSO -This module is part of Log-Report-Lexicon distribution version 1.12, -built on April 18, 2025. Website: F +This module is part of Log-Report-Lexicon version 1.14, +built on September 08, 2025. Website: F =head1 LICENSE -Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. +For contributors see file ChangeLog. + +This software is copyright (c) 2007-2025 by Mark Overmeer. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. -See F +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff -pruN 1.12-1/lib/Log/Report/Translator/POT.pm 1.14-1/lib/Log/Report/Translator/POT.pm --- 1.12-1/lib/Log/Report/Translator/POT.pm 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/lib/Log/Report/Translator/POT.pm 2025-09-08 13:31:48.000000000 +0000 @@ -1,13 +1,25 @@ -# Copyrights 2007-2025 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.03. +# This code is part of Perl distribution Log-Report-Lexicon version 1.14. +# The POD got stripped from this file by OODoc version 3.04. +# For contributors see file ChangeLog. + +# This software is copyright (c) 2007-2025 by Mark Overmeer. + +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later + +#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION *** +#oodist: This file contains OODoc-style documentation which will get stripped +#oodist: during its release in the distribution. You can use this file for +#oodist: testing, however the code of this development version may be broken! +#oorestyle: old style disclaimer to be removed. + # This code is part of distribution Log-Report-Lexicon. Meta-POD processed # with OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Log::Report::Translator::POT;{ -our $VERSION = '1.12'; +our $VERSION = '1.14'; } use base 'Log::Report::Translator'; @@ -33,6 +45,8 @@ sub _fn_to_lexdir($); *LC_MESSAGES = sub(){5} if $@; } +#-------------------- + sub new(@) { my $class = shift; @@ -47,8 +61,8 @@ sub init($) my $lex = delete $args->{lexicons} || delete $args->{lexicon} || (ref $self eq __PACKAGE__ ? [] : _fn_to_lexdir $args->{callerfn}); - error __x"You have to upgrade Log::Report::Lexicon to at least 1.00" - if +($Log::Report::Lexicon::Index::VERSION || 999) < 1.00; + +($Log::Report::Lexicon::Index::VERSION || 999) >= 1.00 + or error __x"You have to upgrade Log::Report::Lexicon to at least 1.00"; my @lex; foreach my $dir (ref $lex eq 'ARRAY' ? @$lex : $lex) @@ -68,14 +82,14 @@ sub _fn_to_lexdir($) File::Spec->catdir($fn, 'messages'); } -#------------ +#-------------------- -sub lexicons() { @{shift->{LRTP_lexicons}} } +sub lexicons() { @{ $_[0]->{LRTP_lexicons}} } -sub charset() { shift->{LRTP_charset} } +sub charset() { $_[0]->{LRTP_charset} } -#------------ +#-------------------- sub translate($;$$) { my ($self, $msg, $lang, $ctxt) = @_; @@ -111,16 +125,14 @@ sub load($$) my $class = $ext eq 'mo' ? 'Log::Report::Lexicon::MOTcompact' : $ext eq 'po' ? 'Log::Report::Lexicon::POTcompact' - : error __x"unknown translation table extension '{ext}' in {filename}", ext => $ext, filename => $fn; + : error __x"unknown translation table extension '{ext}' in {filename}", ext => $ext, filename => $fn; - info __x"read table {filename} as {class} for {dname} in {locale}", - filename => $fn, class => $class, dname => $dname, locale => $locale + info __x"read table {filename} as {class} for {dname} in {locale}", filename => $fn, class => $class, dname => $dname, locale => $locale if $dname ne 'log-report'; # avoid recursion eval "require $class" or panic $@; - - return $self->{LRTP_pots}{$dname}{$locale} = - $class->read($fn, charset => $self->charset); + + return $self->{LRTP_pots}{$dname}{$locale} = $class->read($fn, charset => $self->charset); } $self->{LRTP_pots}{$dname}{$locale} = undef; diff -pruN 1.12-1/lib/Log/Report/Translator/POT.pod 1.14-1/lib/Log/Report/Translator/POT.pod --- 1.12-1/lib/Log/Report/Translator/POT.pod 2025-04-18 15:10:21.000000000 +0000 +++ 1.14-1/lib/Log/Report/Translator/POT.pod 2025-09-08 13:31:48.000000000 +0000 @@ -11,20 +11,20 @@ Log::Report::Translator::POT - translati =head1 SYNOPSIS - # internal use - my $msg = Log::Report::Message->new - ( _msgid => "Hello World\n" - , _domain => 'my-domain' - ); - - print Log::Report::Translator::POT - ->new(lexicons => $dir) - ->translate($msg, 'nl-BE'); - - # normal use (end-users view in the program's ::main) - textdomain 'my-domain' - , translator => Log::Report::Translator::POT->new(lexicon => $dir); - print __"Hello World\n"; + # internal use + my $msg = Log::Report::Message->new( + _msgid => "Hello World\n", + _domain => 'my-domain', + ); + + print Log::Report::Translator::POT + ->new(lexicons => $dir) + ->translate($msg, 'nl-BE'); + + # normal use (end-users view in the program's ::main) + textdomain 'my-domain', + translator => Log::Report::Translator::POT->new(lexicon => $dir); + print __"Hello World\n"; =head1 DESCRIPTION @@ -33,22 +33,18 @@ lazily (unless forced). This module acc using L, which is much more efficient than L. -Extends L<"DESCRIPTION" in Log::Report::Translator|Log::Report::Translator/"DESCRIPTION">. - =head1 METHODS -Extends L<"METHODS" in Log::Report::Translator|Log::Report::Translator/"METHODS">. - =head2 Constructors -Extends L<"Constructors" in Log::Report::Translator|Log::Report::Translator/"Constructors">. - =over 4 -=item Log::Report::Translator::POT-EB(%options) +=item $class-EB(%options) + +Z<> -Option --Default - charset + charset > lexicons =over 2 @@ -74,18 +70,16 @@ of a L Log::Report::Translator::POT->new; + # 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/ + # lexicon now in xxx/perl5.8.8/My/Module/messages/ =back =head2 Accessors -Extends L<"Accessors" in Log::Report::Translator|Log::Report::Translator/"Accessors">. - =over 4 =item $obj-EB() @@ -101,30 +95,43 @@ translation files may be located. =head2 Translating -Extends L<"Translating" in Log::Report::Translator|Log::Report::Translator/"Translating">. - =over 4 -=item $obj-EB($domain, $locale) +=item $obj-EB($msg, $lang, $context) + +Z<> + +=back + +=head1 DIAGNOSTICS -Inherited, see L +=over 4 -=item $obj-EB( $message, [$language, $ctxt] ) +=item Error: You have to upgrade Log::Report::Lexicon to at least 1.00 -Inherited, see L +Cast by new() + +=item Info: read table $filename as $class for $dname in $locale + +Cast by translate() + +=item Error: unknown translation table extension '$ext' in $filename + +Cast by translate() =back =head1 SEE ALSO -This module is part of Log-Report-Lexicon distribution version 1.12, -built on April 18, 2025. Website: F +This module is part of Log-Report-Lexicon version 1.14, +built on September 08, 2025. Website: F =head1 LICENSE -Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. +For contributors see file ChangeLog. + +This software is copyright (c) 2007-2025 by Mark Overmeer. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. -See F +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff -pruN 1.12-1/lib/Log/Report/Win32Locale.pm 1.14-1/lib/Log/Report/Win32Locale.pm --- 1.12-1/lib/Log/Report/Win32Locale.pm 2025-04-18 15:10:20.000000000 +0000 +++ 1.14-1/lib/Log/Report/Win32Locale.pm 2025-09-08 13:31:48.000000000 +0000 @@ -1,13 +1,20 @@ -# Copyrights 2007-2025 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.03. -# This code is part of distribution Log-Report-Lexicon. 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. +# This code is part of Perl distribution Log-Report-Lexicon version 1.14. +# The POD got stripped from this file by OODoc version 3.04. +# For contributors see file ChangeLog. + +# This software is copyright (c) 2007-2025 by Mark Overmeer. + +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later + +#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION *** +#oodist: This file contains OODoc-style documentation which will get stripped +#oodist: during its release in the distribution. You can use this file for +#oodist: testing, however the code of this development version may be broken! package Log::Report::Win32Locale;{ -our $VERSION = '1.12'; +our $VERSION = '1.14'; } use base 'Exporter'; @@ -17,51 +24,55 @@ use strict; use Log::Report 'log-report-lexicon'; -our @EXPORT = qw/codepage_to_iso iso_to_codepage - iso_locale charset_encoding - ms_codepage_id ms_install_codepage_id ms_locale/; - +our @EXPORT = qw/ + codepage_to_iso + iso_to_codepage + iso_locale + charset_encoding + ms_codepage_id + ms_install_codepage_id + ms_locale +/; + use Win32::TieRegistry; -my %codepage2iso; -my %localewin2iso; -my %charsetwin; +my (%codepage2iso, %localewin2iso, %charsetwin); while() -{ my ($codepage, $iso, $localewin, $charsetwin, $name) = split /\,\s*/, $_, 5; - defined $name or die "Missing field in '$_'"; - $codepage2iso{hex $codepage} = $iso; - $localewin2iso{$localewin} = $iso; - $charsetwin{$localewin} = $charsetwin; +{ my ($codepage, $iso, $localewin, $charsetwin, $name) = split /\,\s*/, $_, 5; + defined $name or die "Missing field in '$_'"; + $codepage2iso{hex $codepage} = $iso; + $localewin2iso{$localewin} = $iso; + $charsetwin{$localewin} = $charsetwin; } my %iso2codepage = reverse %codepage2iso; close DATA; +#-------------------- sub codepage_to_iso($) -{ my $cp = shift; - defined $cp ? $codepage2iso{$cp =~ m/^0x/i ? hex($cp) : $cp} : (); +{ my $cp = shift; + defined $cp ? $codepage2iso{$cp =~ m/^0x/i ? hex($cp) : $cp} : (); } - + sub iso_to_codepage($) -{ my $iso = shift; - return $iso2codepage{$iso} - if $iso2codepage{$iso}; +{ my $iso = shift; + return $iso2codepage{$iso} + if $iso2codepage{$iso}; - my ($lang) = split $iso, /\_/; - $iso2codepage{$lang}; + my ($lang) = split $iso, /\_/; + $iso2codepage{$lang}; } sub iso_locale(;$) -{ my $locale = shift; - if(defined $locale) - { my $iso = $localewin2iso{$locale} || $codepage2iso{$locale}; - return $iso if $iso; - } +{ my $locale = shift; + if(defined $locale) + { my $iso = $localewin2iso{$locale} || $codepage2iso{$locale}; + return $iso if $iso; + } - codepage_to_iso(ms_codepage_id()) - || codepage_to_iso(ms_locale()); + codepage_to_iso(ms_codepage_id()) || codepage_to_iso(ms_locale()); } # the following functions are rewrites of Win32::Codepage version 1.00 @@ -69,40 +80,39 @@ sub iso_locale(;$) # Win32 does not nicely export the functions. my $nls = 'HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Nls'; -my $del = {Access => Win32::TieRegistry::KEY_READ(), Delimiter => '/'}; +my $del = +{ Access => Win32::TieRegistry::KEY_READ(), Delimiter => '/' }; my $codepages = Win32::TieRegistry->new("$nls/CodePage", $del); my $languages = Win32::TieRegistry->new("$nls/Language", $del); sub charset_encoding -{ my $charset = $codepages->GetValue("ACP") || $codepages->GetValue("OEMCP"); - $charset && $charset =~ m/^[0-9a-fA-F]+$/ ? "cp".lc($charset) : undef; +{ my $charset = $codepages->GetValue("ACP") || $codepages->GetValue("OEMCP"); + $charset && $charset =~ m/^[0-9a-fA-F]+$/ ? "cp".lc($charset) : undef; } sub ms_codepage_id -{ my $id = $languages->GetValue("Default"); - $id && $id =~ m/^[0-9a-fA-F]+$/ ? hex($id) : undef; +{ my $id = $languages->GetValue("Default"); + $id && $id =~ m/^[0-9a-fA-F]+$/ ? hex($id) : undef; } sub ms_install_codepage_id -{ my $id = $languages->GetValue("InstallLanguage"); - $id && $id =~ m/^[0-9a-fA-F]+$/ ? hex($id) : undef; +{ my $id = $languages->GetValue("InstallLanguage"); + $id && $id =~ m/^[0-9a-fA-F]+$/ ? hex($id) : undef; } - + # the following functions are rewrites of Win32::Locale version 0.04 # Copyright (c) 2001,2003 Sean M. Burke, Under perl license. # The module seems unmaintained, and treating the 'region' in the ISO # code as lower-case is a mistake. -my $i18n = Win32::TieRegistry->new - ("HKEY_CURRENT_USER/Control Panel/International", $del); +my $i18n = Win32::TieRegistry->new("HKEY_CURRENT_USER/Control Panel/International", $del); sub ms_locale -{ my $locale = $i18n->GetValue("Locale"); - $locale =~ m/^[0-9a-fA-F]+$/ ? hex($locale) : undef; +{ my $locale = $i18n->GetValue("Locale"); + $locale =~ m/^[0-9a-fA-F]+$/ ? hex($locale) : undef; } 1; diff -pruN 1.12-1/lib/Log/Report/Win32Locale.pod 1.14-1/lib/Log/Report/Win32Locale.pod --- 1.12-1/lib/Log/Report/Win32Locale.pod 2025-04-18 15:10:21.000000000 +0000 +++ 1.14-1/lib/Log/Report/Win32Locale.pod 2025-09-08 13:31:48.000000000 +0000 @@ -40,21 +40,21 @@ The algorithms in this module are based Returns the encoding name (usable with module Encode) based on the current codepage. For example, C for iso-8859-1 (latin-1) or C for -Shift-JIS Japanese. Returns undef if the encoding cannot be identified. +Shift-JIS Japanese. Returns C if the encoding cannot be identified. =item B($codepage) -Translate windows $codepage into ISO code. The $codepage is numeric +Translate windows C<$codepage> into ISO code. The C<$codepage> is numeric or a hex string like '0x0304'. =item B( [$codepage] ) Returns the ISO string for the Microsoft codepage locale. Might return -C/false. By default, the actual codepage is used. +C/C. By default, the actual codepage is used. =item B($iso) -Returns the numeric value of the codepage. The $iso may look like +Returns the numeric value of the codepage. The C<$iso> may look like this: C. Then, first the C is looked-up. If that does not exist, C is tried. @@ -62,7 +62,7 @@ not exist, C is tried. Returns the numeric language ID for the current codepage language. For example, the numeric value for C<0x0409> for C, and C<0x0411> -for C. Returns false if the codepage cannot be identified. +for C. Returns C if the codepage cannot be identified. =item B() @@ -78,14 +78,15 @@ Returns the locale setting from the cont =head1 SEE ALSO -This module is part of Log-Report-Lexicon distribution version 1.12, -built on April 18, 2025. Website: F +This module is part of Log-Report-Lexicon version 1.14, +built on September 08, 2025. Website: F =head1 LICENSE -Copyrights 2007-2025 by [Mark Overmeer ]. For other contributors see ChangeLog. +For contributors see file ChangeLog. -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. -See F +This software is copyright (c) 2007-2025 by Mark Overmeer. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff -pruN 1.12-1/t/00use.t 1.14-1/t/00use.t --- 1.12-1/t/00use.t 2025-04-10 08:55:41.000000000 +0000 +++ 1.14-1/t/00use.t 2025-09-08 13:22:16.000000000 +0000 @@ -2,7 +2,7 @@ use warnings; use strict; -use Test::More tests => 10; +use Test::More; # The versions of the following packages are reported to help understanding # the environment in which the tests are run. This is certainly not a @@ -11,6 +11,9 @@ my @show_versions = qw/PPI POSIX Test::Pod + Log::Report::Optional + Log::Report + String::Print /; warn "Perl $]\n"; @@ -27,7 +30,6 @@ foreach my $package (sort @show_versions use_ok('Log::Report'); use_ok('Log::Report::Extract'); -use_ok('Log::Report::Extract::Template'); use_ok('Log::Report::Lexicon::Index'); use_ok('Log::Report::Lexicon::PO'); use_ok('Log::Report::Lexicon::POT'); @@ -37,3 +39,5 @@ use_ok('Log::Report::Translator'); use_ok('Log::Report::Translator::POT'); # Log::Report::Extract::PerlPPI requires optional PPI + +done_testing; diff -pruN 1.12-1/t/41ppi_imports.t 1.14-1/t/41ppi_imports.t --- 1.12-1/t/41ppi_imports.t 1970-01-01 00:00:00.000000000 +0000 +++ 1.14-1/t/41ppi_imports.t 2025-09-08 13:22:16.000000000 +0000 @@ -0,0 +1,66 @@ +#!/usr/bin/env perl +# Test that we can cope with all of the ways of specifying a text domain. + +use warnings; +use strict; + +use Cwd; +use File::Temp qw/tempdir/; +use Test::More; + +BEGIN +{ eval "require PPI"; + plan skip_all => 'PPI not installed' + if $@; + + use_ok('Log::Report::Extract::PerlPPI'); +} + +_test_import( + subtest_name => 'Preceded by a version number', + source => 'use Log::Report 1.00 "not-a-version-number";', + text_domain => 'not-a-version-number', +); +_test_import( + subtest_name => 'Using a quotelike operator', + source => 'use Log::Report qw(wossname)', + text_domain => 'wossname', +); +_test_import( + subtest_name => 'The Dancer plugin works as well', + source => q{use Dancer2::Plugin::LogReport 'dance-monkey-dance';}, + text_domain => 'dance-monkey-dance', +); +_test_import( + subtest_name => 'With no arguments at all', + source => 'use Log::Report', + text_domain => undef, +); +done_testing(); + +sub _test_import { + my (%args) = @_; + + subtest $args{subtest_name} => sub { + my $source_dir = tempdir CLEANUP => 1; + my $lexicon = tempdir CLEANUP => 1; + my $ppi = Log::Report::Extract::PerlPPI->new(lexicon => $lexicon); + my $previous_cwd = Cwd::cwd(); + chdir($source_dir); + open (my $fh, '>', 'perl-source.pl'); + print $fh $args{source}; + close $fh; + $ppi->process('perl-source.pl'); + $ppi->write; + + my @leafnames = keys %{ $ppi->index->index }; + if (defined $args{text_domain}) { + is @leafnames, 1, 'We added a file'; + like $leafnames[0], qr/^$args{text_domain}/, '...matching the expected text domain'; + } else { + is @leafnames, 0, 'No text domain = no files added'; + } + + chdir($previous_cwd); + }; +}