view release on metacpan or  search on metacpan

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

    }
    if ( defined $self->reference() ) {
        $dump .= $self->_dump_multi_comment( $self->reference(), '#: ' );
    }
    my $flags = join q{}, map {", $_"} sort keys %{ $self->_flags() };
    if ($flags) {
        $dump .= "#$flags"
                 . $self->eol();
    }
    if ( defined $self->previous_msgctxt() ) {
        $dump .= '#| msgctxt '
                 . $self->quote( $self->previous_msgctxt() );
    }
    if ( defined $self->previous_msgid() ) {
        $dump .= '#| msgid '
                 . $self->quote( $self->previous_msgid() );
    }
    if ( defined $self->previous_msgid_plural() ) {
        $dump .= '#| msgid_plural '
                 . $self->quote( $self->previous_msgid_plural() );
    }
    if ( defined $self->msgctxt() ) {
        $dump .= "${obsolete}msgctxt "
                 . $self->quote( $self->msgctxt() );
    }
    $dump .= "${obsolete}msgid "
             . $self->quote( $self->msgid() );
    if ( defined $self->msgid_plural() ) {
        $dump .= "${obsolete}msgid_plural "
                 . $self->quote( $self->msgid_plural() );
    }
    if ( defined $self->msgstr() ) {
        $dump .= "${obsolete}msgstr "
                 . $self->quote( $self->msgstr() );
    }
    if ( my $msgstr_n = $self->msgstr_n() ) {
        $dump .= join
            q{},
            map {
                "${obsolete}msgstr[$_] "
                . $self->quote( $msgstr_n->{$_} );
            } sort {
                $a <=> $b
            } keys %{$msgstr_n};
    }

    $dump .= $self->eol();

    return $dump;
}

sub _dump_multi_comment {
    my $self    = shift;
    my $comment = shift;
    my $leader  = shift;

    my $eol = $self->eol();

    return join q{}, map {
        "$leader$_$eol";
    } split m{\Q$eol\E}xms, $comment;
}

