lib/KGS/Listener.pm

package KGS::Listener;

=head1 NAME

KGS::Listener - a generic base class to listen for kgs messages.

=head1 SYNOPSIS

  use base KGS::Listener;

  sub new {
     my $class = shift;
     my $self = $class->SUPER::new (@_);

     # for non-channel-related listeners:
     $self->listen ($self->{conn}, qw(ping req_pic));
     # for channel-type listener
     $self->listen ($self->{conn}, qw(join_room: part_room: msg_room:));
     
     $self;
  }

  sub inject_xxx {
     # handle msg xxx
  }

  # KGS::Listener::Room etc. als require this:
  sub event_xxx {
     # handle synthesized event xxx
  }

=head1 DESCRIPTION

Please supply a description )

The KGS::Listener family has currently these members:

  KGS::Listener              base class for everything
  KGS::Listener::Channel     base class for channels (games, rooms)
  KGS::Listener::Game        base class that handles games
  KGS::Listener::Room        base class for rooms and their game lists
  KGS::Listener::Roomlist    base class for the overall room listing
  KGS::Listener::User        base class for user info, chats etc.
  KGS::Listener::Debug       prints all messages that marc doesn't understand

=head2 METHODS

=over 4

=item new [channel => <id>]...

Create a new KGS::Listener project. The L<channel> parameter is optional.

=cut

sub new {
   my $class = shift;
   bless { @_ }, $class;
}

=cut

=item $listener->listen ($conn, [msgtype...])

Registers the object to receive callback messages of the named type(s).
If C<$conn> is C<undef>, returns immediately. It's safe to call this
function repeatedly.

A msgtype is either a packet name like C<login> or C<msg_room>, the
string C<any>, which will match any type, or a msgtype postdixed with
C<:> (e.g. C<msg_room:>), in which case it will only match the C<<
$listener->{channel} >> channel.

The connection will be stored in C<< $listener->{conn} >>.

In your own new method you should call C<< $self->listen >> once with the
connection and the msgtypes you want to listen for.

=item $listener->unlisten

Unregisters the object again.

=cut

sub listen {
   my ($self, $conn, @types) = @_;

   if ($conn) {
      $self->unlisten;
      $self->{conn} = $conn;
      $_ =~ s/:$/:$self->{channel}/ for @types;
      $self->{listen_types} = \@types;
      $self->{conn}->register ($self, "quit", @types);
   }
}

sub unlisten {
   my ($self) = @_;

   (delete $self->{conn})->unregister ($self, @{$self->{listen_types}})
      if $self->{conn};
}

=item $listener->inject ($msg)

The main injector callback.. all (listened for) messages end up in this
method, which will just dispatch a method with name inject_<msgtype>.

You do not normally have to overwrite this method, but you should provide
methods that are being called with names like C<inject_msg_room> etc.

=cut

sub inject {
   my ($self, $msg) = @_;

   if (my $cb = $self->can ("inject_$msg->{type}")) {
      $cb->($self, $msg);
   } elsif (my $cb = $self->can ("inject_any")) {
      $cb->($self, $msg);
   } else {
      warn "no handler found for message $msg->{type} in $self\n";
   }
}

=item $listener->send ($type, %args);

Calls the C<send> method of the connection when in listen state. It does
not (yet) supply a default channel id.

=cut

sub send {
   my ($self, $type, @arg) = @_;

   $self->{conn}->send ($type, @arg) if $self->{conn};
}

sub inject_quit {
   my ($self) = @_;

   $self->event_quit;
}

sub event_quit {
   my ($self) = @_;

   $self->unlisten;
}

sub DESTROY {
   my ($self) = @_;

   $self->unlisten;
}

=back

=cut

1;

