File Coverage

blib/lib/Locale/Maketext/Extract/Plugin/XSL.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package Locale::Maketext::Extract::Plugin::XSL;

use warnings;
use strict;

use base qw(Locale::Maketext::Extract::Plugin::Base);
use Carp qw(croak);
use Regexp::Common;
use XML::LibXML;
use XML::LibXML::XPathContext;

=head1 NAME

Locale::Maketext::Extract::Plugin::XSL - XSL file parser

=head1 VERSION

Version 0.4

=cut

our $VERSION = '0.4';

=head1 SYNOPSIS

    my $ext = Locale::Maketext::Extract->new(
                plugins => {'Locale::Maketext::Extract::Plugin::XSL' => '*'} );
    $ext->extract_file('test.xsl');
    $ext->compile();

    or perhaps more convenient:

    xgettext.pl -P Locale::Maketext::Extract::Plugin::XSL


=head1 DESCRIPTION

Extracts strings to localise from XSL stylesheet files.

Using Perl, custom localisation functions may be registered using
L->register_function().

=head1 KNOWN FILE TYPES

=over 4

=item .xsl

=item .xslt

=back

=head1 VALID FORMATS

This plugin will check for localisation functions in all attribute values of the XSL document.
Valid localisation function names are:

=over 4

=item loc

=item locfrag

=item l

=item lfrag

=back

Note that only the local-name for the function will be checked for. Namespace prefixes
will be ignored. I.e.  and
 will be treated the same.

=head1 FUNCTIONS

=head2 file_types

File types this plugin should handle

=cut
sub file_types {
    return qw( xsl xslt );
}


=head2 extract

Extraction function. Parses XSL document and adds localisation entries

=cut
sub extract {
    my ($self,$filecontent) = @_;

    my $parser = XML::LibXML->new();
    $parser->load_ext_dtd(0);

    my $doc;
    eval {
        $doc = $parser->parse_string( $filecontent );
    };
    if ( $@ ) {
        croak( "Could not parse input string: $@\n" );
    }

    my $xc = XML::LibXML::XPathContext->new($doc);
    $xc->registerNs('xsl', 'http://www.w3.org/1999/XSL/Transform');
    my @nodes = $xc->findnodes('//@*[contains(.,":loc(") or contains(.,":l(") or contains(.,":locfrag(") or contains(.,":lfrag(")]');
    foreach my $node (@nodes) {
        $self->_parse_expression( $node->value() );
    }

    return;
}

=head2 _parse_expression

Extract loc functions from XPATH expressions

=cut
sub _parse_expression {
    my ($self, $value) = @_;

    while (
            $value =~ /$RE{balanced}{-begin => ':loc|:locfrag|:l|:lfrag'}{-keep}/gx
           ) {
        my $str = substr($1,1,length($1)-2); # remove wrapping parens

        # $Re{balanced} will match the outermost parens only, -begin does not work
        # as (I) expected, so...
        # If the expression includes more than one loc function, recurse
        if (
            $str =~ /\:l(?:oc)?(?:frag)?\(/x
           ) {
            $self->_parse_expression( $str );
        }
        else {
            my @data;
            while ($str =~ /$RE{quoted}{-keep}/gx ) {
                push @data, substr($1,1,length($1)-2); # remove wrapping quotes
            }
            $self->add_entry(shift @data,  undef, join(',', @data));
        }
    }

    return 1;
}

=head1 SEE ALSO

=over 4

=item L

for extracting translatable strings from common template
systems and perl source files.

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=back


=head1 AUTHOR

Michael Kroell, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Locale::Maketext::Extract::Plugin::XSL


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 COPYRIGHT

Copyright 2008-2011 Michael Kroell, all rights reserved.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

1; # End of Locale::Maketext::Extract::Plugin::XSL