Bug #38508 for Locale-Maketext-Lexicon: patch for tt & heredoc

OK, i changed the format of the diff and followed some advices :)

--- t/5-extract.t.orig 2008-08-17 12:43:56.000000000 +0200 +++ t/5-extract.t 2008-08-17 20:58:06.000000000 +0200 @@ -1,7 +1,7 @@ #! /usr/bin/perl -w use lib '../lib'; use strict; -use Test::More tests => 29; +use Test::More tests => 43; use_ok('Locale::Maketext::Extract'); my $Ext = Locale::Maketext::Extract->new; @@ -58,6 +58,121 @@ "Handle escaped double quotes" ); +extract_ok(q(_("","car")) => '', 'ignore empty string'); +extract_ok(q(_("0")) => '', 'ignore zero'); + +extract_ok(<<'__EXAMPLE__' => 'foo bar baz', 'trim the string (tt)'); +[% |loc -%] +foo bar baz +[%- END %] +__EXAMPLE__ + +extract_ok(<<'__EXAMPLE__' => "123\n", "Simple extraction (heredoc)"); +_(<<__LOC__); +123 +__LOC__ +__EXAMPLE__ + +extract_ok(<<'__EXAMPLE__' => "foo\\\$bar\\\'baz\n", "No escaped of \$ and \' in singlequoted terminator (heredoc)"); +_(<<'__LOC__'); +foo\$bar\'baz +__LOC__ +__EXAMPLE__ + +extract_ok(<<'__EXAMPLE__' => "foo\$bar\n", "Normalized \$ in doublequoted terminator (heredoc)"); +_(<<"__LOC__"); +foo\$bar +__LOC__ +__EXAMPLE__ + +extract_ok(<<'__EXAMPLE__' => "foo\nbar\n", "multilines (heredoc)"); +_(<<__LOC__); +foo +bar +__LOC__ +__EXAMPLE__ + +extract_ok(<<'__EXAMPLE__' => "example\n", "null identifier (heredoc)"); +_(<<""); +example + +__EXAMPLE__ + +extract_ok(<<'__EXAMPLE__' => "example\n", "end() after the heredoc (heredoc)"); +_(<<__LOC__ +example +__LOC__ +); +__EXAMPLE__ + +write_po_ok(<<'__EXAMPLE__' => <<'__EXPECTED__', "null identifier with end after the heredoc (heredoc)"); +_(<<"" +example + +); +__EXAMPLE__ +#: :1 +msgid "example\n" +msgstr "" +__EXPECTED__ + +write_po_ok(<<'__EXAMPLE__' => <<'__EXPECTED__', "q with multilines with args"); +_(q{example %1 +with multilines +},20); +__EXAMPLE__ +#: :1 +#. (20) +msgid "" +"example %1\n" +"with multilines\n" +msgstr "" +__EXPECTED__ + +write_po_ok(<<'__EXAMPLE__' => <<'__EXPECTED__', "null terminator with multilines with args (heredoc)"); +_(<<"", 15) +example %1 +with multilines + +__EXAMPLE__ +#: :1 +#. (15) +msgid "" +"example %1\n" +"with multilines\n" +msgstr "" +__EXPECTED__ + +write_po_ok(<<'__EXAMPLE__' => <<'__EXPECTED__', "null terminator with end after the heredoc with args (heredoc)"); +_(<<"", 10) +example %1 + +__EXAMPLE__ +#: :1 +#. (10) +msgid "example %1\n" +msgstr "" +__EXPECTED__ + +write_po_ok(<<'__EXAMPLE__' => <<'__EXPECTED__', "two _() calls (heredoc)"); +_(<<"", 10) +example1 %1 + +_(<<"", 5) +example2 %1 + +__EXAMPLE__ +#: :1 +#. (10) +msgid "example1 %1\n" +msgstr "" + +#: :4 +#. (5) +msgid "example2 %1\n" +msgstr "" +__EXPECTED__ + sub extract_ok { my ($text, $expected, $info, $verbatim) = @_; $Ext->extract('' => $text); @@ -67,3 +182,28 @@ $Ext->clear; } +sub write_po_ok { + my ($text, $expected, $info, $verbatim) = @_; + my $po_file = 't/5-extract.po'; + + # create .po + $Ext->extract('' => $text); + $Ext->compile($verbatim); + $Ext->write_po($po_file); + + # read .po + open(my $po_handle,'<',$po_file) or die("Cannot open $po_file: $!"); + local $/ = undef; + my $result = <$po_handle>; + close($po_handle); + unlink($po_file) or die("Cannot unlink $po_file: $!"); + + # cut the header from result + my $start_expected = length($Ext->header); + $start_expected++ if( $start_expected < length($result) ); + + # check result vs expected + is(substr($result, $start_expected), $expected, $info ); + $Ext->clear; +} +

