The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Badger::Config::Item;

use Badger::Debug ':dump';
use Badger::Class
    version   => 0.01,
    debug     => 0,
    base      => 'Badger::Base',
    import    => 'class CLASS',
    utils     => 'blessed',
    accessors => 'name',
    constants => 'DELIMITER ARRAY HASH',
    alias     => {
        init  => \&init_item,
    },
    messages  => {
        bad_type     => 'Invalid type prefix specified for %s: %s',
        bad_method   => 'Missing method for the %s %s configuration item: %s',
        dup_item     => 'Duplicate specification for scheme item: %s',
        bad_fallback => 'Invalid fallback item specified for %s: %s',
        no_value     => 'No value specified for the %s configuration item',
    };


sub init_item {
    my ($self, $config) = @_;
    my ($name, @aka, $alias, $fallback, $test);

    my $fall = delete $config->{ fallback_provider } || $self;

    $self->debug("Generating config item: ", $self->dump_data($config))
        if DEBUG;

    $name = $config->{ name }
        || return $self->error_msg( missing => 'name' );
    
    # A '!' at the end of the name indicates it's mandatory.
    # A '=value' at the end indicates a default value.
    $self->{ required } = ($name =~ s/!$//)      ?  1 : $config->{ required };
    $self->{ default  } = ($name =~ s/=(\S+)$//) ? $1 : $config->{ default  };

    # name can be 'name|alias1|alias2|...'
    ($name, @aka) = split(/\|/, $name);

    # alias can be specified as hash ref or string 
    $alias = $config->{ alias } || { };
    $alias = [ split(DELIMITER, $alias) ]
        unless ref $alias;
    $alias = { map { $_ => $name } @$alias }
        if ref $alias eq ARRAY;
    return $self->error_msg( invalid => alias => $alias )
        unless ref $alias eq HASH;
    
    # aliases, and more generally, fallbacks, can be specified as a list ref 
    # or string which we split
    $self->debug("fallback: ", $self->dump_data($config->{ fallback })) if DEBUG;

    $fallback = $config->{ fallback } || [ ];
    $fallback = [ split(DELIMITER, $fallback) ] 
        unless ref $fallback eq ARRAY;
    push(@$fallback, @aka);
    
    $self->debug("fallbacks: ", $self->dump_data($fallback)) if DEBUG;

    foreach my $item (@$fallback) {
        unless ($item =~ /:/) {
            $alias->{ $item } = $name;
            next;
        }
        my ($type, $data) = split(/:/, $item, 2);
        $item = $fall->fallback($name, $type, $data)
            || return $self->error_msg( bad_type => $name, $type );
    }
        
    # add any aliases specified as part of the name and bind them 
    # back into the field info hash
    $self->{ fallback } = $fallback;

    # this is getting way too large... but I just want to get things working
    # before I start paring things down
    $self->{ name    } = $name;
    $self->{ alias   } = $alias;
    $self->{ message } = $config->{ message } || $config->{ error };
    $self->{ action  } = $config->{ action  };
    $self->{ method  } = $config->{ method  };
    $self->{ about   } = $config->{ about   };
    $self->{ args    } = $config->{ args    };

    $self->debug(
        "Configured configuration item: ", $self->dump
    ) if DEBUG;
    
    return $self;
}


sub fallback {
    shift->not_implemented;
}

sub names {
    my $self  = shift;
    my @names = ($self->{ name }, keys %{ $self->{ alias } });
    return wantarray
        ?  @names
        : \@names;
}


sub configure {
    my ($self, $config, $target, $class) = @_;
    my ($name, $alias, $code, @args, $ok, $value);
    
    $class ||= $target;
    
    $self->debug("configure(", CLASS->dump_data_inline($config), ')') if DEBUG;
    $self->debug("item is ", $self->dump_data($self)) if DEBUG;
#    $self->debug("items: ", CLASS->dump_data($items)) if DEBUG;
    
    $name = $self->{ name };
        
    # TODO: abstract out action calls.
    
    FALLBACK: foreach $alias ($name, @{ $self->{ fallback } || [ ] }) {
        next unless defined $alias;
        
        if (ref $alias eq ARRAY) {
            ($code, @args) = @$alias;
            #$self->todo('calling code');
            ($ok, $value) = $code->($class, $name, $config, $target, @args);
            if ($ok) {
                return $self->set($target, $name, $value, $class);
            }
        }
        elsif (defined $config->{ $alias }) {
            $self->debug("Found value for $name ($alias): $config->{ $alias }\n") if DEBUG;
            return $self->set($target, $name, $config->{ $alias }, $class);
        }
        else {
            $self->debug("Nothing found for $alias to set $name\n") if DEBUG;
        }
    }
        
    if (defined $self->{ default }) {
        $self->debug("setting to default value: $self->{ default }\n") if DEBUG;
        return $self->set($target, $name, $self->{ default }, $class);
    }
        
    if ($self->{ required }) {
        $self->debug("$name is required, throwing error\n") if DEBUG;
        return $self->error_msg( $self->{ message } || missing => $name );
    }
    
    return $self;
}


sub set {
    my ($self, $target, $name, $value, $object) = @_;
    my $method;
    
    $object ||= $target;

    $self->debug("set($target, $name, $value)") if DEBUG;
    
    $target->{ $name } = $value;
    $self->{ action }->($self, $name, $value) if $self->{ action };

    if (blessed($object) && ($method = $self->{ method })) {
        $self->debug("calling method $method on object $object\n") if DEBUG;
        $object->$method($name, $value);
    }
        
    return $self;
}

     
sub args {
    my $self = shift;
    my $args = shift;
    my $value;
    
    if ($self->{ args }) {
        $self->debug("looking for $self->{ name } arg in ", $self->dump_data($args)) if DEBUG;
        return $self->error_msg( no_value => $self->{ name } )
            unless @$args && defined $args->[0] && $args->[0] !~ /^-/;
        $value = shift @$args;
    }
    else {
        $value = 1;
    }
    # this is all the wrong way around - quick hack
    return $self->configure({ $self->{ name } => $value }, @_);
}

sub summary {
    my ($self, $reporter) = @_;
    my $name  = $self->{ name };
    my $args  = $self->{ args }  || '';
    my $about = $self->{ about } || '';
    $args = " <$args>" if length $args;
    return $reporter
        ? $reporter->option( $name.$args, $about )
        : sprintf('--%-20s %s', $name.$args, $about);
}
    

1;