View | Details | Raw Unified | Return to bug 15395
Collapse All | Expand All

(-)a/misc/translator/LangInstaller.pm (-34 / +43 lines)
Lines 550-599 sub extract_messages_from_templates { Link Here
550
        say "Extract messages from $file" if $self->{verbose};
550
        say "Extract messages from $file" if $self->{verbose};
551
        my $template = read_file("$intranetdir/$file");
551
        my $template = read_file("$intranetdir/$file");
552
        my $data = $parser->parse($template);
552
        my $data = $parser->parse($template);
553
        my $document = PPI::Document->new(\$data->{BLOCK});
553
        unless ($data) {
554
            warn "Error at $file : " . $parser->error();
555
            next;
556
        }
554
557
555
        # [% t('foo') %] is compiled to $output .= $stash->get(['t', ['foo']]);
558
        make_path(dirname("$tempdir/$file"));
556
        # We try to find all nodes corresponding to keyword (here 't')
559
        open my $fh, '>', "$tempdir/$file";
557
        my $nodes = $document->find(sub {
558
            my ($topnode, $element) = @_;
559
560
560
            # Filter out non-valid keywords
561
        my @blocks = ($data->{BLOCK}, values %{ $data->{DEFBLOCKS} });
561
            return 0 unless ($element->isa('PPI::Token::Quote::Single'));
562
        foreach my $block (@blocks) {
562
            return 0 unless (grep {$element->content eq qq{'$_'}} @keywords);
563
            my $document = PPI::Document->new(\$block);
563
564
564
            # keyword (e.g. 't') should be the first element of the arrayref
565
            # [% t('foo') %] is compiled to
565
            # passed to $stash->get()
566
            # $output .= $stash->get(['t', ['foo']]);
566
            return 0 if $element->sprevious_sibling;
567
            # We try to find all nodes corresponding to keyword (here 't')
568
            my $nodes = $document->find(sub {
569
                my ($topnode, $element) = @_;
567
570
568
            return 0 unless $element->snext_sibling
571
                # Filter out non-valid keywords
569
                && $element->snext_sibling->snext_sibling
572
                return 0 unless ($element->isa('PPI::Token::Quote::Single'));
570
                && $element->snext_sibling->snext_sibling->isa('PPI::Structure::Constructor');
573
                return 0 unless (grep {$element->content eq qq{'$_'}} @keywords);
571
574
572
            # Check that it's indeed a call to $stash->get()
575
                # keyword (e.g. 't') should be the first element of the arrayref
573
            my $statement = $element->statement->parent->statement->parent->statement;
576
                # passed to $stash->get()
574
            return 0 unless grep { $_->isa('PPI::Token::Symbol') && $_->content eq '$stash' } $statement->children;
577
                return 0 if $element->sprevious_sibling;
575
            return 0 unless grep { $_->isa('PPI::Token::Operator') && $_->content eq '->' } $statement->children;
576
            return 0 unless grep { $_->isa('PPI::Token::Word') && $_->content eq 'get' } $statement->children;
577
578
578
            return 1;
579
                return 0 unless $element->snext_sibling
579
        });
580
                    && $element->snext_sibling->snext_sibling
581
                    && $element->snext_sibling->snext_sibling->isa('PPI::Structure::Constructor');
580
582
581
        next unless $nodes;
583
                # Check that it's indeed a call to $stash->get()
584
                my $statement = $element->statement->parent->statement->parent->statement;
585
                return 0 unless grep { $_->isa('PPI::Token::Symbol') && $_->content eq '$stash' } $statement->children;
586
                return 0 unless grep { $_->isa('PPI::Token::Operator') && $_->content eq '->' } $statement->children;
587
                return 0 unless grep { $_->isa('PPI::Token::Word') && $_->content eq 'get' } $statement->children;
582
588
583
        # Write the Perl equivalent of calls to t* functions family, so xgettext
589
                return 1;
584
        # can extract the strings correctly
590
            });
585
        make_path(dirname("$tempdir/$file"));
591
586
        open my $fh, '>', "$tempdir/$file";
592
            next unless $nodes;
587
593
588
        foreach my $node (@$nodes) {
594
            # Write the Perl equivalent of calls to t* functions family, so
589
            my @args = map {
595
            # xgettext can extract the strings correctly
590
                $_->significant && !$_->isa('PPI::Token::Operator') ? $_->content : ()
596
            foreach my $node (@$nodes) {
591
            } $node->snext_sibling->snext_sibling->find_first('PPI::Statement')->children;
597
                my @args = map {
598
                    $_->significant && !$_->isa('PPI::Token::Operator') ? $_->content : ()
599
                } $node->snext_sibling->snext_sibling->find_first('PPI::Statement')->children;
592
600
593
            my $keyword = $node->content;
601
                my $keyword = $node->content;
594
            $keyword =~ s/^'t(.*)'$/__$1/;
602
                $keyword =~ s/^'t(.*)'$/__$1/;
603
604
                say $fh "$keyword(" . join(', ', @args) . ");";
605
            }
595
606
596
            say $fh "$keyword(" . join(', ', @args) . ");";
597
        }
607
        }
598
608
599
        close $fh;
609
        close $fh;
600
- 

Return to bug 15395