--- lib/Locale/Maketext/Extract.pm.orig 2008-08-17 12:40:53.000000000 +0200 +++ lib/Locale/Maketext/Extract.pm 2008-08-17 20:42:38.000000000 +0200 @@ -202,11 +202,14 @@ use constant NUL => 0; use constant BEG => 1; use constant PAR => 2; +use constant HERE =>10; use constant QUO1 => 3; use constant QUO2 => 4; use constant QUO3 => 5; use constant QUO4 => 6; use constant QUO5 => 7; +use constant QUO6 => 8; +use constant QUO7 => 9; sub extract { my $self = shift; @@ -252,11 +255,13 @@ # Template Toolkit $line = 1; pos($_) = 0; - while (m!\G(.*?\[%\s*\|l(?:oc)?(.*?)\s*%\](.*?)\[%\s*END\s*%\])!sg) { - my ($vars, $str) = ($2, $3); + while (m!\G(.*?\[%-?\s*\|l(?:oc)?(.*?)\s*(-?)%\](.*?)\[%(-?)\s*END\s*-?%\])!sg) { + my ($vars, $trim_start, $str, $trim_end) = ($2, $3, $4, $5); $line += ( () = ($1 =~ /\n/g) ); # cryptocontext! $vars =~ s/^\s*\(//; $vars =~ s/\)\s*$//; + $trim_start && $str =~ s/^\s+//; + $trim_end && $str =~ s/\s+$//; $self->add_entry($str, [ $file, $line, $vars ]); } @@ -300,7 +305,7 @@ } # Perl code: - my ($state,$str,$vars,$quo)=(0); + my ($state,$str,$vars,$quo,$heredoc)=(0); pos($_) = 0; my $orig = 1 + (() = ((my $__ = $_) =~ /\n/g)); @@ -341,6 +346,22 @@ $state == QUO5 && m/^([^\}]*)/gc && do { $str .= $1; redo }; $state == QUO5 && m/^\}/gc && do { $state = PAR; redo }; + # find heredoc terminator, then get the heredoc and go back to current position + $state == PAR && m/^<<\s*\'/gc && do { $state = $quo = QUO6; $heredoc = ''; redo }; + $state == QUO6 && m/^([^'\\\n]+)/gc && do { $heredoc .= $1; redo }; + $state == QUO6 && m/^((?:\\.)+)/gc && do { $heredoc .= $1; redo }; + $state == QUO6 && m/^\'/gc && do { $state = HERE; $heredoc =~ s/\\\'/\'/g; redo }; + + $state == PAR && m/^<<\s*\"/gc && do { $state = $quo = QUO7; $heredoc = ''; redo }; + $state == QUO7 && m/^([^"\\\n]+)/gc && do { $heredoc .= $1; redo }; + $state == QUO7 && m/^((?:\\.)+)/gc && do { $heredoc .= $1; redo }; + $state == QUO7 && m/^\"/gc && do { $state = HERE; $heredoc =~ s/\\\"/\"/g; redo }; + + $state == PAR && m/^<<(\w*)/gc && do { $state = HERE; $quo = QUO7; $heredoc = $1; redo }; + + # jump ahaid and get the heredoc, then s/// also reset the pos and we are back at the current pos + $state == HERE && m/^.*\r?\n/gc && s/\G(.*?\r?\n)$heredoc(\r?\n)//s && do { $state = PAR; $str .= $1; redo }; + # end () # @@ -348,13 +369,14 @@ $state = NUL; $vars =~ s/[\n\r]//g if ($vars); if (($quo == QUO1) || ($quo == QUO5) ){ - $str =~ s/\\([\\'])/$1/g; # normalize q strings + $str =~ s/\\([\\'])/$1/g if ($str); # normalize q strings } - else { - $str =~ s/(\\(?:[0x]..|c?.))/"qq($1)"/eeg; # normalize qq / qx strings + elsif ($quo != QUO6) { + $str =~ s/(\\(?:[0x]..|c?.))/"qq($1)"/eeg if ($str); # normalize qq / qx strings } - push @{$entries->{$str}}, [ $file, $line - (() = $str =~ /\n/g), $vars] if ($str); - undef $str; undef $vars; + # heredoc loosing the terminating line, so decrement one more line for heredoc + push @{$entries->{$str}}, [ $file, $line - (() = $str =~ /\n/g) - defined($heredoc), $vars] if ($str); + undef $str; undef $vars; undef $heredoc; redo; };