| 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 | -  |  |  |