File Coverage

/.cpan/build/Config-Abstract-0.16-7ag85k/blib/lib/Config/Abstract/Ini.pm

Criterion	Covered	Total	%
statement	15	61	24.5
branch	0	26	0.0
condition	0	12	0.0
subroutine	5	9	55.5
pod			n/a
total	20	108	18.5

package Config::Abstract::Ini;

use 5.006;
use strict;
use warnings;

require Exporter;
use Config::Abstract;

use overload qw{""} => \&_to_string;

our @ISA = qw(Config::Abstract Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw( );

our $VERSION = '0.16';

#
# ------------------------------------------------------------------------------------------------------- structural methods -----
#

# All inherited from Config::Abstract

#
# --------------------------------------------------------------------------------------------------------- accessor methods -----
#

# All inherited from Config::Abstract

#
# ------------------------------------------------------------------------------------------------ (un)serialisation methods -----
#

##################################################
#%name: _to_string
#%syntax: _to_string
#%summary: Recursively generates a string representation of the settings hash
#%returns: a string in .ini format

sub _to_string{
	my($self) = @_;
	return $self->_dumpobject('',$self->{_settings});
}

##################################################
#%name: _dumpobject
#%syntax: _dumpobject(<$objectcaption>,<$objectref>,[<@parentobjectcaptions>])
#%summary: Recursively generates a string representation of the object referenced
#          by $objectref
#%returns: a string representation of the object

sub _dumpobject{
	my($self,$name,$obj,@parents) = @_;
	my @result = ();
	if(ref($obj) eq 'HASH'){
		unless($name eq ''){
			push(@parents,"$name");
			push(@result,'[' . join('::',@parents) . ']');
		}
		while(my($key,$val) = each(%{$obj})){
			push(@result,$self->_dumpobject($key,$val,@parents));
		}
	}elsif(ref($obj) eq 'SCALAR'){
		push(@result,"$name = ${$obj}");
	}elsif(ref($obj) eq 'ARRAY'){
		push(@parents,"$name");
		push(@result,'[' . join('::',@parents) . ']');
		for(my $i = 0;scalar(@{$obj});$i++){
			push(@result,$self->_dumpobject($i,${$obj}[$i],@parents));
		}
	}else{
#		print("Why are we here? name: " . ( defined($name) ? $name : 'empty' ) . " obj:" . ( defined($obj) ? $obj : 'empty' ) . "\n");#DEBUG!!!
		push(@result,"$name = " . (defined($obj) ? $obj : '') ) unless(!defined($name));
	}
	return(join("\n",@result));
}


##################################################
#%name: _parse_settings_file
#%syntax: _parse_settings_file(<@settings>)
#%summary: Reads the projects to keep track of
#%returns: a hash of $projectkey:$projectlabel

sub _parse_settings_file{
	my %result = ();
	my ($entry,$subentry) = ('',undef);
	chomp(@_);
	foreach(@_){
		# Get rid of starting/ending whitespace
		s/^\s*(.*?)\s*$/$1/;

		#Delete comments
		($_) = split(/[;#]/,$_);
		#Skip if there's no data
		next if((! defined($_)) || $_ eq '');
		/^\s*(.*?)\s*=\s*(['"]|)(.*)\2\s*/ && do {
			my($key,$val) = ($1,$3);
			next if($key eq '' || $val eq '');
			if(! defined($subentry) || $subentry =~ /^\s*$/){
				${$result{$entry}}{$key} = $val;
			}else{
				${$result{$entry}}{$subentry}{$key} = $val;
			}
			next;
		};
		# Select a new entry if this is such a line
		/\[(.*?)\]/ && do{

			$_ = $1;
			($entry,$subentry) = split('::');
			if(! defined($subentry) || $subentry =~ /^\s*$/){
				$result{$entry} = {};
			}elsif($result{$entry}){
				$result{$entry}{$subentry} = {};
			}
			next;
		};
	}
	return(\%result);
}

# We provide a DESTROY method so that the autoloader
# doesn't bother trying to find it.
sub DESTROY { }

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__