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;