Config-Record

 view release on metacpan or  search on metacpan

Config-Record.spec  view on Meta::CPAN

# Automatically generated by Config-Record.spec.PL

%define appname Config-Record

# This macro is used for the continuous automated builds. It just
# allows an extra fragment based on the timestamp to be appended
# to the release. This distinguishes automated builds, from formal
# Fedora RPM builds
%define _extra_release %{?dist:%{dist}}%{?extra_release:%{extra_release}}


Summary: Config::Record - Simple configuration records
Name: perl-%{appname}
Version: 1.1.2
Release: 1%{_extra_release}
License: GPLv2+

Config-Record.spec.PL  view on Meta::CPAN

open SPEC, ">$ARGV[0]" or die "$!";
print SPEC $_;
close SPEC;
__DATA__
# Automatically generated by Config-Record.spec.PL

%define appname Config-Record

# This macro is used for the continuous automated builds. It just
# allows an extra fragment based on the timestamp to be appended
# to the release. This distinguishes automated builds, from formal
# Fedora RPM builds
%define _extra_release %{?dist:%{dist}}%{?extra_release:%{extra_release}}


Summary: Config::Record - Simple configuration records
Name: perl-%{appname}
Version: @VERSION@
Release: 1%{_extra_release}
License: GPLv2+

lib/Config/Record.pm  view on Meta::CPAN

    warn "Key: '" . $key . "'\n" if $self->{debug};
    foreach (split /((?<!\\)\/)/, $key) {
	next if m,^/$,;
	warn "  -> '" . $_ . "'\n" if $self->{debug};
	push @key, $_;
    }

    my $entry = $self->{record};
    my $context;
    foreach my $fragment (@key) {
	$context = defined $context ? $context . "/" . $fragment : $fragment;
	
	if ($fragment =~ /^\[(\d+)\]$/) {
	    my $index = $1;
	    if (ref($entry) ne "ARRAY") {
		if (@_) {
		    return shift;
		}
		confess "cannot find array value at '$context' for parameter '$key'";
	    }
	    if ($#{$entry} < $index) {
		if (@_) {
		    return shift;
		}
		confess "cannot find array value at '$context' for parameter '$key'";
	    }
	    $entry = $entry->[$index];
	} elsif ($self->{features}->{quotedkeys}) {
	    $fragment =~ s/\\(\[|\]|\/|\\)/$1/g;
	    warn "Quote '$fragment'\n" if $self->{debug};
	    if (ref($entry) ne "HASH") {
		if (@_) {
		    return shift;
		}
		confess "cannot find hash value at '$context' for parameter '$key'";
	    }
	    if (!exists $entry->{$fragment}) {
		if (@_) {
		    return shift;
		}
		confess "cannot find hash value at '$context' for parameter '$key'";
	    }
	    $entry = $entry->{$fragment};
	} else {
	    warn "NonQuote '$fragment'\n" if $self->{debug};
	    if ($fragment =~ /((?:\w|-|\.)+)/) {
		if (ref($entry) ne "HASH") {
		    if (@_) {
			return shift;
		    }
		    confess "cannot find hash value at '$context' for parameter '$key'";
		}
		if (!exists $entry->{$fragment}) {
		    if (@_) {
			return shift;
		    }
		    confess "cannot find hash value at '$context' for parameter '$key'";
		}
		$entry = $entry->{$fragment};
	    } else {
		confess "fragment '$fragment' should be alphanumeric, or an array index";
	    }
	}
    }
    
    return $entry;
}


sub set {
    my $self = shift;

lib/Config/Record.pm  view on Meta::CPAN

    warn "Key: '" . $key . "'\n" if $self->{debug};
    foreach (split /((?<!\\)\/)/, $key) {
	next if m,^/$,;
	warn "  -> '" . $_ . "'\n" if $self->{debug};
	push @key, $_;
    }


    my $entry = $self->{record};
    my $context;
    while (defined (my $fragment = shift @key)) {
	$context = defined $context ? $context . "/" . $fragment : $fragment;
	
	if ($fragment =~ /^\[(\d+)\]$/) {
	    my $index = $1;
	    if (ref($entry) ne "ARRAY") {
		confess "cannot find array value at $context for parameter $key";
	    }
	    if (@key) {
		if (exists $entry->[$index]) {
		    $entry = $entry->[$index];
		} else {
		    if ($key[0] =~ /^\[(\d+)\]$/) {
			$entry->[$index] = [];
		    } else {
			$entry->[$index] = {};
		    }
		    $entry = $entry->[$index];
		}
	    } else {
		$entry->[$index] = $value;
	    }
	} elsif ($self->{features}->{quotedkeys}) {
	    $fragment =~ s/\\(\[|\]|\/|\\)/$1/g;
	    warn "Quote '$fragment'\n" if $self->{debug};
	    if (ref($entry) ne "HASH") {
		confess "cannot find hash value at $context for parameter $key";
	    }
	    if (@key) {
		if (exists $entry->{$fragment}) {
		    $entry = $entry->{$fragment};
		} else {
		    if ($key[0] =~ /^\[(\d+)\]$/) {
			$entry->{$fragment} = [];
		    } else {
			$entry->{$fragment} = {};
		    }
		    $entry = $entry->[$fragment];
		}
	    } else {
		$entry->{$fragment} = $value;
	    }
	} else {
	    warn "NonQuote '$fragment'\n" if $self->{debug};
	    if ($fragment =~ /((?:\w|-|\.)+)/) {
		if (ref($entry) ne "HASH") {
		    confess "cannot find hash value at $context for parameter $key";
		}
		if (@key) {
		    if (exists $entry->{$fragment}) {
			$entry = $entry->{$fragment};
		    } else {
			if ($key[0] =~ /^\[(\d+)\]$/) {
			    $entry->{$fragment} = [];
			} else {
			    $entry->{$fragment} = {};
			}
			$entry = $entry->[$fragment];
		    }
		} else {
		    $entry->{$fragment} = $value;
		}
	    } else {
		confess "fragment '$fragment' should be alphanumeric, or an array index";
	    }
	}
    }
}


sub record {
    my $self = shift;
    
    return $self->{record};