Commit v0.998 - liblog-report-perl

distribution Log-Report-0.998.tar.gz Mark Overmeer authored 10 years ago Mark Overmeer committed 6 years ago

7 changed file(s) with 172 addition(s) and 53 deletion(s). Raw diff Collapse all Expand all

+13

-1

ChangeLog less more

4	4	. connect to Message::Passing framework
5	5	. extract a Log::Report::Optional distribution
6	6
	7	version 0.998: Tue Oct 22 09:55:06 CEST 2013
	8	Fixes:
	9	- xgettext-perl: actually use the provided template pattern
	10	- xgettext-perl: only take template from .tt and .tt2 files
	11	- xgettext-perl: accept '-' (STDIN) for --from
	12
	13	Improvements:
	14	- more documentation about the PPI extraction process, and how
	15	to use ::Message::new(_domain)
	16	- Log::Report import option 'import'
	17
7	18	version 0.997: Fri Sep 27 17:37:11 CEST 2013
8	19	Fixes:
9	20	- error about double definedness of settings, dependent on the

12	23
13	24	Improvements:
14	25	- xgettext-perl: do not PPI files unless they are Perl
15		- xgettext-perl: do warn when ' are used, needs " with __x
	26	- xgettext-perl: do warn when ' (single quotes) are used, needs
	27	" (double quote) with __x
16	28	- __x() now can have a _domain parameter
17	29
18	30	version 0.996: Wed Sep 4 17:23:11 CEST 2013

-1

Makefile.PL less more

1	1
2	2	use 5.008;
3	3
4		my $version = '0.997';
	4	my $version = '0.998';
