package Language::P::Toy::Value::Typeglob;
use strict;
use warnings;
use base qw(Language::P::Toy::Value::Any);
__PACKAGE__->mk_ro_accessors( qw(body) );
sub new {
my( $class, $args ) = @_;
my $self = $class->SUPER::new( $args );
$self->{body} ||= Language::P::Toy::Value::Typeglob::Body->new;
return $self;
}
sub set_slot {
my( $self, $slot, $value ) = @_;
$self->body->set_slot( $slot, $value );
}
sub get_slot {
my( $self, $slot ) = @_;
Carp::confess unless $slot;
return $self->body->$slot;
}
sub get_or_create_slot {
my( $self, $slot ) = @_;
return $self->body->get_or_create( $slot );
}
sub as_boolean_int {
my( $self ) = @_;
return 1;
}
package Language::P::Toy::Value::Typeglob::Body;
use strict;
use warnings;
use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_ro_accessors( qw(scalar array hash io format subroutine) );
use Language::P::Toy::Value::Scalar;
use Language::P::Toy::Value::Array;
# use Language::P::Toy::Value::Hash;
use Language::P::Toy::Value::Subroutine;
use Language::P::Toy::Value::Handle;
# use Language::P::Toy::Value::Format;
my %types =
( scalar => 'Language::P::Toy::Value::Scalar',
array => 'Language::P::Toy::Value::Array',
hash => 'Language::P::Toy::Value::Hash',
subroutine => 'Language::P::Toy::Value::Subroutine',
io => 'Language::P::Toy::Value::Handle',
format => 'Language::P::Toy::Value::Format',
);
sub set_slot {
my( $self, $slot, $value ) = @_;
die unless $self->can( $slot );
$self->{$slot} = $value;
}
sub get_or_create {
my( $self, $slot ) = @_;
return $self->{$slot} ||= $types{$slot}->new;
}
1;