package Text::Wigwam::Config;

    use strict;
    use Text::Wigwam::Config::Class;
    no warnings;

    our $VERSION = '0.01';

## Constructors

    sub _new { return bless { cache => {}, classes => {} }, ref $_[0] || $_[0] }

    sub new {
        my( $pkg, %args ) = @_;
        my $conf = $pkg->_new;
        while( my( $class, $hash ) = each %args ){
            $class = lc $class;
            $conf->{classes}{$class} = Text::Wigwam::Config::Class->new($class);
            next unless ref($hash) eq 'HASH';
            $conf->{classes}{$class}->set( presets => $hash );
        }
        return $conf;
    }

    sub spawn {
        my $self = shift;
        my $child = $self->_new;
        $child->{classes}{$_} = $self->{classes}{$_}->spawn
          for keys %{$self->{classes}};
        return $child;
    }

 ## Sets user-specified parameters for one or more option classes.

    sub inherit {
        my( $self, %args ) = @_;
        while( my( $class, $hash ) = each %args ){
            $class = $self->_canonical($class) or next;
            next unless ref($hash) eq 'HASH';
            $self->{classes}{$class}->set( inherit => $hash );
        }
    }

 ## Generate option hashes

    sub crank {
        my $self = shift;
        return $self->_generate(@_);
    }

    sub cache {
        my( $self, $name, @args ) = @_;
        @args = ($name) unless scalar @args;
        return $self->{cache}{$name} ||= $self->_generate(@args);
    }

 ## Set attributes on a class or set of classes.

    sub exclude {
        my $self = shift;
        $self->{classes}{$_}->set_attrib( exclude => 1 )
          for $self->_canonical(@_);
    }

    sub concede {
        my $self = shift;
        $self->{classes}{$_}->set_attrib( concede => 1 )
          for $self->_canonical(@_);
    }

    sub confine {
        my $self = shift;
        $self->{classes}{$_}->set_attrib( confine => 1 )
          for $self->_canonical(@_);
    }

    sub promote {
        my $self = shift;
        $self->{classes}{$_}->set_attrib( promote => 1 )
          for $self->_canonical(@_);
    }

 ## Find a config tag, store its parameters into instance data within the
 ## corresponding class,then remove the tag and return the remaining text.

    sub parse_config {
        my $self= shift;
        my $template = shift;

        my $oltag = qr/<</;
        my $ortag = qr/>>/;

        ( $oltag, $ortag ) = @_ if scalar @_ == 2;

        if( $template =~ /^(.*?)$oltag\s*Wig[wW]am\s*(.*?)\s*$ortag(.*)$/s ){
            my $conf = $2;
            $template = $1.$3; # Remove config tag.

             # ** Comment characters aren't recognized as such if they are immediately
             # ** preceded by an equals '=' This is to allow them to someday be redefined,
             # ** or used as a value for any given option
            # $conf =~ s/\/\*.*?\*\///gs; # Remove comments.
            $conf =~ s/(?<!=)\/\*.*?(?<!=)\*\///gs; # Remove comments.

            my (undef, %parms ) = split( /\s*(\w+)(?<!\\):\s*/s, $conf );
            while( my ( $class, $pairs ) = each %parms ){
                $class = $self->_canonical($class) or next;
                $self->{classes}{$class}->set(
                  conftag => {
                  map(
                    {
                      my @arr = $self->_unescape(
                        ';:=',
                        split( /\s*(?<!\\)=\s*/s )
                      );
                      scalar @arr == 2 ? @arr : (@arr, undef)
                    }
                    split( /\s*(?<!\\);\s*/s, $pairs )
                  ),
                     # Give priority to existing settings
                    %{ $self->{classes}{$class}->conftag || {} },
                  }
                );
            }
        }
        return $template;
    }

 ## Private methods

    sub _canonical {
        my( $self, @classes ) = @_;
        my @canlist = ();
        while(@classes){
            my $class = lc shift @classes;
            warn "Invalid config class specified '$class'" and next
              unless exists $self->{classes}{$class};
            push( @canlist, $class );
        }
        return wantarray ? @canlist : $canlist[0];
    }

    sub _generate {
        my $self = shift;
        my @classes = reverse $self->_canonical(@_);
        my $hash = {};
        while( my $class = shift @classes ){
            $class = $self->_canonical($class) or next;
            %$hash = ( %$hash, %{$self->{classes}{$class}->generate} );
        }
        return $hash;
    }

    sub _unescape {
        shift;
        my $chars=quotemeta(shift);
        $_ =~ s/\\([$chars])/$1/gs for (@_);
        return @_;
    }

