File Coverage

blib/lib/Config/INI/Serializer.pm

Criterion	Covered	Total	%
statement	83	93	89.2
branch	43	66	65.1
condition	6	12	50.0
subroutine	10	10	100.0
pod	2	3	66.6
total	144	184	78.2

package Config::INI::Serializer;
BEGIN {
  $Config::INI::Serializer::AUTHORITY = 'cpan:SCHWIGON';
}
{
  $Config::INI::Serializer::VERSION = '0.001';
}

use strict;
use warnings;

# ABSTRACT: Round-trip INI serializer for nested data


# lightweight OO to the extreme, as we really don't need more
sub new {
        bless {}, shift;
}

# utility method, stolen from App::Reference, made internal here
sub _get_branch {
    my ($self, $branch_name, $create, $ref) = @_;
    my ($sub_branch_name, $branch_piece, $attrib, $type, $branch, $cache_ok);
    $ref = $self if (!defined $ref);

    # check the cache quickly and return the branch if found
    $cache_ok = (ref($ref) ne "ARRAY" && $ref eq $self); # only cache from $self
    $branch = $ref->{_branch}{$branch_name} if ($cache_ok);
    return ($branch) if (defined $branch);

    # not found, so we need to parse the $branch_name and walk the $ref tree
    $branch = $ref;
    $sub_branch_name = "";

    # these: "{field1}" "[3]" "field2." are all valid branch pieces
    while ($branch_name =~ s/^([\{\[]?)([^\.\[\]\{\}]+)([\.\]\}]?)//) {

        $branch_piece = $2;
        $type = $3;
        $sub_branch_name .= ($3 eq ".") ? "$1$2" : "$1$2$3";

        if (ref($branch) eq "ARRAY") {
            if (! defined $branch->[$branch_piece]) {
                if ($create) {
                    $branch->[$branch_piece] = ($type eq "]") ? [] : {};
                    $branch = $branch->[$branch_piece];
                    $ref->{_branch}{$sub_branch_name} = $branch if ($cache_ok);
                }
                else {
                    return(undef);
                }
            }
            else {
                $branch = $branch->[$branch_piece];
                $sub_branch_name .= "$1$2$3";   # accumulate the $sub_branch_name
            }
        }
        else {
            if (! defined $branch->{$branch_piece}) {
                if ($create) {
                    $branch->{$branch_piece} = ($type eq "]") ? [] : {};
                    $branch = $branch->{$branch_piece};
                    $ref->{_branch}{$sub_branch_name} = $branch if ($cache_ok);
                }
                else {
                    return(undef);
                }
            }
            else {
                $branch = $branch->{$branch_piece};
            }
        }
        $sub_branch_name .= $type if ($type eq ".");
    }
    return $branch;
}

# utility method, stolen from App::Reference, made internal here
sub _set {
    my ($self, $property_name, $property_value, $ref) = @_;
    #$ref = $self if (!defined $ref);

    my ($branch_name, $attrib, $type, $branch, $cache_ok);
    if ($property_name =~ /^(.*)([\.\{\[])([^\.\[\]\{\}]+)([\]\}]?)$/) {
        $branch_name = $1;
        $type = $2;
        $attrib = $3;
        $cache_ok = (ref($ref) ne "ARRAY" && $ref eq $self);
        $branch = $ref->{_branch}{$branch_name} if ($cache_ok);
        $branch = $self->_get_branch($1,1,$ref) if (!defined $branch);
    }
    else {
        $branch = $ref;
        $attrib = $property_name;
    }

    if (ref($branch) eq "ARRAY") {
        $branch->[$attrib] = $property_value;
    }
    else {
        $branch->{$attrib} = $property_value;
    }
}

# the serialize frontend method
sub serialize {
    my ($self, $data) = @_;
    $self->_serialize($data, "");
}

# recursive serialize method doing the actual work, internal
sub _serialize {
    my ($self, $data, $section) = @_;
    my ($section_data, $idx, $key, $elem);
    if (ref($data) eq "ARRAY") {
        for ($idx = 0; $idx <= $#$data; $idx++) {
            $elem = $data->[$idx];
            if (!ref($elem)) {
                $section_data .= "[$section]\n" if (!$section_data && $section);
                $section_data .= "$idx = $elem\n";
            }
        }
        for ($idx = 0; $idx <= $#$data; $idx++) {
            $elem = $data->[$idx];
            if (ref($elem)) {
                $section_data .= $self->_serialize($elem, $section ? "$section.$idx" : $idx);
            }
        }
    }
    elsif (ref($data)) {
        foreach $key (sort keys %$data) {
            $elem = $data->{$key};
            if (!ref($elem)) {
                no warnings 'uninitialized';
                $section_data .= "[$section]\n" if (!$section_data && $section);
                $section_data .= "$key = $elem\n";
            }
        }
        foreach $key (sort keys %$data) {
            $elem = $data->{$key};
            if (ref($elem)) {
                $section_data .= $self->_serialize($elem, $section ? "$section.$key" : $key);
            }
        }
    }

    return $section_data;
}

# the deserialize frontend method
sub deserialize {
    my ($self, $inidata) = @_;
    my ($data, $r, $line, $attrib_base, $attrib, $value);

    $data = {};

    $attrib_base = "";
    foreach $line (split(/\n/, $inidata)) {
        next if ($line =~ /^;/);  # ignore comments
        next if ($line =~ /^#/);  # ignore comments
        if ($line =~ /^\[([^\[\]]+)\] *$/) {  # i.e. [Repository.default]
            $attrib_base = $1;
        }
        if ($line =~ /^ *([^ =]+) *= *(.*)$/) {
            $attrib = $attrib_base ? "$attrib_base.$1" : $1;
            $value = $2;
            $self->_set($attrib, $value, $data);
        }
    }
    return $data;
}

# END of stolen ::App::Serialize::Ini

1;

__END__