Revision:	1.14
Committed:	Mon May 31 18:18:26 2004 UTC (20 years ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.13:	+23 -12 lines
Log Message:	* empty log message *
#	Content
1	package KGS::Listener;
2
3	=head1 NAME
4
5	KGS::Listener - a generic base class to listen for kgs messages.
6
7	=head1 SYNOPSIS
8
9	use base KGS::Listener;
10
11	sub new {
12	my $class = shift;
13	my $self = $class->SUPER::new (@_);
14
15	# for non-channel-related listeners:
16	$self->listen ($self->{conn}, qw(ping req_pic));
17	# for channel-type listener
18	$self->listen ($self->{conn}, qw(join_room: part_room: msg_room:));
19
20	$self;
21	}
22
23	sub inject_xxx {
24	# handle msg xxx
25	}
26
27	# KGS::Listener::Room etc. als require this:
28	sub event_xxx {
29	# handle synthesized event xxx
30	}
31
32	=head1 DESCRIPTION
33
34	Please supply a description )
35
36	The KGS::Listener family has currently these members:
37
38	KGS::Listener base class for everything
39	KGS::Listener::Channel base class for channels (games, rooms)
40	KGS::Listener::Game base class that handles games
41	KGS::Listener::Room base class for rooms and their game lists
42	KGS::Listener::Roomlist base class for the overall room listing
43	KGS::Listener::User base class for user info, chats etc.
44	KGS::Listener::Debug prints all messages that marc doesn't understand
45
46	=head2 METHODS
47
48	=over 4
49
50	=item new [channel => <id>]...
51
52	Create a new KGS::Listener project. The L<channel> parameter is optional.
53
54	=cut
55
56	sub new {
57	my $class = shift;
58	bless { @_ }, $class;
59	}
60
61	=cut
62
63	=item $listener->listen ($conn, [msgtype...])
64
65	Registers the object to receive callback messages of the named type(s).
66	If C<$conn> is C<undef>, returns immediately. It's safe to call this
67	function repeatedly.
68
69	A msgtype is either a packet name like C<login> or C<msg_room>, the
70	string C<any>, which will match any type, or a msgtype postdixed with
71	C<:> (e.g. C<msg_room:>), in which case it will only match the C<<
72	$listener->{channel} >> channel.
73
74	The connection will be stored in C<< $listener->{conn} >>.
75
76	In your own new method you should call C<< $self->listen >> once with the
77	connection and the msgtypes you want to listen for.
78
79	=item $listener->unlisten
80
81	Unregisters the object again.
82
83	=cut
84
85	sub listen {
86	my ($self, $conn, @types) = @_;
87
88	if ($conn) {
89	$self->unlisten;
90	$self->{conn} = $conn;
91	$_ =~ s/:$/:$self->{channel}/ for @types;
92	$self->{listen_types} = \@types;
93	$self->{conn}->register ($self, "quit", @types);
94	}
95	}
96
97	sub unlisten {
98	my ($self) = @_;
99
100	(delete $self->{conn})->unregister ($self, @{$self->{listen_types}})
101	if $self->{conn};
102	}
103
104	=item $listener->inject ($msg)
105
106	The main injector callback.. all (listened for) messages end up in this
107	method, which will just dispatch a method with name inject_<msgtype>.
108
109	You do not normally have to overwrite this method, but you should provide
110	methods that are being called with names like C<inject_msg_room> etc.
111
112	=cut
113
114	sub inject {
115	my ($self, $msg) = @_;
116
117	if (my $cb = $self->can ("inject_$msg->{type}")) {
118	$cb->($self, $msg);
119	} elsif (my $cb = $self->can ("inject_any")) {
120	$cb->($self, $msg);
121	} else {
122	warn "no handler found for message $msg->{type} in $self\n";
123	}
124	}
125
126	=item $listener->send ($type, %args);
127
128	Calls the C<send> method of the connection when in listen state. It does
129	not (yet) supply a default channel id.
130
131	=cut
132
133	sub send {
134	my ($self, $type, @arg) = @_;
135
136	$self->{conn}->send ($type, @arg) if $self->{conn};
137	}
138
139	sub inject_quit {
140	my ($self) = @_;
141
142	$self->event_quit;
143	}
144
145	sub event_quit {
146	my ($self) = @_;
147
148	$self->unlisten;
149	}
150
151	sub DESTROY {
152	my ($self) = @_;
153
154	$self->unlisten;
155	}
156
157	=back
158
159	=cut
160
161	1;
162