source: perl/modules/AIM/lib/Net/OSCAR/Buddylist.pm @ a1c2f06

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