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