# Quote a string properly
sub quote {
    my $self   = shift;
    my $string = shift;

    if (! defined $string) {
        return q{""};
    }
    my %named = (
        ## no critic (InterpolationOfLiterals)
        #qq{\a} => qq{\\a}, # BEL
        #qq{\b} => qq{\\b}, # BS
        #qq{\t} => qq{\\t}, # TAB
        qq{\n}  => qq{\\n}, # LF
        #qq{\f} => qq{\\f}, # FF
        #qq{\r} => qq{\\r}, # CR
        qq{"}   => qq{\\"},
        qq{\\}  => qq{\\\\},
        ## use critic (InterpolationOfLiterals)
    );
    $string =~ s{
        ( [^ !#$%&'()*+,\-.\/0-9:;<=>?@A-Z\[\]\^_`a-z{|}~] )
    }{
        ord $1 < 0x80
        ? (
            exists $named{$1}
            ? $named{$1}
            : sprintf '\x%02x', ord $1
        )
        : $1;
    }xmsge;
    $string = qq{"$string"};
    # multiline
    my $eol = $self->eol();
    if ($string =~ s{\A ( " .*? \\n )}{""$eol$1}xms) {
        $string =~ s{\\n}{\\n"$eol"}xmsg;
    }

    return "$string$eol";
}

sub dequote {
    my $self   = shift;
    my $string = shift;
    my $eol    = shift || $self->eol();

    if (! defined $string) {
        $string = q{};
    }
    # multiline
    if ($string =~ s{\A "" \Q$eol\E}{}xms) {
        $string =~ s{\\n"\Q$eol\E"}{\\n}xmsg;
    }
    $string =~ s{( [\$\@] )}{\\$1}xmsg; # make uncritical
    ($string) = $string =~ m{
        \A
        (
            "

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

            && $last_line_of_section{ $current_section_key }
               != ${$line_number_ref} - 1
        ) {
            # roll back
            ${$line_number_ref} = $current_line_number;
            seek $file_handle, $current_pos, 0
                or croak "Can not seek file pointer of file $file_name: $OS_ERROR";
            return 1; # this is a new entry
        }
        $last_line_of_section{ $current_section_key } = ${$line_number_ref};
        return;
    };

    my $po;             # build an object during read an entry
    my %buffer;         # find the different msg...
    my $current_buffer; # to add lines
    LINE:
    while (my $line = <$file_handle>) {
        $line =~ s{\Q$eol\E \z}{}xms;
        my $line_number = ++${$line_number_ref};
        my ($obsolete, $key, $value);
        # Empty line. End of an entry.
        if ( $line =~ m{\A \s* \z}xms ) { ## no critic (CascadingIfElse)
            last LINE if $po;
        }
        # strings
        elsif (
            ($obsolete, $key, $value)
                = $line =~ m{\A ( \# ~ \s+ )? ( msgctxt | msgid | msgid_plural | msgstr ) \s+ (.*)}xms
        ) {
            last LINE if $is_new_entry->($key);
            $po ||= $class->new(eol => $eol, -loaded_line_number => $line_number);
            $buffer{$key} = $self->dequote($value, $eol);
            $current_buffer = \$buffer{$key};
            if ($obsolete) {
                $po->obsolete(1);
            }
        }
        # contined string
        elsif ( $line =~ m{\A (?: \# ~ \s+ )? "}xms ) {
            ${$current_buffer} .= $self->dequote($line, $eol);
            $last_line_of_section{ $current_section_key } = $line_number;
        }
        # translated string, plural
        elsif (
            ($obsolete, $key, $value)
                = $line =~  m{\A ( \# ~ \s+ )? msgstr \[ (\d+) \] \s+ (.*)}xms
        ) {
            last LINE if $is_new_entry->('msgstr_n');
            $buffer{msgstr_n}->{$key} = $self->dequote($value, $eol);
            $current_buffer = \$buffer{msgstr_n}->{$key};
            if ($obsolete) {
                $po->obsolete(1);
            }
        }
        # reference
        elsif ( ($value) = $line =~ m{\A \# : \s+ (.*)}xms ) {
            last LINE if $is_new_entry->('comment');
            $po ||= $class->new(eol => $eol, -loaded_line_number => $line_number);
            # maybe more in 1 line
            $value = join $eol, split m{\s+}xms, $value;
            $po->reference(
                defined $po->reference()
                ? $po->reference() . "$eol$value"
                : $value
            );
        }
        # flags
        elsif ( ($value) = $line =~ m{\A \# , \s+ (.*)}xms) {
            last LINE if $is_new_entry->('comment');
            $po ||= $class->new(eol => $eol, -loaded_line_number => $line_number);
            for my $flag ( split m{\s* , \s*}xms, $value ) {
                $po->add_flag($flag);
            }
        }
        # Translator comments
        elsif (
            $line =~ m{\A \# \s+ (.*)}xms
            || $line =~ m{\A \# ()\z}xms
        ) {
            $value = $1;
            last LINE if $is_new_entry->('comment');
            $po ||= $class->new(eol => $eol, -loaded_line_number => $line_number);
            $po->comment(
                defined $po->comment()
                ? $po->comment() . "$eol$value"
                : $value
            );
        }
        # Automatic comments
        elsif ( ($value) = $line =~ m{\A \# \. \s* (.*)}xms ) {
            last LINE if $is_new_entry->('comment');
            $po ||= $class->new(eol => $eol, -loaded_line_number => $line_number);
            $po->automatic(
                defined $po->automatic()
                ? $po->automatic() . "$eol$value"
                : $value
            );
        }
        # previous
        elsif (
            ($key, $value)
                = $line =~ m{\A \# \| \s+ ( msgctxt | msgid | msgid_plural ) \s+ (.*)}xms
        ) {
            last LINE if $is_new_entry->('comment');
            $po ||= $class->new(eol => $eol, -loaded_line_number => $line_number);
            $key = "previous_$key";
            $buffer{$key} = $self->dequote($value, $eol);
            $current_buffer = \$buffer{$key};
        }
        else {
            warn "Strange line at $file_name line $line_number: $line\n";
        }
        $safe_current_position->();
    }
    if ($po) {
        for my $key (qw(
            msgctxt msgid msgid_plural
            previous_msgctxt previous_msgid previous_msgid_plural
            msgstr msgstr_n
        )) {
            if ( defined $buffer{$key} ) {
                $po->$key( $buffer{$key} );
            }
        }
        return $po;
    }

    return; # no entry found
}

sub _hash_key_ok {