1;

__END__


##############################################################################
##############################################################################
            package Text::Wigwam::Config;
##############################################################################
##                              Config.pm                                   ##
##############################################################################
## This module manages the configuration tag settings.                      ##
##############################################################################
## All supported options classes must be specified during the construction  ##
## phase. This is done by calling the new method with a list of class names ##
## each followed by the desired preset parameters in the form of a hash     ##
## reference, or undef if no such parameters are required. References to    ##
## class names that were not declared during object construction will be    ##
## quietly ignored by all object methods.                                   ##
##                                                                          ##
## my $Config = Text::Wigwam::Config->new(                                  ##
##      class1 => { parm => 1 },                                            ##
##      class2 => { parm => 2 },                                            ##
##      class3 => undef,                                                    ##
## )                                                                        ##
##                                                                          ##
##                                                                          ##
## $Config->inherit (                                                       ##
##      class1 => \%class_1_parms,                                          ##
##      class2 => \%class_2_parms,                                          ##
##      class3 => \%class_3_parms,                                          ##
## )                                                                        ##
##                                                                          ##
## The inherit method is used to set user-specified parameters for each     ##
## class.                                                                   ##
##                                                                          ##
## Programmable attribute methods:                                          ##
##                                                                          ##
## $Config->confine qw( class1 class2 ... )                                 ##
##                                                                          ##
## The confine method is used to confine classes' parameters to the current ##
## Config object only. This method affects the way spawn works on a given   ##
## class. If a class has been confined, then that class' parameters are not ##
## pass to child objects via the spawn method.                              ##
##                                                                          ##
##                                                                          ##
## $Config->concede qw( class1 class2 ... )                                 ##
##                                                                          ##
## By invoking the concede method, a class can be programmed to ignore any  ##
## preset parameters (as opposed to merging them) when inherited parameters ##
## are defined.                                                             ##
##                                                                          ##
##                                                                          ##
## $Config->promote qw( class1 class2 ... )                                 ##
##                                                                          ##
## The promote method gives the specified classes' inherited settings       ##
## priority over config tag settings.                                       ##
##                                                                          ##
##                                                                          ##
## $Config->exclude qw( class1 class2 ... )                                 ##
##                                                                          ##
## The exclude method forces the parameters defined within the config       ##
## tag for the specified classes to be ignored when generating an options   ##
## hash via the get/store methods.                                          ##
##                                                                          ##
##                                                                          ##
## Data manipulation methods:                                               ##
##                                                                          ##
## $Config->crank( qw( class1 class2 class3 ... ) )                         ##
##                                                                          ##
## The crank method is used to crank out an options hash from an ordered    ##
## list of classes arranged highest priority first. The resulting hash is   ##
## returned.                                                                ##
##                                                                          ##
## $Config->cache( name => qw( class1 class2 class3 ... ) )                 ##
##                                                                          ##
## The cache method functions much like crank except that the first         ##
## argument is used as a key for storing and retrieving the resulting hash. ##
## Subsequent cache requests for the same name will be pulled from the      ##
## cache.                                                                   ##
##                                                                          ##
## If only one parameter is passed to the cache method, that parameter is   ##
## used both as the name and class. The following examples are virtually    ##
## identical:                                                               ##
##                                                                          ##
## $Config->cache qw( name )                                                ##
## $Config->cache( name => qw( name ) )                                     ##
##                                                                          ##
##                                                                          ##
## $Config->parse_config( $template, '<<', '>>' )                           ##
##                                                                          ##
## The parse_config method is used to parse a template's configuration tag, ##
## assuming it has one. All parameters of known option classes are stored   ##
## within the object's instance data, then the template text is returned    ##
## sans the configuration tag. Optionally, the config tag identifiers may   ##
## be specified as the second and third arguments.                          ##
##                                                                          ##
## $template = $Config->parse_config( $template, '<<', '>>' )               ##
##                                                                          ##
##                                                                          ##
## $Config->spawn                                                           ##
##                                                                          ##
## The spawn method is used to generate a copy of any given Config object   ##
## suitable for use by child templates. The new Config object inherits all  ##
## the config classes, attributes, and presets from the parent based on the ##
## parent's preprogrammed rules.                                            ##
##                                                                          ##
## my $child = $Config->spawn                                               ##
## $child->parse_config( $child_template )                                  ##
##                                                                          ##
##                                                                          ##
##############################################################################

