view release on metacpan or  search on metacpan

lib/DBD/PO/Text/PO.pm  view on Meta::CPAN

        [ qw( obsolete  -obsolete  obsolete  ) ],
        # plural only
        (
            $has_plural
            ? (
                [ qw( msgid_plural -msgid_plural msgid_plural ) ],
                                   # dummy       # dummy
                [ qw( msgstr_0     -msgstr_0     msgstr_0     ) ], # singular or zero
                [ qw( msgstr_1     -msgstr_1     msgstr_1     ) ], # plural   or singular
                [ qw( msgstr_2     -msgstr_2     msgstr_2     ) ], # plural
                [ qw( msgstr_3     -msgstr_3     msgstr_3     ) ], # plural
                [ qw( msgstr_4     -msgstr_4     msgstr_4     ) ], # plural
                [ qw( msgstr_5     -msgstr_5     msgstr_5     ) ], # plural
            )
            : ()
        ),
        # prevoius
        (
            $has_previous
            ? (
                [ qw( previous_msgctxt      -previous_msgctxt      previous_msgctxt      ) ],
                [ qw( previous_msgid        -previous_msgid        previous_msgid        ) ],
                [ qw( previous_msgid_plural -previous_msgid_plural previous_msgid_plural ) ],
            )
            : ()
        ),
        # format-flags
        (
            map { ## no critic (ComplexMappings)
                (my $col_name = $_) =~ tr{-}{_};
                                     # dummy
                ([ $col_name, "-$_", $_ ]);
            } $config->elements()
        ),
    );

    @COL_NAMES       = map {$_->[0]} @cols; # for SQL
    @COL_PARAMETERS  = map {$_->[1]} @cols; # for DBD::PO::Locale::PO->new(...)
    @COL_METHODS     = map {$_->[2]} @cols; # it is the method for the $po object

    return;
}
init();

my $dequote = sub {
    my $string = shift;

    return if $string eq 'NULL';
    if ($string =~ s{\A _Q_U_O_T_E_D_:}{}xms) {
        $string =~ s{\\\\}{\\}xmsg;
    }

    return $string;
};

my $array_from_anything = sub {
    my ($self, $anything) = @_;

    my @array = map { ## no critic (ComplexMappings)
        my $dequoted = $dequote->($_);
        split m{\Q$self->{separator}\E}xms, $dequoted;
    } ref $anything eq 'ARRAY'
      ? @{$anything}
      : defined $anything
        ? $anything
        : ();

    return \@array;
};

sub new { ## no critic (RequireArgUnpacking)
    my ($class, $options) = validate_pos(
        @_,
        {type => SCALAR},
        {type => HASHREF},
    );
    $options = validate_with(
        params => $options,
        spec   => {
            eol       => {type => SCALAR, default => $EOL_DEFAULT},
            separator => {type => SCALAR, default => $SEPARATOR_DEFAULT},
            charset   => {type => SCALAR | UNDEF, optional => 1},
        },
        called => "2nd parameter of new('$class', \$hash_ref)",
    );

    if ($options->{charset}) {
        $options->{encoding} = ":encoding($options->{charset})";
    }

    return bless $options, $class;
}

sub write_entry { ## no critic (ExcessComplexity)
    my ($self, $file_name, $file_handle, $col_ref) = @_;

    my %line;
    for my $index (0 .. $#COL_NAMES) {
        my $parameter = $COL_PARAMETERS[$index];
        my $values    = $array_from_anything->($self, $col_ref->[$index]);
        if ( ## no critic (CascadingIfElse)
            $parameter eq '-comment'
            || $parameter eq '-automatic'
            || $parameter eq '-reference'
        ) {
            if (@{$values}) {
                $line{$parameter} = join $self->{eol}, @{$values};
            }
        }
        elsif (
            $parameter eq '-obsolete'
            || $parameter eq '-fuzzy'
        ) {
            $line{$parameter} = $values->[0] ? 1 : 0;
        }
        elsif (
            my ($prefix) = $parameter =~ m{\A - ( [a-z-]+ ) -format \z}xms
        ) {
            my $flag = $values->[0];
            # translate:
            # perl_false => nothing set

lib/DBD/PO/Text/PO.pm  view on Meta::CPAN

            }
            else {
                if ($parameter eq '-msgid' && tell $file_handle) {
                    croak 'A line has to have a msgid';
                }
                elsif ($parameter eq '-msgstr' && ! tell $file_handle) {
                    croak 'A header has to have a msgstr';
                }
            }
        }
        ++$index;
    }
    my $line = DBD::PO::Locale::PO->new(
        eol      => $self->{eol},
        '-msgid' => q{},
        (
            exists $line{'-msgid_plural'}
            ? ('-msgstr_n' => { 0 => q{} })
            : ('-msgstr'   => q{})
        ),
        %line,
    )->dump();
    print {$file_handle} $line
        or croak "Print $file_name: $OS_ERROR";

    return $self;
}

