Net/XMPP2/Event.pm

package Net::XMPP2::Event;

=head1 NAME

Net::XMPP2::Event - Event handler class

=head1 SYNOPSIS

   package foo;
   use Net::XMPP2::Event;

   our @ISA = qw/Net::XMPP2::Event/;

   package main;
   my $o = foo->new;
   $o->reg_cb (foo => sub { ...; 1 });
   $o->event (foo => 1, 2, 3);

=head1 DESCRIPTION

This module is just a small helper module for the connection
and client classes.

You may only derive from this package.

=head1 METHODS

=over 4

=item B<reg_cb ($eventname1, $cb1, [$eventname2, $cb2, ...])>

This method registers a callback C<$cb1> for the event with the
name C<$eventname1>. You can also pass multiple of these eventname => callback
pairs.

The return value will be an ID that represents the set of callbacks you have installed.
Call C<unreg_cb> with that ID to remove those callbacks again.

To see a documentation of emitted events please take a look at the EVENTS section
in the classes that inherit from this one.

=cut

sub reg_cb {
   my ($self, %regs) = @_;

   $self->{id}++;

   for my $cmd (keys %regs) {
      push @{$self->{events}->{lc $cmd}}, [$self->{id}, $regs{$cmd}]
   }

   $self->{id}
}

=item B<unreg_cb ($id)>

Removes the set C<$id> of registered callbacks. C<$id> is the
return value of a C<reg_cb> call.

=cut

sub unreg_cb {
   my ($self, $id) = @_;

   my $set = delete $self->{ids}->{$id};

   for my $key (keys %{$self->{events}}) {
      @{$self->{events}->{$key}} =
         grep {
            $_->[0] ne $id
         } @{$self->{events}->{$key}};
   }
}


=item B<event ($eventname, @args)>

Emits the event C<$eventname> and passes the arguments C<@args>.

=cut

sub event {
   my ($self, $ev, @arg) = @_;

   my $nxt = [];

   my $handled;
   for (@{$self->{events}->{lc $ev}}) {
      $_->[1]->($self, @arg) and push @$nxt, $_;
   }

   for (values %{$self->{event_forwards}}) {
      $_->[1]->($self, $_->[0], $ev, @arg);
   }

   $self->{events}->{lc $ev} = $nxt;
}

=item B<add_forward ($obj, $forward_cb)>

This method allows to forward or copy all events to a object.
C<$forward_cb> will be called everytime an event is generated in C<$self>.
The first argument to the callback C<$forward_cb> will be <$self>, the second
will be C<$obj>, the third will be the event name and the rest will be
the event arguments. (For third and rest of argument also see description
of C<event>).

=cut

sub add_forward {
   my ($self, $obj, $forward_cb) = @_;
   $self->{event_forwards}->{$obj} = [$obj, $forward_cb];
}

=back

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2007 Robin Redeker, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;
Revision:	1.5
Committed:	Thu Jul 5 19:27:35 2007 UTC (19 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.4:	+2 -2 lines
Log Message:	fixed some typos and such
#	User	Rev	Content
1	elmex	1.1	package Net::XMPP2::Event;
2
3			=head1 NAME
4
5	elmex	1.5	Net::XMPP2::Event - Event handler class
6	elmex	1.1
7			=head1 SYNOPSIS
8
9			package foo;
10			use Net::XMPP2::Event;
11
12			our @ISA = qw/Net::XMPP2::Event/;
13
14			package main;
15			my $o = foo->new;
16			$o->reg_cb (foo => sub { ...; 1 });
17			$o->event (foo => 1, 2, 3);
18
19			=head1 DESCRIPTION
20
21			This module is just a small helper module for the connection
22			and client classes.
23
24			You may only derive from this package.
25
26	elmex	1.4	=head1 METHODS
27
28			=over 4
29
30			=item B<reg_cb ($eventname1, $cb1, [$eventname2, $cb2, ...])>
31	elmex	1.1
32			This method registers a callback C<$cb1> for the event with the
33			name C<$eventname1>. You can also pass multiple of these eventname => callback
34			pairs.
35
36	elmex	1.2	The return value will be an ID that represents the set of callbacks you have installed.
37			Call C<unreg_cb> with that ID to remove those callbacks again.
38
39	elmex	1.1	To see a documentation of emitted events please take a look at the EVENTS section
40	elmex	1.2	in the classes that inherit from this one.
41	elmex	1.1
42			=cut
43
44			sub reg_cb {
45			my ($self, %regs) = @_;
46
47	elmex	1.2	$self->{id}++;
48
49	elmex	1.1	for my $cmd (keys %regs) {
50	elmex	1.2	push @{$self->{events}->{lc $cmd}}, [$self->{id}, $regs{$cmd}]
51	elmex	1.1	}
52
53	elmex	1.2	$self->{id}
54			}
55
56	elmex	1.4	=item B<unreg_cb ($id)>
57	elmex	1.2
58			Removes the set C<$id> of registered callbacks. C<$id> is the
59			return value of a C<reg_cb> call.
60
61			=cut
62
63			sub unreg_cb {
64			my ($self, $id) = @_;
65
66			my $set = delete $self->{ids}->{$id};
67
68			for my $key (keys %{$self->{events}}) {
69			@{$self->{events}->{$key}} =
70			grep {
71			$_->[0] ne $id
72			} @{$self->{events}->{$key}};
73			}
74	elmex	1.1	}
75
76	elmex	1.2
77	elmex	1.4	=item B<event ($eventname, @args)>
78	elmex	1.1
79			Emits the event C<$eventname> and passes the arguments C<@args>.
80
81			=cut
82
83			sub event {
84			my ($self, $ev, @arg) = @_;
85
86			my $nxt = [];
87
88			my $handled;
89			for (@{$self->{events}->{lc $ev}}) {
90	elmex	1.2	$_->[1]->($self, @arg) and push @$nxt, $_;
91	elmex	1.1	}
92
93	elmex	1.3	for (values %{$self->{event_forwards}}) {
94			$_->[1]->($self, $_->[0], $ev, @arg);
95			}
96
97	elmex	1.1	$self->{events}->{lc $ev} = $nxt;
98			}
99
100	elmex	1.4	=item B<add_forward ($obj, $forward_cb)>
101	elmex	1.3
102			This method allows to forward or copy all events to a object.
103	elmex	1.5	C<$forward_cb> will be called everytime an event is generated in C<$self>.
104	elmex	1.3	The first argument to the callback C<$forward_cb> will be <$self>, the second
105			will be C<$obj>, the third will be the event name and the rest will be
106			the event arguments. (For third and rest of argument also see description
107			of C<event>).
108
109			=cut
110
111			sub add_forward {
112			my ($self, $obj, $forward_cb) = @_;
113			$self->{event_forwards}->{$obj} = [$obj, $forward_cb];
114			}
115
116	elmex	1.4	=back
117
118	elmex	1.1	=head1 AUTHOR
119
120	elmex	1.4	Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
121	elmex	1.1
122			=head1 COPYRIGHT & LICENSE
123
124			Copyright 2007 Robin Redeker, all rights reserved.
125
126			This program is free software; you can redistribute it and/or modify it
127			under the same terms as Perl itself.
128
129			=cut
130
131			1;