5	5
6	6	my %prereq =
7	7	( Test::More => 0.86

+32

-18

bin/xgettext-perl less more

11	11	my $lang = 'perl';
12	12	my $version = 0;
13	13	my $help = 0;
14		my ($from, $output);
	14	my ($from, $output, $fn_match);
15	15	my ($char_in, $char_out, $domain, $mode, $template);
16	16
17	17	GetOptions
18		'files-from\|f=s' => \$from
	18	'domain\|d=s' => \$domain
	19	, 'files-from\|f=s' => \$from # file with filenames (MANIFEST?) or '-'
	20	, 'files-match\|m=s' => \$fn_match # select filename is dir
	21	, 'from-code=s' => \$char_in
	22	, 'help\|h' => \$help
	23	, 'language\|L=s' => \$lang
	24	, 'mode=s' => \$mode
19	25	, 'output-dir\|p=s' => \$output
20		, 'domain\|d=s' => \$domain
21		, 'language\|L=s' => \$lang
22		, 'from-code=s' => \$char_in
	26	, 'template\|t=s' => \$template # pattern in ::Template
23	27	, 'to-code=s' => \$char_out # missing in xgettext?
	28	, 'verbose=i' => \$mode
24	29	, 'version\|V' => \$version
25		, 'help\|h' => \$help
26		, 'template\|t=s' => \$template # pattern in ::Template
27		, 'verbose=i' => \$mode
28	30	, 'v+' => \$mode
29		, 'mode=s' => \$mode
30		or exit(1);
	31	or exit(1);
31	32
32	33	if($version)
33	34	{ print "Log::Report $Log::Report::VERSION\n";

60	61	{ !@ARGV
61	62	or error __x"do not combine command-line filenames with --files-from";
62	63
63		open FILENAMES, '<:raw', $from
64		or fault __x"cannot read filename list from {fn}", fn => $from;
	64	if($from eq '-')
	65	{ @filenames = <STDIN>;
	66	}
	67	else
	68	{ open FILENAMES, '<:raw', $from
	69	or fault __x"cannot read filename list from {fn}", fn => $from;
65	70
66		@filenames = <FILENAMES>;
67		close FILENAMES;
	71	@filenames = <FILENAMES>;
	72	close FILENAMES;
	73	}
68	74	chomp(@filenames);
69	75	}
70	76	elsif(@ARGV)

85	91	( lexicon => $output
86	92	, charset => $char_out
87	93	, domain => $domain
88		, pattern => 'TT2-loc'
	94	, pattern => $template
89	95	);
90	96
91		$extr->process($_, charset => $char_in)
92		for @filenames;
	97	$fn_match \|\|= qr/\.tt2?$/i;
	98
	99	foreach my $filename (@filenames)
	100	{ unless($filename =~ $fn_match)
	101	{ info __x"skipping (not a template) {fn}", fn => $filename;
	102	next;
	103	}
	104	$extr->process($_, charset => $char_in)
	105	}
93	106	}
94	107	else
95	108	{ # process the pm files

101	114	, charset => $char_out
102	115	);
103	116
	117	$fn_match \|\|= qr/\.p[lm]$/i;
104	118	foreach my $filename (@filenames)
105		{ unless($filename =~ m/\.p[lm]$/i)
	119	{ unless($filename =~ $fn_match)
106	120	{ info __x"skipping (not perl) {fn}", fn => $filename;
107	121	next;
108	122	}

+75

-14

lib/Log/Report/Extract/PerlPPI.pm less more

32	32	my $ppi = Log::Report::Extract::PerlPPI->new
33	33	( lexicon => '/usr/share/locale'
34	34	);
35		$ppi->process('lib/My/Pkg.pm'); # many times
36		$ppi->showStats;
	35	$ppi->process('lib/My/Pkg.pm'); # call for each .pm file
	36	$ppi->showStats; # optional
37	37	$ppi->write;
38	38
39	39	# See script xgettext-perl
40	40
41	41	=chapter DESCRIPTION
	42
42	43	This module helps maintaining the POT files, updating the list of
43	44	message-ids which are kept in them. After initiation, the M<process()>
44	45	method needs to be called with all files which changed since last processing
45		and the existing PO files will get updated accordingly. If no translations
46		exist yet, one C<textdomain/xx.po> file will be created.
	46	and the existing PO files will get updated accordingly.
	47
	48	If no translations exist yet, one C<$lexicon/$domain.po> file will be
	49	created. If you want to start a translation, copy C<$lexicon/$domain.po>
	50	to C<$lexicon/$domain/$lang.po> and edit that file. You may use
	51	C<poedit> to edit po-files. Do not forget to add the new po-file to
	52	your distribution (MANIFEST)
	53
	54	=section The extraction process
	55
	56	All pm-files need to be processed in one go: no incremental processing!
	57
	58	The Perl source is parsed using M<PPI>, which does understand Perl syntax
	59	quite well, but does not support all features.
	60
	61	Automatically, the textdomain of the translations is discovered, as
	62	first parameter of C<use Log::Report>. You may switch textdomain inside
	63	one pm-file.
	64
	65	When all files have been processed, during the M<write()>, all existing
	66	po-files for all discovered textdomains will get updated. Not only the
	67	C<$lexicon/$domain.po> template, but also all C<$lexicon/$domain/$lang.po>
	68	will be replaced. When a msgid has disappeared, existing translations
	69	will get disabled, not removed. New msgids will be added and flagged
	70	"fuzzy".
	71
	72	=subsection What is extracted?
	73
	74	This script will extract the msgids used in C<__()>, C<__x()>, C<__xn()>,
	75	and C<__n()> (implemented by M<Log::Report>) For instance
	76
	77	__x"msgid", @more
	78	__x'msgid', @more <--- no! syntax error!
	79	__x("msgid", @more)
	80	__x('msgid', @more)
	81	__x(msgid => @more)
	82
	83	Besides, there are some helpers which are no-ops in the code, only to fill
	84	the po-tables: C<N__()>, C<N__n()>, C<N__()>
	85
	86	=subsection What is not extracted?
	87
	88	B<Not> extracted are the usage of anything above, where the first
	89	parameter is not a simple string. Not extracted are
	90
	91	__x($format, @more)
	92	__x$format, @more
	93	__x(+$format, _domain => 'other domain', @more)
	94	__x($first.$second, @more)
	95
	96	In these cases, you have to use C<N__()> functions to declare the possible
	97	values of C<$format>.
47	98
48	99	=chapter METHODS
49	100

125	176	my $def = $msgids{$word} # get __() description
126	177	or return 0;
127	178
128		my @msgids = $self->_get($node, @$def)
	179	my @msgids = $self->_get($node, $domain, $word, $def)
129	180	or return 0;
	181
	182	my ($nr_msgids, $has_count, $has_opts, $has_vars,$do_split) = @$def;
130	183
131	184	my $line = $node->location->[0];
132	185	unless($domain)
133		{ mistake __x
134		"no text-domain for translatable at {fn} line {line}"
	186	{ mistake
	187	__x"no text-domain for translatable at {fn} line {line}"
135	188	, fn => $fn, line => $line;
136	189	return 0;
137	190	}
138	191
139		if($def->[4]) # must split? Bulk conversion strings
	192	if($do_split) # Bulk conversion strings
140	193	{ my @words = map {split} @msgids;
141	194	$self->store($domain, $fn, $line, $_) for @words;
142	195	$msgs_found += @words;

153	206	$msgs_found;
154	207	}
155	208
156		sub _get($@)
157		{ my ($self, $node, $msgids, $count, $opts, $vars, $split) = @_;
158		my $list_only = ($msgids > 1) \|\| $count \|\| $opts \|\| $vars;
	209	sub _get($$$$)
	210	{ my ($self, $node, $domain, $function, $def) = @_;
	211	my ($nr_msgids, $has_count, $opts, $vars, $split) = @$def;
	212	my $list_only = ($nr_msgids > 1) \|\| $has_count \|\| $opts \|\| $vars;
159	213	my $expand = $opts \|\| $vars;
160	214
161	215	my @msgids;

166	220	$first = $first->schild(0)
167	221	if $first->isa('PPI::Statement::Expression');
168	222
169		while(defined $first && $msgids > @msgids)
	223	my $line;
	224	while(defined $first && $nr_msgids > @msgids)
170	225	{ my $msgid;
171	226	my $next = $first->snext_sibling;
172	227	my $sep = $next && $next->isa('PPI::Token::Operator') ? $next : '';
173		my $line = $first->location->[0];
	228	$line = $first->location->[0];
174	229
175	230	if($first->isa('PPI::Token::Quote'))
176	231	{ last if $sep !~ m/^ (?: \| \=\> \| [,;:] ) $/x;

200	255	, line => $line if $msgid =~ s/(?<!\\)\n$//;
201	256
202	257	push @msgids, $msgid;
203		last if $msgids==@msgids \|\| !$sep;
	258	last if $nr_msgids==@msgids \|\| !$sep;
204	259
205	260	$first = $sep->snext_sibling;
	261	}
	262	@msgids or return ();
	263	my $next = $first->snext_sibling;
	264	if($has_count && !$next)
	265	{ error __x"count missing in {function} in line {line}"
	266	, function => $function, line => $line;
206	267	}
207	268
208	269	@msgids;

+11

-1

lib/Log/Report/Message.pm less more

80	80	Indicates whether variables are to be filled-in.
81	81
82	82	=option _domain STRING
83		=default _domain from C<use>
	83	=default _domain <from "use Log::Report">
84	84	The text-domain (translation table) to which this C<_msgid> belongs.
	85
	86	With this parameter, your can "borrow" translations from other textdomains.
	87	Be very careful with this (although there are good use-cases) The xgettext
	88	msgid extractor may add the used msgid to this namespace as well. To
	89	avoid that, add a harmless '+':
	90
	91	print __x(+"errors", _domain => 'global');
	92
	93	The extractor will not take the msgid when it is an expression. The '+'
	94	has no effect on the string at runtime.
85	95
86	96	=option _count INTEGER\|ARRAY\|HASH
87	97	=default _count C<undef>

+32

-15

lib/Log/Report.pm less more

22	22	require Log::Report::Dispatcher::Try;
23	23
24	24	# See section Run modes
25		my %is_reason = map {($_=>1)} @Log::Report::Util::reasons;
26		my %is_fatal = map {($_=>1)} qw/ERROR FAULT FAILURE PANIC/;
27		my %use_errno = map {($_=>1)} qw/FAULT ALERT FAILURE/;
	25	my %is_reason = map +($_=>1), @Log::Report::Util::reasons;
	26	my %is_fatal = map +($_=>1), qw/ERROR FAULT FAILURE PANIC/;
	27	my %use_errno = map +($_=>1), qw/FAULT ALERT FAILURE/;
28	28
29	29	sub _whats_needed(); sub dispatcher($@);
30	30	sub trace(@); sub assert(@); sub info(@); sub notice(@); sub warning(@);

101	101	fault "cannot allocate $size bytes"; # no translation
102	102	fault __x "cannot allocate $size bytes"; # wrong, not static
103	103
104		# translation depends on count.
	104	# translation depends on count
105	105	print __xn("found one file", "found {_count} files", @files), "\n";
	106
	107	# borrow from an other textdomain (see M<Log::Report::Message>)
	108	print __x(+"errors in {line}", _domain => 'global', line => $line);
106	109
107	110	# catch errors (implements hidden eval/die)
108	111	try { error };

829	832	also selectively change the output mode, like
830	833	dispatcher PERL => 'default', mode => 3
831	834
	835	=option import FUNCTION\|ARRAY
	836	=default import C<undef>
	837	[0.998] When not specified, the C<syntax> option determines the list
	838	of functions which are being exported. With this option, the C<syntax>
	839	option is ignored and only the specified FUNCTION(s) are imported.
	840
832	841	=examples of import
833	842	use Log::Report mode => 3; # or 'DEBUG'
834	843

837	846	use Log::Report 'my-domain' # in one package, top of distr
838	847	, mode => 'VERBOSE'
839	848	, translator => Log::Report::Translator::POT->new
840		( lexicon => '/home/me/locale' # bindtextdomain
841		, charset => 'UTF-8' # codeset
	849	( lexicon => '/home/mine/locale' # bindtextdomain
	850	, charset => 'UTF-8' # codeset
842	851	)
843	852	, native_language => 'nl_NL' # untranslated msgs are Dutch
844	853	, syntax => 'REPORT';# report ERROR, not error()
845	854
	855	use Log::Report import => 'try'; # or ARRAY of functions
	856
846	857	=cut
847	858
848	859	sub import(@)

850	861
851	862	my $textdomain = @_%2 ? shift : undef;
852	863	my %opts = @_;
853		my $syntax = delete $opts{syntax} \|\| 'SHORT';
854	864	my ($pkg, $fn, $linenr) = caller;
855	865
856	866	if(my $trans = delete $opts{translator})

875	885
876	886	push @{$domain_start{$fn}}, [$linenr => $textdomain];
877	887
878		my @export = (@functions, @make_msg);
879
880		if($syntax eq 'SHORT')
881		{ push @export, @reason_functions
882		}
883		elsif($syntax ne 'REPORT' && $syntax ne 'LONG')
884		{ error __x"syntax flag must be either SHORT or REPORT, not `{syntax}'"
885		, syntax => $syntax;
	888	my @export;
	889	if(my $in = $opts{import})
	890	{ push @export, ref $in eq 'ARRAY' ? @$in : $in;
	891	}
	892	else
	893	{ push @export, @functions, @make_msg;
	894
	895	my $syntax = delete $opts{syntax} \|\| 'SHORT';
	896	if($syntax eq 'SHORT')
	897	{ push @export, @reason_functions
	898	}
	899	elsif($syntax ne 'REPORT' && $syntax ne 'LONG')
	900	{ error __x"syntax flag must be either SHORT or REPORT, not `{flag}'"
	901	, flag => $syntax;
	902	}
886	903	}
887	904
888	905	$class->export_to_level(1, undef, @export);

-3

t/40ppi.t less more

6	6	use File::Temp qw/tempdir/;
7	7	use Test::More;
8	8
9		use constant MSGIDS => 24;
	9	use constant MSGIDS => 25;
10	10	use constant PLURAL_MSGIDS => 4;
11	11	BEGIN
12	12	{ eval "require PPI";
13	13	plan skip_all => 'PPI not installed'
14	14	if $@;
15	15
16		plan tests => 34 + MSGIDS3 + PLURAL_MSGIDS1;
	16	plan tests => 10 + MSGIDS4 + PLURAL_MSGIDS1;
17	17	use_ok('Log::Report::Extract::PerlPPI');
18	18	}
19	19

66	66	take(__x(qq{b7a}, b7b => "b7c"), 'b7a');
67	67	take(__x(q{b8a}, b8b => "b8c"), 'b8a');
68	68	take(__x(b9a => b9b => "b9c"), 'b9a');
	69	take(__x(b10 => 1, 2), 'b10');
69	70
70	71	take((__n "c1", "c2", 1), "c1", "c2");
71	72	take((__n "c3", "c4", 0), "c3", "c4");

78	79	take(join(',', N__w(" d4 d5
79	80	d6
80	81	d7")), "d4", "d5", "d6", "d7"); # line contains tab
	82
	83	### do not index these:
	84
	85	__x(+"e1");
81	86
82	87	### check that all tags were found in POT
83	88

94	99	ok(defined $msgid, "processing $msgid");
95	100	ok(!defined $msgids{$msgid}, 'check not double');
96	101	$msgids{$msgid}++;
97		ok(delete $expect_pos{$msgid}, 'was expected');
	102	ok(delete $expect_pos{$msgid}, "was expected $msgid");
98	103
99	104	my $plural = $po->plural
100	105	or next;