Lines 25-31
use C4::Context;
Link Here
|
25 |
use YAML::Syck qw( Dump LoadFile ); |
25 |
use YAML::Syck qw( Dump LoadFile ); |
26 |
use Locale::PO; |
26 |
use Locale::PO; |
27 |
use FindBin qw( $Bin ); |
27 |
use FindBin qw( $Bin ); |
|
|
28 |
use File::Basename; |
29 |
use File::Find; |
28 |
use File::Path qw( make_path ); |
30 |
use File::Path qw( make_path ); |
|
|
31 |
use File::Slurp; |
32 |
use File::Temp qw( tempdir ); |
33 |
use Template::Parser; |
34 |
use PPI; |
29 |
|
35 |
|
30 |
$YAML::Syck::ImplicitTyping = 1; |
36 |
$YAML::Syck::ImplicitTyping = 1; |
31 |
|
37 |
|
Lines 498-503
sub update_messages {
Link Here
|
498 |
system "$self->{msgmerge} -U $pofile $self->{domain}.pot"; |
504 |
system "$self->{msgmerge} -U $pofile $self->{domain}.pot"; |
499 |
} |
505 |
} |
500 |
|
506 |
|
|
|
507 |
sub extract_messages_from_templates { |
508 |
my ($self, $tempdir, @files) = @_; |
509 |
|
510 |
my $intranetdir = $self->{context}->config('intranetdir'); |
511 |
my @keywords = qw(t tx tn txn tnx tp tpx tnp tnpx); |
512 |
my $parser = Template::Parser->new(); |
513 |
|
514 |
foreach my $file (@files) { |
515 |
my $template = read_file("$intranetdir/$file"); |
516 |
my $data = $parser->parse($template); |
517 |
my $document = PPI::Document->new(\$data->{BLOCK}); |
518 |
|
519 |
# [% t('foo') %] is compiled to $output .= $stash->get(['t', ['foo']]); |
520 |
# We try to find all nodes corresponding to keyword (here 't') |
521 |
my $nodes = $document->find(sub { |
522 |
my ($topnode, $element) = @_; |
523 |
|
524 |
# Filter out non-valid keywords |
525 |
return 0 unless ($element->isa('PPI::Token::Quote::Single')); |
526 |
return 0 unless (grep {$element->content eq qq{'$_'}} @keywords); |
527 |
|
528 |
# keyword (e.g. 't') should be the first element of the arrayref |
529 |
# passed to $stash->get() |
530 |
return 0 if $element->sprevious_sibling; |
531 |
|
532 |
return 0 unless $element->snext_sibling |
533 |
&& $element->snext_sibling->snext_sibling |
534 |
&& $element->snext_sibling->snext_sibling->isa('PPI::Structure::Constructor'); |
535 |
|
536 |
# Check that it's indeed a call to $stash->get() |
537 |
my $statement = $element->statement->parent->statement->parent->statement; |
538 |
return 0 unless grep { $_->isa('PPI::Token::Symbol') && $_->content eq '$stash' } $statement->children; |
539 |
return 0 unless grep { $_->isa('PPI::Token::Operator') && $_->content eq '->' } $statement->children; |
540 |
return 0 unless grep { $_->isa('PPI::Token::Word') && $_->content eq 'get' } $statement->children; |
541 |
|
542 |
return 1; |
543 |
}); |
544 |
|
545 |
next unless $nodes; |
546 |
|
547 |
# Write the Perl equivalent of calls to t* functions family, so xgettext |
548 |
# can extract the strings correctly |
549 |
make_path(dirname("$tempdir/$file")); |
550 |
open my $fh, '>', "$tempdir/$file"; |
551 |
|
552 |
foreach my $node (@$nodes) { |
553 |
my @args = map { |
554 |
$_->significant && !$_->isa('PPI::Token::Operator') ? $_->content : () |
555 |
} $node->snext_sibling->snext_sibling->find_first('PPI::Statement')->children; |
556 |
|
557 |
my $keyword = $node->content; |
558 |
$keyword =~ s/^'t(.*)'$/__$1/; |
559 |
|
560 |
say $fh "$keyword(" . join(', ', @args) . ");"; |
561 |
} |
562 |
|
563 |
close $fh; |
564 |
} |
565 |
|
566 |
return $tempdir; |
567 |
} |
568 |
|
501 |
sub extract_messages { |
569 |
sub extract_messages { |
502 |
my $self = shift; |
570 |
my $self = shift; |
503 |
|
571 |
|
Lines 520-530
sub extract_messages {
Link Here
|
520 |
} |
588 |
} |
521 |
} |
589 |
} |
522 |
|
590 |
|
|
|
591 |
my @tt_files; |
592 |
find(sub { |
593 |
if ($File::Find::dir =~ m|/en/| && $_ =~ m/\.(tt|inc)$/) { |
594 |
my $filename = $File::Find::name; |
595 |
$filename =~ s|^$intranetdir/||; |
596 |
push @tt_files, $filename; |
597 |
} |
598 |
}, "$intranetdir/koha-tmpl"); |
599 |
|
600 |
my $tempdir = tempdir('Koha-translate-XXXX', TMPDIR => 1, CLEANUP => 1); |
601 |
$self->extract_messages_from_templates($tempdir, @tt_files); |
602 |
push @files_to_scan, @tt_files; |
603 |
|
523 |
my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 " |
604 |
my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 " |
524 |
. "-k -k__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 -k__p:1c,2 " |
605 |
. "-k -k__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 -k__p:1c,2 " |
525 |
. "-k__px:1c,2 -k__np:1c,2,3 -k__npx:1c,2,3 -kN__ -kN__n:1,2 " |
606 |
. "-k__px:1c,2 -k__np:1c,2,3 -k__npx:1c,2,3 -kN__ -kN__n:1,2 " |
526 |
. "-kN__p:1c,2 -kN__np:1c,2,3 " |
607 |
. "-kN__p:1c,2 -kN__np:1c,2,3 " |
527 |
. "-o $Bin/$self->{domain}.pot -D $intranetdir"; |
608 |
. "-o $Bin/$self->{domain}.pot -D $tempdir -D $intranetdir"; |
528 |
$xgettext_cmd .= " $_" foreach (@files_to_scan); |
609 |
$xgettext_cmd .= " $_" foreach (@files_to_scan); |
529 |
|
610 |
|
530 |
if (system($xgettext_cmd) != 0) { |
611 |
if (system($xgettext_cmd) != 0) { |
531 |
- |
|
|