1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
# $Id: Event.pm,v 1.1.1.1 2002/03/05 16:34:19 dgl Exp $
package Event;
use strict;
my($currentevent,$currenteventid,$stop);
sub new {
my $self = bless { }, shift;
%$self = @_;
return $self;
}
sub add {
my($self,$event,%option) = @_;
return unless $event;
$self->{$event} ||= [ ];
push(@{$self->{$event}}, bless ( {
priority => $option{priority} || 5,
code => $option{code},
data => $option{data},
'package' => (caller)[0],
_self => $self,
} ) );
$self->sortpri($event);
}
sub delete {
my($self,$event,%option) = @_;
if(defined $currentevent) {
$self = $self->{_self};
splice( @{ $self->{$currentevent} }, $currenteventid, 1);
$self->sortpri($currentevent);
} else {
my $count = 0;
for my $item(@{ $self->{$event} } ) {
if((exists $option{code} && $item->{code} eq $option{code}) || (exists $option{data} && $item->{data} eq $option{data})) {
splice( @{ $self->{$event} }, $count, 1);
}
$count++;
}
$self->sortpri($event);
}
}
sub remove_package {
my($self, $package) = @_;
for my $event (keys %$self) {
next unless ref $self->{$event};
my $count = 0;
for my $item(@{ $self->{$event} } ) {
if($item->{package} eq $package) {
splice( @{ $self->{$event} }, $count, 1);
}
$count++;
}
}
}
# Make sure the array for the event is sorted on priority
sub sortpri {
my($self,$event) = @_;
return unless $event;
if($#{$self->{$event}} == -1) {
delete($self->{$event});
} else {
@{$self->{$event}} = (sort {$a->{priority} <=> $b->{priority}} @{$self->{$event}});
}
}
sub handle {
my($self,$event,@param) = @_;
print("Event: $event, @param\n") if $self->{_DEBUG};
$currentevent = $event;
$currenteventid = 0;
for my $item(@{$self->{$event}} ) {
my($tmpevent,$tmpid) = ($currentevent,$currenteventid);
$item->{code}->($item,@param);
($currentevent,$currenteventid) = ($tmpevent,$tmpid);
$currenteventid++;
if($stop) {
$stop = 0;
last;
}
}
if(!scalar @{$self->{$event}} && $event ne "unhandled") {
$self->handle('unhandled', $event, @param);
}
$currenteventid = $currentevent = undef;
}
sub stop {
my($self) = @_;
$stop = 1 if defined $currentevent;
}
sub getevent {
my($self) = @_;
return defined $currentevent ? $currentevent : undef;
}
sub exists {
my($self,$event) = @_;
return 1 if exists $self->{$event};
0;
}
1;
|
