Re: Issue with HashRef attritubes

package Namespace;

use namespace::sweep;
use Moose;
use Carp;
use feature 'switch';
use experimental qw(smartmatch);
use overload
	'""' => '_to_string',
	fallback => 1;


use Location;
use Pool;
use Region;
use Flow;
use Timeline;
use Event;


$Carp::Internal{$_}++ for qw{
    Class::MOP
    Class::MOP::Attribute
    Class::MOP::Class
    Class::MOP::Method::Wrapped
	Wrapper
	Container
};


sub _to_string {
	my $self = shift;
	
	return $self->name;
}


# debug output to confirm creation
sub BUILD {
	my $self = shift;
	
	DEBUG_OUTPUT: {
		printf STDERR "New namespace \"$self\" created with id $self->{id}\n",
			if $main::verbose < 2;
			#	debug output (higher verbose value means less output)
	}

	return $self;
};


# string that identifies the Namespace
has 'name' => ( is => 'rw', isa => 'Str', required => 1, writer => 'set_name', );


# DO NOT ACCESS -> for internal use only!
#	unique IDs for objects internal to this namespace
has 'id' => ( is  => 'ro',  isa => 'Str', default => '00000000', writer => 'step_id', );


# tracks the object most recently added to this namespace
#	Type 'IsWrapper' refers to any class that consumes 'Wrapper'
has 'recent_obj' => ( is => 'rw', isa => 'IsWrapper', writer => 'add_obj', );


# updates the ID value and gives it to the newly created object
after add_obj => sub {
	my $self = shift;
	my $id = $self->id;
	my $new_obj = $self->recent_obj;
	
	$new_obj->set_id( $self->step_id( ++$id ) );
	#	steps the current ID and assigns it to the object
	
	# pushes new_obj into the correct hash with the current ID as a key
	for (ref $new_obj) {
		$self->add_pool		( $id => $new_obj ) when 'Pool';
		$self->add_flow		( $id => $new_obj ) when 'Flow';
		$self->add_loc		( $id => $new_obj ) when 'Location';
		$self->add_region	( $id => $new_obj ) when 'Region';
		$self->add_timeline	( $id => $new_obj ) when 'Timeline';
		$self->add_event	( $id => $new_obj ) when 'Event';
		default { $self->add_misc( $id => $new_obj ) }
	}
	
	DEBUG_OUTPUT: {
		printf STDERR "%-8s %-15s  spawned in namespace  %6s  with id %s\n",
			ref $new_obj, $new_obj, $self, $new_obj->id
			if $main::verbose < 1;
			#	debug output (higher verbose value means less output)
	}
		
	return $new_obj;
};


# DO NOT ACCESS -> for internal use only!
#	tracks pools belonging to this namespace, organized by HashRef{ ID => object }
has 'pools' => (
    traits  => ['Hash'],
    is  => 'ro',
    isa => 'HashRef[Pool]',
    handles => {
        add_pool		=> 'set',
        del_pool		=> 'delete',
        get_pool		=> 'get',
		pool_keys		=> 'keys',
		pool_vals		=> 'values',
        no_pools		=> 'is_empty',
        pool_count		=> 'count',
		pool_pairs		=> 'kv',
    },
);


# DO NOT ACCESS -> for internal use only!
#	tracks flows belonging to this namespace, organized by HashRef{ ID => object }
has 'flows' => (
    traits  => ['Hash'],
    is  => 'ro',
    isa => 'HashRef[Flow]',
    handles => {
        add_flow		=> 'set',
        del_flow		=> 'delete',
        get_flow		=> 'get',
		flow_keys		=> 'keys',
		flow_vals		=> 'values',
        no_flows		=> 'is_empty',
        flow_count		=> 'count',
		flow_pairs		=> 'kv',
    },
);


# DO NOT ACCESS -> for internal use only!
#	tracks locations belonging to this namespace, organized by HashRef{ ID => object }
has 'locations' => (
    traits  => ['Hash'],
    is  => 'ro',
    isa => 'HashRef[Location]',
    handles => {
        add_loc			=> 'set',
        del_loc			=> 'delete',
        get_loc			=> 'get',
		loc_keys		=> 'keys',
		loc_vals		=> 'values',
        no_locs			=> 'is_empty',
        loc_count		=> 'count',
		loc_pairs		=> 'kv',
    },
);


# DO NOT ACCESS -> for internal use only!
#	tracks regions belonging to this namespace, organized by HashRef{ ID => object }
has 'regions' => (
    traits  => ['Hash'],
    is  => 'ro',
    isa => 'HashRef[Region]',
    handles => {
        add_region		=> 'set',
        del_region		=> 'delete',
        get_region		=> 'get',
		region_keys		=> 'keys',
		region_vals		=> 'values',
        no_regions		=> 'is_empty',
        region_count	=> 'count',
		region_pairs	=> 'kv',
    },
);


