view release on metacpan or  search on metacpan

Array.pm  view on Meta::CPAN

package Config::Dot::Array;

use strict;
use warnings;

use Class::Utils qw(set_params);
use Config::Utils qw(hash_array);
use English qw(-no_match_vars);
use Error::Pure qw(err);
use Readonly;

Readonly::Scalar my $EMPTY_STR => q{};

our $VERSION = 0.08;

# Constructor.
sub new {
	my ($class, @params) = @_;
	my $self = bless {}, $class;

	# Callback.
	$self->{'callback'} = undef;

	# Config hash.
	$self->{'config'} = {};

	# Set conflicts detection as error.
	$self->{'set_conflicts'} = 1;

	# Process params.
	set_params($self, @params);

	# Check config hash.
	if (! $self->_check($self->{'config'})) {
		err 'Bad \'config\' parameter.';
	}

	# Check callback.
	if (defined $self->{'callback'} && ref $self->{'callback'} ne 'CODE') {
		err 'Parameter \'callback\' isn\'t code reference.';
	}

	# Count of lines.
	$self->{'count'} = 0;

	# Stack.
	$self->{'stack'} = [];

	# Object.
	return $self;
}

# Parse text or array of texts.
sub parse {
	my ($self, $string_or_array_ref) = @_;
	my @text;
	if (ref $string_or_array_ref eq 'ARRAY') {
		@text = @{$string_or_array_ref};
	} else {
		@text = split m/$INPUT_RECORD_SEPARATOR/ms,
			$string_or_array_ref;
	}
	foreach my $line (@text) {
		$self->{'count'}++;
		$self->_parse($line);
	}
	return $self->{'config'};
}

# Reset content.
sub reset {
	my $self = shift;
	$self->{'config'} = {};
	$self->{'count'} = 0;
	return;
}

# Serialize.
sub serialize {
	my $self = shift;
	return join "\n", $self->_serialize($self->{'config'});
}

# Check structure.
sub _check {
	my ($self, $config_ref) = @_;
	if (ref $config_ref eq 'HASH') {
		foreach my $key (sort keys %{$config_ref}) {
			if (ref $config_ref->{$key} ne ''
				&& ! $self->_check($config_ref->{$key})) {

				return 0;
			}
		}
		return 1;
	} elsif (ref $config_ref eq 'ARRAY') {
		foreach my $val (@{$config_ref}) {
			if (ref $val ne '' && ! $self->_check($val)) {
				return 0;
			}
		}
		return 1;
	} else {
		return 0;
	}
}

# Parse string.
sub _parse {
	my ($self, $string) = @_;

	# Remove comments on single line.
	$string =~ s/^\s*#.*$//ms;

	# Blank space.
	if ($string =~ m/^\s*$/ms) {
		return 0;
	}

	# Split.
	my ($key, $val) = split m/=/ms, $string, 2;

	# Not a key.
	if (length $key < 1) {
		return 0;
	}

	# Bad key.
	if ($key !~ m/^[-\w\.:,]+\+?$/ms) {
		err "Bad key '$key' in string '$string' at line ".
			"'$self->{'count'}'.";
	}

	my @tmp = split m/\./ms, $key;
	hash_array($self, \@tmp, $val);

	# Ok.
	return 1;
}

# Serialize.
sub _serialize {
	my ($self, $config_ref) = @_;
	if (ref $config_ref eq 'HASH') {
		my @ret;
		foreach my $key (sort keys %{$config_ref}) {
			my @subkey = $self->_serialize(
				$config_ref->{$key});
			foreach my $subkey (@subkey) {
				if ($subkey !~ m/^=/ms) {
					$subkey = '.'.$subkey;
				}
				push @ret, $key.$subkey;
			}
		}
		return @ret;
	} elsif (ref $config_ref eq 'ARRAY') {
		my @ret;
		foreach my $val (@{$config_ref}) {
			push @ret, $self->_serialize($val);
		}
		return @ret;
	} else {
		return '='.$config_ref;
	}
}

1;

__END__

=pod

=encoding utf8

=head1 NAME

Config::Dot::Array - Module for simple configure file parsing with arrays.

=head1 SYNOPSIS

 my $cnf = Config::Dot::Array->new(%params);

 my $struct_hr = $cnf->parse($string_or_array_ref);
 $cnf->reset;
 my $serialized = $cnf->serialize;

=head1 METHODS

=head2 C<new>

Constructor.

=over 8