view release on metacpan or  search on metacpan

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

    my @lines = split m{\Q$separator\E}xms, $msgstr;
    LINE:
    while (1) {
        my $line = shift @lines;
        defined $line
           or last LINE;
        # run the regex for the selected column
        my $index = 0;
        HEADER_REGEX:
        for my $header_regex (@HEADER_REGEX) {
            if (! $header_regex) {
                ++$index;
                next HEADER_REGEX;
            }
            my @result;
            # more regexes are necessary
            if (ref $header_regex eq 'ARRAY') {
                # run from special to more common regex
                INNER_REGEX:
                for my $inner_regex ( @{$header_regex} ) {
                    @result = $line =~ $inner_regex;
                    last INNER_REGEX if @result;
                }
            }
            # only 1 regex is necessary
            else {
                @result = $line =~ $header_regex;
            }
            # save the result to the selected column
            if (@result) {
                # some columns are multiline
                defined $cols[$index]
                ? (
                    ref $cols[$index] eq 'ARRAY'
                    ? push @{ $cols[$index] }, @result
                    : do {
                        $cols[$index] = [ $cols[$index], @result ];
                    }
                )
                : (
                    $cols[$index] = @result > 1
                                    ? \@result
                                    : $result[0]
                );
                next LINE;
            }
            ++$index;
        }
    }

    return \@cols;
}

sub get_header_msgstr_data { ## no critic (ArgUnpacking)
    my ($dbh, $anything, $key) = validate_pos(
        @_,
        {isa  => 'DBI::db'},
        {type => ARRAYREF | SCALAR | HASHREF},
        {
            type      => SCALAR | ARRAYREF,
            callbacks => {
                check_keys => sub {
                    my $check_key = shift;
                    if (ref $check_key eq 'ARRAY') {
                        return 1;
                    }
                    else {
                        return $check_key =~ $valid_keys_regex;
                    }
                },
            },
        },
    );

    my $array_ref = (ref $anything eq 'ARRAY')
                    ? $anything
                    : $dbh->func($anything, 'split_header_msgstr');

    if (ref $key eq 'ARRAY') {
        return [
            map {
                get_header_msgstr_data($dbh, $array_ref, $_);
            } @{$key}
        ];
    }

    my $index = $key eq 'extended'
                ? $index_extended
                : $hash2array{$key};
    if (ref $index eq 'ARRAY') {
        return $array_ref->[ $index->[0] ]->[ $index->[1] ];
    }

    return $array_ref->[$index];
}

1;

__END__

=head1 NAME

DBD::PO::db - database class for DBD::PO

$Id: db.pm 380 2009-05-02 07:05:20Z steffenw $

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

=head1 VERSION

2.05

=head1 SYNOPSIS

do not use

=head1 DESCRIPTION

database class for DBD::PO

=head1 SUBROUTINES/METHODS