
# Use this as the base class for custom Metachar implementations

package Text::Wigwam::Stash::Metachar::Base;

use strict;
use warnings;
no warnings q/uninitialized/;

our $VERSION = '0.01';

use Scalar::Util( qw/ blessed reftype refaddr / );

sub new {
    my ($class, %Opts) = @_;

    my %opts = ();
    map { $opts{ uc $_ } = $Opts{$_} } keys %Opts;

    $opts{HASH}    ||= '.';
    $opts{ARRAY}   ||= ':';
    $opts{MAGIC}   ||= '`';

    $opts{DEFAULT} ||= $opts{uc $opts{DEFAULT}||'HASH'}
      or die "Invalid DEFAULT parameter - must be HASH, ARRAY or MAGIC";

    my $mchar = bless {
        MCHAR => {
            HASH    => $opts{HASH},
            ARRAY   => $opts{ARRAY},
            MAGIC   => $opts{MAGIC},
            $opts{HASH}  => 'HASH',
            $opts{ARRAY} => 'ARRAY',
            $opts{MAGIC} => 'MAGIC',
        },
        MCHAR_DEFAULT => $opts{DEFAULT},
        DTYPE => {
            $opts{HASH}  => sub { {} },
            $opts{ARRAY} => sub { [] },
            $opts{MAGIC} => sub { {} },
        },
    }, ref($class) || $class;
    return $mchar;
}

sub meta_type {
    my ($self, $meta) = @_;
    return $self->{MCHAR}{$meta}
      or die "Invalid metacharacter '$meta'";
}

sub metas {
    my ($mchar) = @_;
    return @{$mchar->{MCHAR}}{qw/HASH ARRAY MAGIC/};
}

sub new_value {
    my ($self, $mchr) = @_;
#    $self->{DTYPE}{$mchr}->();
    my $code = $self->{DTYPE}{$mchr}
      or die "Unknown meta character '$mchr'";
    return $code->();
}

sub _subclass {
    my ($self, $mchar) = @_;
    return join(
            "::" =>
               ref($self) || $self,
               ucfirst lc $self->meta_type($mchar),
          )
    ;
}

sub get {
    my ($self, $mchar, @args) = @_;
    return $self->_subclass($mchar)->get(@args);
}

sub set {
#    my ($self, $mchar, @args) = @_;
    my ($self, $mchar, $mgc, $val, $key, $type) = @_;
    return $self->_subclass($mchar)->set($mgc, $val, $key, $type, $self->new_value($type));
}

sub def {
    my ($self, $mchar, @args) = @_;
    return $self->_subclass($mchar)->def(@args);
}

1;
