Tie-SecureHash

 view release on metacpan or  search on metacpan

lib/Tie/SecureHash.pm  view on Meta::CPAN

        carp qq{Tie'ing a securehash directly should never happen in 'fast' mode.\n}.
            qq{Use Tie::SecureHash::new instead}
	}
    bless {}, $class;
}

sub FETCH {                     # ($self, $key)
    my ($self, $key) = @_;
    my $entry;
    if (! $dangerous) {
        $entry = _access($self,$key,(caller)[0..1]);
    } elsif ($key =~ /::/) {
        $entry = \$self->{fullkeys}->{$key};
    } else {
        my $caller = (caller)[0];
        $entry = $self->_dangerous_access($key, $caller, 'FETCH');
    }
    return $$entry if $entry;
    return;
}

sub STORE {                       # ($self, $key, $value)
	my ($self, $key, $value) = @_;
	my $entry;
	if (! $dangerous) {
            $entry = _access($self,$key,(caller)[0..1]);
	} elsif ($key =~ /::/) {
            $self->{fullkeys}->{$key} = $value;
            $entry = \$self->{fullkeys}->{$key};
	} else {
            my $caller = (caller)[0];
            $entry = $self->_dangerous_access($key,$caller, 'STORE');
	}
	return $$entry = $value if $entry;
	return;
    }

sub DELETE {                      # ($self, $key)
    my ($self, $key) = @_;
    if (! $dangerous) {
        return _access($self,$key,(caller)[0..1],'DELETE');
    } 
    elsif ($key =~ /::/) {
        delete $self->{fullkeys}->{$key};
    } 
    else {
        my $caller = (caller)[0];
        return $self->_dangerous_access($key, $caller, 'DELETE');
    }
}


sub CLEAR {                     # ($self)
    my ($self) = @_;
    if ($dangerous) {
        %$self = ();
    }

lib/Tie/SecureHash.pm  view on Meta::CPAN

            join("\n", map {"\t$_"} @inaccessibles) . "\n "
                if @inaccessibles;
        %{$self} = ();
    }
}

sub EXISTS                      # ($self, $key)
    {
	my ($self, $key) = @_;
        if (! $dangerous) {
            my @context = (caller)[0..1];
            eval { _access($self,$key,@context); 1 } ? 1 : '';
        }
        elsif ($key =~ /::/) {
            return exists $self->{fullkeys}->{$key};
        }
        else {
            my $caller = (caller)[0];
            _complain($self, $key, $caller, 'EXISTS') if $strict;
            return exists $self->{fullkeys}->{"$caller::$key"};
        }
    }

sub FIRSTKEY                    # ($self)
    {
	my ($self) = @_;
	CORE::keys %{$self->{fullkeys}};
	goto &NEXTKEY;
    }

sub NEXTKEY                     # ($self)
    {
	my $self = $_[0];
        if ($dangerous) {
            return CORE::each %{$self->{fullkeys}};
        }
	my $key;
	my @context = (caller)[0..1];
	while (defined($key = CORE::each %{$self->{fullkeys}})) {
            last if eval { _access($self,$key,@context) };
            carp "Attempt to iterate inaccessible key '$key' will be unsafe in 'fast' mode. Use explicit keys" if $ENV{UNSAFE_WARN};
		     
	}
	return $key;
    }

sub DESTROY {    # ($self) 
    # NOTHING TO DO

t/dangerous.t  view on Meta::CPAN

print "ok 1\n";

######################### End of black magic.

$hashref = Tie::SecureHash->new();

$ok_count = 1;
sub ok($)
{
	print "\t$@" if $@ && $::VERBOSE;
	print "\tUnexpected error at ", (caller)[2], "\n"
		if !$_[0] && !$@ && $::VERBOSE;
	print "not " unless $_[0];
	print "ok ", ++$ok_count;
	print "\t($_[0])" if $_[0] && $::VERBOSE;
	print "\n";
	push @::failed, $ok_count  unless $_[0];
}

sub NB
{

t/fast.t  view on Meta::CPAN

print "ok 1\n";

######################### End of black magic.

$hashref = Tie::SecureHash->new();

$ok_count = 1;
sub ok($)
{
	print "\t$@" if $@ && $::VERBOSE;
	print "\tUnexpected error at ", (caller)[2], "\n"
		if !$_[0] && !$@ && $::VERBOSE;
	print "not " unless $_[0];
	print "ok ", ++$ok_count;
	print "\t($_[0])" if $_[0] && $::VERBOSE;
	print "\n";
	push @::failed, $ok_count  unless $_[0];
}

sub NB
{

t/safe.t  view on Meta::CPAN

print "ok 1\n";

######################### End of black magic.

$hashref = Tie::SecureHash->new();

$ok_count = 1;
sub ok($)
{
	print "\t$@" if $@ && $::VERBOSE;
	print "\tUnexpected error at ", (caller)[2], "\n"
		if !$_[0] && !$@ && $::VERBOSE;
	print "not " unless $_[0];
	print "ok ", ++$ok_count;
	print "\t($_[0])" if $_[0] && $::VERBOSE;
	print "\n";
	push @::failed, $ok_count  unless $_[0];
}

sub NB
{

t/strict.t  view on Meta::CPAN

print "ok 1\n";

######################### End of black magic.

$hashref = Tie::SecureHash->new();

$ok_count = 1;
sub ok($)
{
	print "\t$@" if $@ && $::VERBOSE;
	print "\tUnexpected error at ", (caller)[2], "\n"
		if !$_[0] && !$@ && $::VERBOSE;
	print "not " unless $_[0];
	print "ok ", ++$ok_count;
	print "\t($_[0])" if $_[0] && $::VERBOSE;
	print "\n";
	push @::failed, $ok_count  unless $_[0];
}

sub NB
{