view release on metacpan or  search on metacpan

HashObject.pm  view on Meta::CPAN

	if (!defined $self->object && $key eq 'object') {
		if (ref $value) {
			$self->object($value);
		} else {
			warn sprintf('First call to %s->{object} must be a reference to an object', __PACKAGE__);
		}
	}
	elsif (!defined $self->method_keys && $key eq 'keys') {
		$self->method_keys($value);
	}
        elsif ( $self->object->isa( (caller)[0] ) ) { 
		return $self->{storage}->{$key} = $value;
	}
	elsif (grep /^$key$/, @{$self->method_keys}) {
		$self->object->$key($value);
	}
	else {
		warn "Invalid key: " . $key;
	}
}

sub FETCH { 
	my $self = shift;
	my $key  = shift;
        if ( $self->object->isa((caller)[0]) ) { 
		return $self->{storage}->{$key};
	}
	elsif (grep /^$key$/, @{$self->method_keys}) {
		return $self->object->$key;
	}
	else {
		warn "Invalid key: " . $key;
	}
}

sub FIRSTKEY {
	my $self = shift;
        if ( $self->object->isa((caller)[0]) ) { 
		return (keys %{$self->{storage}})[0];
	}
	else {
		# we have to do this for data dumps...
		return (@{$self->defined_public_keys})[0];
	}
}

sub NEXTKEY { 
	my $self        = shift;
	my $last_method = shift;

	my @keys;

        if ( $self->object->isa((caller)[0]) ) { 
		@keys = keys %{$self->{storage}};
	}
	else {
		@keys = @{$self->defined_public_keys};
	}
	my $next_index  = 0;
	foreach my $key (@keys) {
		$next_index++;
		last if $last_method eq $key;
	}
	return $next_index > scalar @keys ? undef : $keys[$next_index];
}


sub EXISTS { 
	my $self = shift;
	my $key  = shift;

        if ( $self->object->isa((caller)[0]) ) { 
		return exists $self->{storage}->{$key};
	}
	else {
		return (grep /^$key$/, @{$self->defined_public_keys});
	}
}

sub DELETE { 
	my $self = shift;
	my $key  = shift;

        if ( $self->object->isa((caller)[0]) ) { 
		return delete $self->{storage}->{$key};
	}
	else {
		warn "Cannot delete methods. Please set the values instead.";
	}
}

# override this method if you have some default for clearing the method hash values...
sub CLEAR  { 
	my $self = shift;
        if ( $self->object->isa((caller)[0]) ) { 
		$self->{storage} = {};
	}
	else {
		warn "Cannot clear tied method calls"; 
	}
}

sub SCALAR { 
	my $self = shift;
        if ( $self->object->isa((caller)[0]) ) { 
		return scalar keys %{$self->{storage}};
	}
	else {
		return scalar @{$self->defined_public_keys};
	}
}

1;

__END__