# DO NOT ACCESS -> for internal use only!
#	tracks regions belonging to this namespace, organized by HashRef{ ID => object }
has 'timelines' => (
    traits  => ['Hash'],
    is  => 'ro',
    isa => 'HashRef[Timeline]',
    handles => {
        add_timeline	=> 'set',
        del_timeline	=> 'delete',
        get_timeline	=> 'get',
		timeline_keys	=> 'keys',
		timeline_vals	=> 'values',
        no_timeline		=> 'is_empty',
		timeline_count	=> 'count',
		timeline_pairs	=> 'kv',
    },
);


# DO NOT ACCESS -> for internal use only!
#	tracks regions belonging to this namespace, organized by HashRef{ ID => object }
has 'events' => (
    traits  => ['Hash'],
    is  => 'ro',
    isa => 'HashRef[Event]',
    handles => {
        add_event		=> 'set',
        del_event		=> 'delete',
        get_event		=> 'get',
		event_keys		=> 'keys',
		event_vals		=> 'values',
        no_events		=> 'is_empty',
		event_count		=> 'count',
		event_pairs		=> 'kv',
    },
);


# DO NOT ACCESS -> for internal use only!
#	tracks regions belonging to this namespace, organized by HashRef{ ID => object }
has 'miscs' => (
    traits  => ['Hash'],
    is  => 'ro',
    isa => 'HashRef[IsWrapper]',
    handles => {
        add_misc		=> 'set',
        del_misc		=> 'delete',
        get_misc		=> 'get',
		misc_keys		=> 'keys',
		misc_vals		=> 'values',
        no_misc			=> 'is_empty',
		misc_count		=> 'count',
		misc_pairs		=> 'kv',
    },
);


sub wrappers {
	my $self = shift;
	
	return (	$self->pool_vals,
				$self->flow_vals,
				$self->loc_vals,
				$self->region_vals,
				$self->timeline_vals, 
				$self->misc_vals, );
}


sub containers {
	my $self = shift;

	return ( $self->region_vals, );
}


# DO NOT ACCESS -> for internal use only!
#	tracks retrieved addresses, organized by HashRef{ Address => Region }
has 'AddrCache' => (
    traits  => ['Hash'],
    is  => 'ro',
    isa => 'HashRef[Region]',
);


# DO NOT ACCESS -> for internal use only!
#	tracks retrieved names, organized by HashRef{ name => ArrayRef[Region] }
has 'NameCache' => (
    traits  => ['Hash'],
    is  => 'ro',
    isa => 'HashRef[ArrayRef[Region]]',
);


sub update_cache {
	my ( $self, $wrapper ) = @_;
	
	$_[1] eq $wrapper  ? 
		$self->AddrCache->delete( $_[0] ) : 0
		for $self->AddrCache->kv;
	
	$_[1] eq $wrapper and $_[0] ne $wrapper->name ? 
		( $self->NameCache->delete( $_[0] ) and $self->NameCache->set( $wrapper->name => $wrapper ) ) : 0
		for $self->NameCache->kv;
}


sub retrieve {
	my ( $self, $address ) = @_;
	my ( @names, @possible, $parent, $child, $found );
	
	# pulls the cached reference for $address if it exists
	return $self->AddrCache->get( $address ) if $self->AddrCache->exists( $address );
	
	# removes the "target" reference from the end of the address string
	#	and creates a list of the remaining references
	pop ( @names = split ( '/', $address ) );
	
	# retrieves the grandparent name from the @names array
	my $grandparent = shift @names;
	
	if ( $self->NameCache->exists( $grandparent ) ) {
		@possible = $self->NameCache->get( $grandparent );
		#	pulls the cached array of references for $grandparent if it exists
	} else {
		@possible = grep { $_->name eq $grandparent } $self->containers unless @possible;
		#	searches this namespace for each container that matches the provided grandparent
		
		return carp "retrieve_error: parent \"$grandparent\" not found in namespace \"$self->{name}\""
			and 0 unless @possible;
			#	aborts the retrieval if $grandparent is not found in this namespace
			
		$self->NameCache->set( $grandparent => @possible )
		#	caches the newly searched grandparent
	}
	
	# checks each Region in @possible to see if it contains the given address 
	PARENT: for $parent ( @possible ) {
		for $child ( @names ) {
			# traverses the address tree to see if the child exists under the current grandparent
			$parent->owns( $child ) ?
				$parent = $parent->visit( $child ) :
				next PARENT;
		}
		
		# aborts the retrieval if more than one region matches the given address
		$found ? ( return carp "retrieve_error: ambiguous address \"$address\"" and 0 ) : ( $found = 1 );
	}
		
	$self->AddrCache->set( $address => $parent );	# caches the newly retrieved address
	return $parent;	# $parent is now the grandchild reference
}


# prints the list of objects owned by this namespace
#	in the format (class, name, key)
sub list_children {
	my $self = shift;
	
	my @objects_list = map { ( ref $_, $_->name, $_->id ) } sort by_id $self->wrappers;
	sprintf "List of objects in $self:\n" .
			"\t %8s  %-15s  %s \n" x ( @objects_list / 3 ),
			@objects_list;
	#	prints a formatted list of objects in columns of (class, name, key)
}
sub by_id { $a->id ge $b->id }


1;
__PACKAGE__->meta->make_immutable;