File Coverage

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

Criterion	Covered	Total	%
statement	74	83	89.1
branch	17	26	65.3
condition	7	9	77.7
subroutine	11	11	100.0
pod	2	2	100.0
total	111	131	84.7

package Locale::Maketext::Extract::Plugin::FormFu;
$Locale::Maketext::Extract::Plugin::FormFu::VERSION = '1.00';
use strict;
use base qw(Locale::Maketext::Extract::Plugin::Base);

# ABSTRACT: FormFu format parser


sub file_types {
    return qw( yaml yml conf );
}

sub extract {
    my $self = shift;
    my $data = shift;

    my $y = Locale::Maketext::Extract::Plugin::FormFu::Extractor->new();
    $y->load($data);

    foreach my $entry ( @{ $y->found } ) {
        $self->add_entry(@$entry);
    }

}

package Locale::Maketext::Extract::Plugin::FormFu::Extractor;
$Locale::Maketext::Extract::Plugin::FormFu::Extractor::VERSION = '1.00';
use base qw(YAML::Loader);

#===================================
sub new {
#===================================
    my $class = shift;
    my $self  = $class->SUPER::new(@_);
    $self->{found} = [];
    return $self;
}

#===================================
sub _check_key {
#===================================
    my $self = shift;
    my ( $key, $value, $line ) = @_;
    my ( $str, $vars );
    if ( ref $value ) {
        return if ref $value ne 'ARRAY';
        $str = shift @$value;
        $vars = join( ', ', @$value );
    }
    else {
        $str = $value;
    }
    return
           unless $key
        && $key =~ /_loc$/
        && defined $str;
    push @{ $self->{found} }, [ $str, $line, $vars ];
}

#===================================
sub _parse_mapping {
#===================================
    my $self     = shift;
    my ($anchor) = @_;
    my $mapping  = {};
    $self->anchor2node->{$anchor} = $mapping;
    my $key;
    while ( not $self->done
        and $self->indent == $self->offset->[ $self->level ] )
    {

        # If structured key:
        if ( $self->{content} =~ s/^\?\s*// ) {
            $self->preface( $self->content );
            $self->_parse_next_line(YAML::Loader::COLLECTION);
            $key = $self->_parse_node();
            $key = "$key";
        }

        # If "default" key (equals sign)
        elsif ( $self->{content} =~ s/^\=\s*// ) {
            $key = YAML::Loader::VALUE;
        }

        # If "comment" key (slash slash)
        elsif ( $self->{content} =~ s/^\=\s*// ) {
            $key = YAML::Loader::COMMENT;
        }

        # Regular scalar key:
        else {
            $self->inline( $self->content );
            $key = $self->_parse_inline();
            $key = "$key";
            $self->content( $self->inline );
            $self->inline('');
        }

        unless ( $self->{content} =~ s/^:\s*// ) {
            $self->die('YAML_LOAD_ERR_BAD_MAP_ELEMENT');
        }
        $self->preface( $self->content );
        my $line = $self->line;
        $self->_parse_next_line(YAML::Loader::COLLECTION);
        my $value = $self->_parse_node();
        if ( exists $mapping->{$key} ) {
            $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY');
        }
        else {
            $mapping->{$key} = $value;
            $self->_check_key( $key, $value, $line );
        }
    }
    return $mapping;
}

#===================================
sub _parse_inline_mapping {
#===================================
    my $self       = shift;
    my ($anchor)   = @_;
    my $node       = {};
    my $start_line = $self->{_start_line};

    $self->anchor2node->{$anchor} = $node;

    $self->die('YAML_PARSE_ERR_INLINE_MAP')
        unless $self->{inline} =~ s/^\{\s*//;
    while ( not $self->{inline} =~ s/^\s*\}// ) {
        my $key = $self->_parse_inline();
        $self->die('YAML_PARSE_ERR_INLINE_MAP')
            unless $self->{inline} =~ s/^\: \s*//;
        my $value = $self->_parse_inline();
        if ( exists $node->{$key} ) {
            $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY');
        }
        else {
            $node->{$key} = $value;
            $self->_check_key( $key, $value, $start_line );
        }
        next if $self->inline =~ /^\s*\}/;
        $self->die('YAML_PARSE_ERR_INLINE_MAP')
            unless $self->{inline} =~ s/^\,\s*//;
    }
    return $node;
}

#===================================
sub _parse_next_line {
#===================================
    my $self = shift;
    $self->{_start_line} = $self->line;
    $self->SUPER::_parse_next_line(@_);
}

#===================================
sub found {
#===================================
    my $self = shift;
    return $self->{found};
}


1;

__END__