package Template::Flute::Specification::Scoped;

use strict;
use warnings;

use Template::Flute::Specification;
use Config::Scoped;

=head1 NAME

Template::Flute::Specification::Scoped - Config::Scoped Specification Parser

=head1 SYNOPSIS

    $scoped = new Template::Flute::Specification::Scoped;

    $spec = $scoped->parse_file($specification_file);
    $spec = $scoped->parse($specification_text);

=head1 CONSTRUCTOR

=head2 new

Create a Template::Flute::Specification::Scoped object.

=cut

# Constructor

sub new {
	my ($class, $self);
	my (%params);

	$class = shift;
	%params = @_;

	$self = \%params;

	bless ($self, $class);
}

=head1 METHODS

=head2 parse [ STRING | SCALARREF ]

Parses text from STRING or SCALARREF and returns L<Template::Flute::Specification>
object in case of success.

=cut
	
sub parse {
	my ($self, $text) = @_;
	my ($scoped, $config);
	
	# create Config::Scoped parser and parse text
	$scoped = new Config::Scoped;

	if (ref($text) eq 'SCALAR') {
		$config = $scoped->parse(text => $$text);
	}
	else {
		$config = $scoped->parse(text => $text);
	}

	$self->{spec} = $self->create_specification($config);

	return $self->{spec};
}

=head2 parse_file FILENAME

Parses text from file FILENAME and returns L<Template::Flute::Specification>
object in case of success.

=cut

sub parse_file {
	my ($self, $file) = @_;
	my ($scoped, $config, $key, $value, %list);

	# create Config::Scoped parser and parse file
	$scoped = new Config::Scoped(file => $file);
	$config = $scoped->parse();

	$self->{spec} = $self->create_specification($config);

	return $self->{spec};
}

=head2 create_specification [ HASHREF ]

Takes a L<Config::Scoped> hash reference and returns a 
L<Template::Flute::Specification> object.  Mostly used for parse and 
parse_file methods.

=cut

sub create_specification {
	my ($self, $config) = @_;
	my ($spec, $scoped, $key, $value, %list, $encoding);

	# specification object
	$spec = new Template::Flute::Specification;

	if ($encoding = $config->{specification}->{encoding}) {
		$spec->encoding($encoding);
	}
	
	# lists
	while (($key, $value) = each %{$config->{list}}) {
		$value->{name} = $key;
		$list{$key} = $value;
	}

	# adding list tokens: params, separators, inputs and filters
	my ($list);

	for my $cname (qw/param input filter separator/) {
		while (($key, $value) = each %{$config->{$cname}}) {
			$list = delete $value->{list};
			$value->{name} = $key;
		
			if ($list) {
				if (exists $list{$list}) {
					push @{$list{$list}->{$cname}}, {%$value};
				}
				else {
					die "List missing for $cname $key.";
				}
			}
			else {
				die "No list assigned to $cname $key.";
			}
		}
	}

	# adding other tokens: values and i18n
	for my $cname (qw/value i18n/) {
		while (($key, $value) = each %{$config->{$cname}}) {
			$value->{name} = $key;

			if ($cname eq 'value') {
				$spec->value_add({value => $value});
			}
			elsif ($cname eq 'i18n') {
				$spec->i18n_add({i18n => $value});
			}
		}
	}

	while (($key, $value) = each %{$config->{list}}) {
		$spec->list_add({list => $value,
				 param => $value->{param},
				 separator => $value->{separator},
				 input => $value->{input},
				 filter => $value->{filter},
				});
	}

	return $spec;
}

=head2 error

Returns last error.

=cut

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

	if (@{$self->{errors}}) {
		return $self->{errors}->[0]->{error};
	}
}

sub _add_error {
	my ($self, @args) = @_;
	my (%error);

	%error = @args;
	
	unshift (@{$self->{errors}}, \%error);
}

=head1 AUTHOR

Stefan Hornburg (Racke), <racke@linuxia.de>

=head1 LICENSE AND COPYRIGHT

Copyright 2010-2013 Stefan Hornburg (Racke) <racke@linuxia.de>.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

1;