1=pod
2
3=head1 NAME
4
5Net::OSCAR::Buddylist -- tied hash class whose keys are Net::OSCAR::Screennames and which also maintains the ordering of its keys.
6
7=head1 VERSION
8
9version 1.928
10
11=head1 DESCRIPTION
12
13OSCAR screennames don't compare like normal scalars; they're case and whitespace-insensitive.
14This is a tied hash class that has that behavior for its keys.
15
16=cut
17
18package Net::OSCAR::Buddylist;
19BEGIN {
20  $Net::OSCAR::Buddylist::VERSION = '1.928';
21}
22
23$REVISION = '$Revision$';
24
25use strict;
26
27use Carp;
28use Net::OSCAR::Screenname;
29use Net::OSCAR::Utility qw(normalize);
30
31sub new {
32	my $pkg = shift;
33	$pkg->{nonorm} = 0;
34	$pkg->{nonorm} = shift if @_;
35	$pkg->TIEHASH(@_);
36}
37
38sub setorder {
39	my $self = shift;
40
41	# Anything not specified gets shoved at the end
42	my @end = grep { my $inbud = $_; not grep { $_ eq $inbud } @_ } @{$self->{ORDERFORM}};
43
44	@{$self->{ORDERFORM}} = @_;
45	push @{$self->{ORDERFORM}}, @end;
46}
47
48sub TIEHASH {
49	my $class = shift;
50	my $self = { DATA => {}, ORDERFORM => [], CURRKEY => -1};
51	return bless $self, $class;
52}
53
54sub FETCH {
55	my($self, $key) = @_;
56	confess "\$self was undefined!" unless defined($self);
57	return undef unless $key;
58	$self->{DATA}->{$self->{nonorm} ? $key : normalize($key)};
59}
60
61sub STORE {
62	my($self, $key, $value) = @_;
63	if(exists $self->{DATA}->{$self->{nonorm} ? $key : normalize($key)}) {
64		my $foo = 0;
65		for(my $i = 0; $i < scalar @{$self->{ORDERFORM}}; $i++) {
66			next unless $key eq $self->{ORDERFORM}->[$i];
67			$foo = 1;
68			$self->{ORDERFORM}->[$i] = $self->{nonorm} ? $key : Net::OSCAR::Screenname->new($key);
69			last;
70		}
71	} else {
72		push @{$self->{ORDERFORM}}, $self->{nonorm} ? $key : Net::OSCAR::Screenname->new($key);
73	}
74	$self->{DATA}->{$self->{nonorm} ? $key : normalize($key)} = $value;
75}
76
77sub DELETE {
78	my($self, $key) = @_;
79	my $retval = delete $self->{DATA}->{$self->{nonorm} ? $key : normalize($key)};
80	my $foo = 0;
81	for(my $i = 0; $i < scalar @{$self->{ORDERFORM}}; $i++) {
82		next unless $key eq $self->{ORDERFORM}->[$i];
83		$foo = 1;
84		splice(@{$self->{ORDERFORM}}, $i, 1);
85
86		# What if the user deletes a key while iterating?  We need to correct for the new index.
87		if($self->{CURRKEY} != -1 and $i <= $self->{CURRKEY}) {
88			$self->{CURRKEY}--;
89		}
90
91		last;
92	}
93	return $retval;
94}
95
96sub CLEAR {
97	my $self = shift;
98	$self->{DATA} = {};
99	$self->{ORDERFORM} = [];
100	$self->{CURRKEY} = -1;
101	return $self;
102}
103
104sub EXISTS {
105	my($self, $key) = @_;
106	return exists $self->{DATA}->{$self->{nonorm} ? $key : normalize($key)};
107}
108
109sub FIRSTKEY {
110	$_[0]->{CURRKEY} = -1;
111	goto &NEXTKEY;
112}
113
114sub NEXTKEY {
115	my ($self, $currkey) = @_;
116	$currkey = ++$self->{CURRKEY};
117
118	if($currkey >= scalar @{$self->{ORDERFORM}}) {
119		return wantarray ? () : undef;
120	} else {
121		my $key = $self->{ORDERFORM}->[$currkey];
122		my $normalkey = $self->{nonorm} ? $key : normalize($key);
123		return wantarray ? ($key, $self->{DATA}->{$normalkey}) : $key;
124	}
125}
126
1271;