sub read_entry {
    my ($self, $file_name, $file_handle) = @_;

    if (! defined $self->{line_number}) {
        $self->{line_number} = 0;
    }
    my $po = DBD::PO::Locale::PO->load_entry(
        $file_name,
        $file_handle,
        \$self->{line_number},
        $self->{eol},
    );
    # EOF
    if (! $po) {
        delete $self->{line_number};
        return [];
    }
    # run a line, it is a po object
    my @cols;
    my $index = 0;
    METHOD:
    for my $method (@COL_METHODS) {
        if ( ## no critic (CascadingIfElse)
            $method eq 'comment'
            || $method eq 'automatic'
            || $method eq 'reference'
        ) {
            my $comment = $po->$method();
            $cols[$index]
                = defined $comment
                  ? (
                      join  $self->{separator},
                      split m{\Q$self->{eol}\E}xms,
                      $comment
                  )
                  : q{};
        }
        elsif (
            $method eq 'obsolete'
            || $method eq 'fuzzy'
        ) {
            $cols[$index] = $po->$method() ? 1 : 0;
        }
        elsif ( $method =~ m{\A [a-z-]+ -format \z}xms) {
            my $flag = $po->format_flag($method);
            # translate:
            # undef => 0
            # 0     => -1
            # 1     => 1
            $cols[$index] = defined $flag
                            ? (
                                $flag ? 1 : -1 ## no critic (MagicNumbers)
                            )
                            : 0;
        }
        elsif (
            $method =~ m{
                \A (?:
                    msgstr
                    | (?: msg | previous_msg ) (?: ctxt | id | id_plural )
                ) \z
            }xms
        ) {
            my $data = $po->$method();
            if (! defined $data) {
                $data = q{};
            }
            $cols[$index]
                = join  $self->{separator},
                  split m{\\n}xms,
                        $data;
        }
        elsif ( my ($n) = $method =~ m{\A msgstr_ ( \d ) \z}xms ) {
            my $data = $po->msgstr_n();
            if ($data) {
                $data = $data->{$n};
            }
            if (! defined $data) {
                $data = q{};
            }
            $cols[$index]
                = join  $self->{separator},
                  split m{\\n}xms,
                        $data;
        }
        else {
            croak "Strange extract method $method";
        }
        ++$index;
    }

    return \@cols;
}

1;

__END__

=head1 NAME

DBD::PO::Text::PO - read or write a PO file entry by entry

$Id: PO.pm 412 2009-08-29 08:58:24Z steffenw $

$HeadURL: https://dbd-po.svn.sourceforge.net/svnroot/dbd-po/trunk/DBD-PO/lib/DBD/PO/Text/PO.pm $

=head1 VERSION

2.08

=head1 SYNOPSIS

=head2 write

    use strict;
    use warnings;

    use Carp qw(croak);
    use English qw(-no_match_vars $OS_ERROR);
    require IO::File;
    require DBD::PO::Text::PO;

    my $file_handle = IO::File->new();
    $file_handle->open(
        $file_name,
        '> :encoding(utf-8)',
    ) or croak "Can not open file $file_name: $OS_ERROR;
    my $text_po = DBD::PO::Text::PO->new({
        eol     => "\n",
        charset => 'utf-8',
    });

    # header
    $text_po->write_entry(
        $file_name,
        $file_handle,
        [
            q{},
            'Content-Type: text/plain; charset=utf-8',
        ],
    );

    # line