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