File Coverage

blib/lib/Net/OSCAR/Buddylist.pm

Criterion	Covered	Total	%
statement	21	76	27.6
branch	4	36	11.1
condition	0	3	0.0
subroutine	7	15	46.6
pod	0	2	0.0
total	32	132	24.2

=pod

=head1 NAME

Net::OSCAR::Buddylist -- tied hash class whose keys are Net::OSCAR::Screennames and which also maintains the ordering of its keys.

=head1 VERSION

version 1.928

=head1 DESCRIPTION

OSCAR screennames don't compare like normal scalars; they're case and whitespace-insensitive.
This is a tied hash class that has that behavior for its keys.

=cut

package Net::OSCAR::Buddylist;
BEGIN {
  $Net::OSCAR::Buddylist::VERSION = '1.928';
}

$REVISION = '$Revision$';

use strict;

use Carp;
use Net::OSCAR::Screenname;
use Net::OSCAR::Utility qw(normalize);

sub new {
	my $pkg = shift;
	$pkg->{nonorm} = 0;
	$pkg->{nonorm} = shift if @_;
	$pkg->TIEHASH(@_);
}

sub setorder {
	my $self = shift;

	# Anything not specified gets shoved at the end
	my @end = grep { my $inbud = $_; not grep { $_ eq $inbud } @_ } @{$self->{ORDERFORM}};

	@{$self->{ORDERFORM}} = @_;
	push @{$self->{ORDERFORM}}, @end;
}

sub TIEHASH {
	my $class = shift;
	my $self = { DATA => {}, ORDERFORM => [], CURRKEY => -1};
	return bless $self, $class;
}

sub FETCH {
	my($self, $key) = @_;
	confess "\$self was undefined!" unless defined($self);
	return undef unless $key;
	$self->{DATA}->{$self->{nonorm} ? $key : normalize($key)};
}

sub STORE {
	my($self, $key, $value) = @_;
	if(exists $self->{DATA}->{$self->{nonorm} ? $key : normalize($key)}) {
		my $foo = 0;
		for(my $i = 0; $i < scalar @{$self->{ORDERFORM}}; $i++) {
			next unless $key eq $self->{ORDERFORM}->[$i];
			$foo = 1;
			$self->{ORDERFORM}->[$i] = $self->{nonorm} ? $key : Net::OSCAR::Screenname->new($key);
			last;
		}
	} else {
		push @{$self->{ORDERFORM}}, $self->{nonorm} ? $key : Net::OSCAR::Screenname->new($key);
	}
	$self->{DATA}->{$self->{nonorm} ? $key : normalize($key)} = $value;
}

sub DELETE {
	my($self, $key) = @_;
	my $retval = delete $self->{DATA}->{$self->{nonorm} ? $key : normalize($key)};
	my $foo = 0;
	for(my $i = 0; $i < scalar @{$self->{ORDERFORM}}; $i++) {
		next unless $key eq $self->{ORDERFORM}->[$i];
		$foo = 1;
		splice(@{$self->{ORDERFORM}}, $i, 1);

		# What if the user deletes a key while iterating?  We need to correct for the new index.
		if($self->{CURRKEY} != -1 and $i <= $self->{CURRKEY}) {
			$self->{CURRKEY}--;
		}

		last;
	}
	return $retval;
}

sub CLEAR {
	my $self = shift;
	$self->{DATA} = {};
	$self->{ORDERFORM} = [];
	$self->{CURRKEY} = -1;
	return $self;
}

sub EXISTS {
	my($self, $key) = @_;
	return exists $self->{DATA}->{$self->{nonorm} ? $key : normalize($key)};
}

sub FIRSTKEY {
	$_[0]->{CURRKEY} = -1;
	goto &NEXTKEY;
}

sub NEXTKEY {
	my ($self, $currkey) = @_;
	$currkey = ++$self->{CURRKEY};

	if($currkey >= scalar @{$self->{ORDERFORM}}) {
		return wantarray ? () : undef;
	} else {
		my $key = $self->{ORDERFORM}->[$currkey];
		my $normalkey = $self->{nonorm} ? $key : normalize($key);
		return wantarray ? ($key, $self->{DATA}->{$normalkey}) : $key;
	}
}

1;