view release on metacpan or  search on metacpan

lib/Config/IOD/Document.pm  view on Meta::CPAN

}

sub dump {
    my $self = shift;
    my $opts;
    if (ref($_[0]) eq 'HASH') {
        $opts = shift;
    } else {
        $opts = {};
    }

    my $parser = $self->{_parser};

    my $linum = 0;
    my $merge;
    my $cur_section = $parser->{default_section};
    my $res = {};
    my $arrayified = {};
    my $num_seen_section_lines = 0;

    my $_merge = sub {
        return if $cur_section eq $merge;
        die "IOD document:$linum: Can't merge section '$merge' to ".
            "'$cur_section': Section '$merge' not seen yet"
                unless exists $res->{$merge};
        for my $k (keys %{ $res->{$merge} }) {
            $res->{$cur_section}{$k} //= $res->{$merge}{$k};
        }
    };

    # TMP HACK. for _decode_expr, this is currently rather hackish because
    # Config::IOD::Base expects some state in $parser
    local $parser->{_res} = $res if $parser->{enable_expr};
    local $parser->{_cur_section} = $cur_section if $parser->{enable_expr};

    for my $line (@{ $self->{_parsed} }) {
        $linum++;
        next if defined($opts->{linum_start}) && $linum < $opts->{linum_start};
        next if defined($opts->{linum_end}  ) && $linum > $opts->{linum_end};

        my $type = $line->[COL_TYPE];
        if ($type eq 'D') {
            my $directive = $line->[COL_D_DIRECTIVE];
            if ($directive eq 'merge') {
                my $args = $parser->_parse_command_line(
                    $line->[COL_D_ARGS_RAW]);
                if (!defined($args)) {
                    die "IOD document:$linum: Invalid arguments syntax '".
                        $line->[COL_D_ARGS_RAW]."'";
                }
                $merge = @$args ? $args->[0] : undef;
            } # ignore the other directives
        } elsif ($type eq 'S') {
            $num_seen_section_lines++;
            # merge previous section
            $_merge->() if defined($merge) && $num_seen_section_lines > 1;
            $cur_section = $line->[COL_S_SECTION];
            $parser->{_cur_section} = $cur_section if $parser->{enable_expr}; #TMP HACK
            $res->{$cur_section} //= {};
        } elsif ($type eq 'K') {
            # the common case is that value are not decoded or
            # quoted/bracketed/braced, so we avoid calling _parse_raw_value here
            # to avoid overhead
            my $key = $line->[COL_K_KEY];
            my $val = $line->[COL_K_VALUE_RAW];
            if ($val =~ /\A["!\\[\{]/) {
                my ($err, $parse_res, $decoded_val) =
                    $parser->_parse_raw_value($val);
                die "IOD document:$linum: Invalid value: $err" if $err;
                $val = $decoded_val;
            } else {
                $val =~ s/\s*[#;].*//; # strip comment
            }

            if (exists $res->{$cur_section}{$key}) {
                if (!$parser->{allow_duplicate_key}) {
                    die "IOD document:$linum: Duplicate key: $key ".
                        "(section $cur_section)";
                } elsif ($arrayified->{$cur_section}{$key}++) {
                    push @{ $res->{$cur_section}{$key} }, $val;
                } else {
                    $res->{$cur_section}{$key} = [
                        $res->{$cur_section}{$key}, $val];
                }
            } else {
                $res->{$cur_section}{$key} = $val;
            }
        } # ignore the other line types
    }

    $_merge->() if defined($merge) && $num_seen_section_lines > 1;;

    $res;
}

sub each_key {
    my $self = shift;
    my $opts;
    if (ref($_[0]) eq 'HASH') {
        $opts = shift;
    } else {
        $opts = {};
    }
    my ($code) = @_;

    my $parser = $self->{_parser};

    my $linum = 0;
    my $cur_section = $parser->{default_section};

    my $skip_section;
    my %seen_sections;
    my %seen_keys;
    for my $line (@{ $self->{_parsed} }) {
        $linum++;
        next if defined($opts->{linum_start}) && $linum < $opts->{linum_start};
        next if defined($opts->{linum_end}  ) && $linum > $opts->{linum_end};

        my $type = $line->[COL_TYPE];
        if ($type eq 'S') {
            $cur_section = $line->[COL_S_SECTION];
            %seen_keys = ();
            $skip_section = $opts->{unique_section} &&
                $seen_sections{$cur_section}++;
        } elsif ($type eq 'K') {
            next if $skip_section;
            my $key = $line->[COL_K_KEY];
            next if $opts->{unique_key} && $seen_keys{$key}++;
            my $res = $code->(
                $self,

lib/Config/IOD/Document.pm  view on Meta::CPAN

 # insert at the top of section, instead of at the bottom
 $doc->insert_key({top=>1}, 'section', 'key', 'value');

 # insert at specific location (line number)
 $doc->insert_key({linum=>12}, 'section', 'name', 'value');

Delete a section (and all keys under it):

 $doc->delete_section('name');

 # delete all occurrences instead of just the first one
 $doc->delete_section({all=>1}, 'name');

Delete a key:

 $doc->delete_key('section', 'key');

 # delete all occurrences instead of just the first one
 $doc->delete_key({all=>1}, 'section', 'key');

Empty document:

 $doc->empty;

Dump object as IOD document string:

 print $doc->as_string;

 # or just:
 print $doc;

=head1 ATTRIBUTES

=head1 METHODS

=head2 new(%attrs) => obj

=head2 $doc->as_string => str

Return document object rendered as string. Automatically used for
stringification.

=head2 $doc->delete_key([\%opts, ]$section, $name) => $num_deleted

Delete key named C<$name> in section named C<$section>.

Options:

=over

=item * all => bool

If set to 1, then will delete all occurrences. By default only delete the first
occurrence.

=item * cond => code

Will only delete key if C<cond> returns true. C<cond> will be called with C<<
($self, %args) >> where the hash will contain these keys: C<linum> (int, line
number), C<parsed> (array, parsed line), C<key> (string, key name), C<value>
(NOT YET IMPLEMENTED), C<raw_value> (str, raw/undecoded value).

=back

=head2 $doc->delete_section([\%opts, ]$section) => $num_deleted

Delete section named C<$section>.

Options:

=over

=item * all => bool

If set to 1, then will delete all occurrences. By default only delete the first
occurrence.

=item * cond => code

Will only delete section if C<cond> returns true. C<cond> will be called with
C<< ($self, %args) >> where the hash will contain these keys: C<linum_start>
(int, starting line number), C<linum_end> (int, ending line number).

=back

=head2 $doc->dump([ \%opts ]) => hoh

Return a hoh (hash of section names and hashes, where each of the second-level
hash is of keys and values), Values will be decoded and merging will be done,
but includes are not processed (even though C<include> directive is active).

Options:

=over

=item * linum_start => int

Only dump beginning from this line number.

=item * linum_end => int

Only dump until this line number.

=back

=head2 $doc->each_key([ \%opts , ] $code) => LIST

Execute C<$code> for each key found in document, in order of occurrence.
C<$code> will be called with arguments C<< ($self, %args) >> where C<%args> will
contain these keys: C<section> (str, current section name), C<key> (str, key
name), C<value> (any, value, NOT YET IMPLEMENTED/AVAILABLE), C<raw_value> (str,
raw/undecoded value), C<linum> (int, line number, 1-based), C<parsed> (array,
parsed line).

Options:

=over

=item * linum_start => int

Only dump beginning from this line number.

=item * linum_end => int

Only dump until this line number.

=item * unique_section => bool

If set to 1, will only list the first occurence of each section.

=item * unique_key => bool

If set to 1, will only list the first occurence of each key in the same section.

=item * early_exit => bool

If set to 1, then if coderef returns false will return early immediately and not
continue to the next key.

=back

=head2 $doc->each_section([ \%opts , ] $code) => LIST

Execute C<$code> for each section found in document, in order of occurrence.
C<$code> will be called with arguments C<< ($self, %args) >> where C<%args> will
contain these keys: C<section> (str, section name), C<linum> (int, line number,
1-based), C<linum_start> (the same as C<linum>), C<linum_end> (int, line number
of the last line of the section), C<parsed> (array, parsed line).

Options:

=over

=item * unique => bool

If set to 1, will only list the first occurence of each section.

=item * early_exit => bool

If set to 1, then if coderef returns false will return early immediately and not
continue to the next section.

=back

=head2 $doc->empty()

Empty document.

=head2 $doc->get_directive_before_key($section, $key) => array

Find directive right before a key. Directive must directly precede key line
without any blank line, e.g.:

 ;!lint_prereqs assume-used "undetected, used via Riap"
 App::MyApp=0

If found, will return an arrayref containing directive name and arguments.
Otherwise, will return undef.

=head2 $doc->get_value($section, $key) => $value

Get value. Values are decoded and section merging is respected, but includes are
not processed.

Internally, will do a C<dump()> and cache the result so subsequent
C<get_value()> will avoid re-parsing the whole document. (The cache will
automatically be discarded is one of document-modifying methods like
C<delete_section()> is called.)

=head2 $doc->insert_key([\%opts, ]$section, $key, $value) => int

Insert a key named C<$name> with value C<$value> under C<$section>. Return line
number where the key is inserted, or undef if nothing is inserted (e.g. when
C<ignore> option is set to true). Die on failure.

Options:

=over

=item * create_section => bool

If set to 1, will create section (at the end of document) if it doesn't exist.

=item * add => bool

If set to 1, will add another key if key with the same name already exists.
Conflicts with C<ignore> and <replace>.

=item * ignore => bool

If set to 1, will do nothing if key already exists. Conflicts with C<add> and
C<replace>.

=item * replace => bool

If set to 1, will delete (all) previous keys first. Conflicts with C<add> and
C<ignore>.

=item * top => bool

If set to 1, will insert at the top of section before other keys. By default
will add at the end of section.

=item * linum => posint

Optional. Insert at this specific line number. Line number must fall within
section. Ignores C<top>.

=back

=head2 $doc->insert_section([\%opts, ]$name) => int

Insert empty section named C<$name>. Return line number where the section is
inserted, or undef if nothing is inserted (e.g. when C<ignore> option is set to
true). Die on failure.

Options:

=over

=item * ignore => bool