File Coverage

blib/lib/Tie/Hash/Longest.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	20	20	100.0
condition	6	6	100.0
subroutine	14	14	100.0
pod	2	3	66.6
total	91	92	98.9

package Tie::Hash::Longest;

$VERSION='1.1';

use strict;

sub TIEHASH {
	my $class = shift;
	my $self = CLEAR({});
	return bless $self, $class;
}

sub longestkey {
    my $self = shift;
    rescan($self) if($self->{RESCAN_NEEDED});
    $self->{KEY};
}

sub longestvalue {
    my $self = shift;
    rescan($self) if($self->{RESCAN_NEEDED});
    $self->{VALUE};
}

# the no warnings here (and the one later) are so we can take length(undef)

sub rescan {
    no warnings;
    my $self = shift;
    $self->{KEY} = $self->{VALUE} = undef;
    foreach (keys %{$self->{CURRENT_STATE}}) {
        $self->{KEY} = $_ if(length($_) > length($self->{KEY}));
        $self->{VALUE} = $self->{CURRENT_STATE}->{$_}
            if(length($self->{CURRENT_STATE}->{$_}) > length($self->{VALUE}));
    }
    $self->{RESCAN_NEEDED} = 0;
}

sub CLEAR {
    my $self = shift;
    $self = {
        KEY           => undef,
        VALUE         => undef,
        CURRENT_STATE => {},
        RESCAN_NEEDED => 0
    };
}

sub STORE {
    no warnings;
    my($self, $key, $value)=@_;
    $self->{KEY} = $key unless(defined($self->{KEY}));
    $self->{VALUE} = $value unless(defined($self->{VALUE}));
    $self->{RESCAN_NEEDED} = 1 if(
        length($key) == length($self->{KEY}) ||
        length($self->{CURRENT_STATE}->{$key}) == length($self->{VALUE})
    );
    $self->{CURRENT_STATE}->{$key} = $value;
    $self->{KEY}   = $key   if(length($key)   > length($self->{KEY}));
    $self->{VALUE} = $value if(length($value) > length($self->{VALUE}));
}

sub FETCH {
    my($self, $key) = @_;
    $self->{CURRENT_STATE}->{$key};
}

sub FIRSTKEY {
    my $self = shift;
    scalar keys %{$self->{CURRENT_STATE}};
    scalar each %{$self->{CURRENT_STATE}};
}

sub DELETE {
    my($self, $key) = @_;
    $self->{RESCAN_NEEDED} = 1 if(
        $key eq $self->{KEY} ||
        $self->{CURRENT_STATE}->{$key} eq $self->{VALUE}
    );
    delete $self->{CURRENT_STATE}->{$key};
}

sub NEXTKEY { my $self = shift; scalar each %{$self->{CURRENT_STATE}}; }
sub EXISTS { my($self, $key) = @_; exists($self->{CURRENT_STATE}->{$key}); }

1;
__END__