File Coverage

blib/lib/GeNUScreen/Config.pm

Criterion	Covered	Total	%
statement	50	51	98.0
branch	10	12	83.3
condition			n/a
subroutine	11	11	100.0
pod	4	5	80.0
total	75	79	94.9

# vim: set ts=4 sw=4 tw=78 et si:
#
package GeNUScreen::Config;

use warnings;
use strict;
use Carp;
use GeNUScreen::Config::Diff;

use version; our $VERSION = qv('0.0.10');

my $re_cfgval  = qr/\S.*/;
my $re_cfgvar  = qr/[0-9a-z_]+/i;
my $re_cfgpath = qr/$re_cfgvar(?:\.$re_cfgvar)*/;
my $re_marker  = qr/[a-z]+/i;

use Class::Std;
{
    # storage for attributes
    my %cfg : ATTR;

    sub BUILD {
        my ($self, $ident, $args_ref) = @_;

        $cfg{$ident} = {}; # nothing more for now
    } # BUILD()

    sub read_config {
        my ($self,$filename) = @_;

        my %gs_cfg;
        my $prefix = '';

        open my $fh, '<', $filename
            or croak("Could not open $filename for reading");

        while (<$fh>) {
            chomp;
            if (/^\s*($re_cfgpath)\s*=\s*($re_cfgval)?$/) {
                $gs_cfg{$prefix . $1} = $2;
            }
            elsif (/^\s*($re_cfgpath)\s*<<\s*($re_marker)$/) {
                my $cfgpath = $1;
                my $marker = $2;
                my $cfgval = '';
                while (<$fh>) {
                    last if (/^$marker$/);
                    $cfgval .= $_;
                }
                $gs_cfg{$prefix . $cfgpath} = $cfgval;
            }
            elsif (/^\s*($re_cfgvar)\s*\{\s*$/) {
                $prefix .= $1 . ".";
            }
            elsif (/^\s*\}\s*$/) {
                my @path_elements = split /[.]/, $prefix;
                $#path_elements--;
                $prefix = join('.', @path_elements) . '.';
            }
            else {
                croak("read_config could not parse"
                      . " line $. in file $filename: '$_'");
            }
        }
        $cfg{ident $self} = \%gs_cfg;
        close $fh;
    } # read_config()

    sub get_keys {
        my ($self) = @_;

        return keys %{$cfg{ident $self}};
    } # get_keys()

    sub get_value {
        my ($self,$key) = @_;

        return $cfg{ident $self}->{$key};
    } # get_value()

    sub diff {
        my ($self,$thatcfg) = @_;

        my $diff = GeNUScreen::Config::Diff->new();

        $diff->compare($self,$thatcfg);
        return $diff;
    } # diff()

} # package GeNUScreen::Config

1; # Magic true value required at end of module
__END__