File Coverage

blib/lib/Net/Vypress/Chat.pm
Criterion Covered Total %
statement 435 567 76.7
branch 141 256 55.0
condition 29 77 37.6
subroutine 52 59 88.1
pod 37 52 71.1
total 694 1011 68.6


line stmt bran cond sub pod time code
1             # vim:syntax=perl
2             # vim:tabstop=2
3             # vim:shiftwidth=2
4             # vim:enc=utf-8
5             # vim:foldmethod=marker
6             # vim:foldenable
7             package Net::Vypress::Chat;
8              
9 1     1   23992 use 5.008;
  1         3  
  1         31  
10 1     1   4 use strict;
  1         2  
  1         25  
11 1     1   4 use warnings;
  1         6  
  1         31  
12 1     1   854 use IO::Socket;
  1         29379  
  1         6  
13 1     1   1980 use Sys::Hostname;
  1         1812  
  1         65  
14 1     1   1033 use Data::Dumper;
  1         19031  
  1         267  
15 1     1   14 use Carp;
  1         3  
  1         11311  
16              
17             require Exporter;
18              
19             our @ISA = qw(Exporter);
20              
21             our $VERSION = '0.71';
22              
23             # Prints debug messages
24             sub debug { # {{{
25 153     153 1 264 my ($self, $text, $buffer) = @_;
26 153 50       380 print "*** $text\n" if $self->{debug};
27 153 50 66     632 if ($buffer && $self->{debug} == 2) {
28 0         0 my $header = substr $buffer, 0, 1;
29 0         0 my $random = substr $buffer, 1, 9;
30 0         0 my $left = substr $buffer, 10;
31 0         0 $left =~ s/\0/|/gs;
32 0         0 print "($header $random $left)\n";
33             }
34             } # }}}
35              
36             # Generates random letters
37             sub random_letters { # {{{
38 34     34 0 42 my ($count) = shift;
39 34         316 my @pool = ("a".."z");
40 34         41 my $str;
41 34         341 $str .= $pool[rand int $#pool] for 1..$count;
42 34         371 return $str;
43             } # }}}
44              
45             # Generates Vypress Chat header used to mark its packets.
46             # Returns \x58 and nine random letters.
47             sub header { # {{{
48             # 0x58 - Vypress Chat
49 34     34 0 71 return "\x58".random_letters(9);
50             } # }}}
51              
52             # i_am_here($updater)
53             # Replies to who query. Called by recognise() function.
54             # Mainly used in module itself.
55             # E.g.: $vyc->i_am_here("OtherGuy");
56             sub i_am_here { # {{{
57 2     2 0 3 my ($self, $updater) = @_;
58 2         6 my $str = header()."1".$updater."\0".$self->{'nick'}."\0"
59             .$self->{'users'}{$self->{'nick'}}{'status'}
60             .$self->{'users'}{$self->{'nick'}}{'active'};
61 2         9 $self->{'send'}->send($str);
62 2         87 $self->debug("F: i_am_here(), To: $updater, Nick: $self->{'nick'}, "
63             . "Status: "
64             . $self->num2status($self->{'users'}{$self->{'nick'}}{'status'}).", "
65             . "Active: "
66             . $self->num2active($self->{'users'}{$self->{'nick'}}{'active'})
67             , $str);
68             } # }}}
69              
70             # Acknowledges that you have got message.
71             sub msg_ack { # {{{
72 2     2 0 5 my ($self, $to) = @_;
73 2         4 my $str = header()."7".$self->{'users'}{$self->{'nick'}}{'status'}.$to."\0"
74             .$self->{'nick'}."\0".$self->{'users'}{$self->{'nick'}}{'gender'}
75             .$self->{'users'}{$self->{'nick'}}{'autoanswer'}."\0";
76 2         11 $self->usend($str, $to);
77 2         68 $self->debug("F: msg_ack(), To: $to", $str);
78             } # }}}
79              
80             # Sends topic to person if it is set for channel.
81             # Used in recognise() when new user joins.
82             sub send_topic { # {{{
83 0     0 0 0 my ($self, $to, $chan) = @_;
84 0 0       0 if ($self->{'channels'}->{$chan}{'topic'}) {
85 0         0 my $topic = $self->{'channels'}->{$chan}{'topic'};
86 0         0 my $str = header()."C".$to."\0".$chan."\0".$topic."\0";
87 0         0 $self->{'send'}->send($str);
88 0         0 $self->debug("F: send_topic(), To: $to, Chan: $chan, Topic: \"$topic\""
89             , $str);
90             }
91             } # }}}
92              
93             # Changes in channels list.
94             sub change_in_channels { # {{{
95 1     1 0 2 my ($self, $from, $to) = @_;
96 1         2 while (my ($key, $channel) = each %{$self->{channels}}) {
  3         28  
97 2         3 my $arr_cnt = @{$channel->{users}};
  2         4  
98 2         3 my $last;
99 2         7 for (0..$arr_cnt-1) {
100 2 50       4 if (@{$channel->{users}}[$_] eq $from) {
  2         8  
101 2         4 @{$self->{channels}{$key}{users}}[$_] = $to;
  2         6  
102 2         3 $last = 1;
103             }
104 2 50       10 last if $last;
105             }
106             }
107             } # }}}
108              
109             # Deletes channel from user.
110             sub delete_from_channel { # {{{
111 2     2 0 5 my ($self, $nick, $chan) = @_;
112 2 50       17 if ($nick eq $self->{nick}) {
113 2         9 delete $self->{channels}{$chan};
114             }
115             else {
116 0         0 my $arr_count = @{$self->{channels}{$chan}{users}};
  0         0  
117 0         0 my $last;
118 0         0 for (0..$arr_count-1) {
119 0 0       0 if (@{$self->{channels}{$chan}{users}}[$_] eq $nick) {
  0         0  
120 0         0 splice @{$self->{channels}{$chan}{users}}, $_, 1;
  0         0  
121 0         0 $last = 1;
122             }
123 0 0       0 last if $last;
124             }
125             }
126 2         10 $self->debug("F: delete_from_channel(), Nick: $nick, Chan: $chan");
127             } # }}}
128              
129             # Adds channel record.
130             sub add_to_channel { # {{{
131 2     2 0 7 my ($self, $nick, $chan) = @_;
132 2         3 push @{$self->{channels}{$chan}{users}}, $nick;
  2         14  
133             } # }}}
134              
135             # Deletes private record.
136             sub delete_from_private { # {{{
137 1     1 0 3 my ($self, $nick) = @_;
138 1         1 my $arr_count = @{$self->{users}{$self->{nick}}{chats}};
  1         4  
139 1         3 my $last;
140 1         4 for (0..$arr_count-1) {
141 1 50       2 if (@{$self->{users}{$self->{nick}}{chats}}[$_] eq $nick) {
  1         7  
142 1         2 splice @{$self->{users}{$self->{nick}}{chats}}, $_, 1;
  1         5  
143 1         3 $last = 1;
144             }
145 1 50       5 last if $last;
146             }
147             } # }}}
148              
149             # Adds private record.
150             sub add_to_private { # {{{
151 2     2 0 4 my ($self, $nick) = @_;
152 2         3 push @{$self->{users}{$self->{nick}}{chats}}, $nick;
  2         13  
153             } # }}}
154              
155             # Acknowledges a beep
156             sub beep_ack { # {{{
157 0     0 0 0 my ($self, $to) = @_;
158 0         0 my $str = header()."H1".$to."\0".$self->{send}."\0";
159 0         0 $self->{send}->send($str);
160 0         0 $self->debug("F: beep_ack(), To: $to", $str);
161             } # }}}
162              
163             # Gives out out channel list.
164             # CHECK THIS OUT
165             sub chanlist_ack { # {{{
166 0     0 0 0 my ($self, $to) = @_;
167             } # }}}
168              
169             # Acknowledges to here() request on channel.
170             sub here_ack { # {{{
171 0     0 0 0 my ($self, $to, $chan) = @_;
172 0         0 my $str = header()."K".$to."\0".$chan."\0".$self->{'nick'}."\0"
173             .$self->{'users'}{$self->{'nick'}}{'active'};
174 0         0 $self->{'send'}->send($str);
175 0         0 $self->debug("Sent here to $to at $chan with state "
176             .num2active($self->{'users'}{$self->{'nick'}}{'active'}), $str);
177             } # }}}
178              
179             # Sends string thru unicast
180             sub usend { # {{{
181 21     21 0 34 my ($self, $str, $to) = @_;
182 21 100       66 if (defined $self->{users}{$to}{ip}) {
    50          
183 20         99 my $iaddr = inet_aton($self->{users}{$to}{ip});
184 20         72 my $paddr = sockaddr_in($self->{port}, $iaddr);
185 20         211 $self->debug("F: usend, To: $to, Ip: $self->{users}{$to}{ip}", $str);
186 20         75 $self->{usend}->send($str, 0, $paddr);
187             }
188             elsif ($self->{uc_fail} == 1) {
189 1         5 $self->debug("F: usend, To: $to, Warn: IP unknown, A: Sending bcast.");
190 1         4 $self->{send}->send($str);
191             }
192             else {
193 0         0 $self->debug("F: usend, To: $to, Err: IP unknown");
194             }
195             } # }}}
196              
197             # Sends string thru usend to people on some chan
198             sub usend_chan { # {{{
199 6     6 0 10 my ($self, $str, $chan) = @_;
200 6         20 $self->debug("F: usend_chan, Chan: $chan");
201 6         9 for (@{$self->{channels}{$chan}{users}}) {
  6         57  
202 6         15 $self->usend($str, $_);
203             }
204             } # }}}
205              
206              
207              
208             # {{{ Documentation start
209              
210             =pod
211              
212             =head1 NAME
213              
214             Net::Vypress::Chat - Perl extension for Vypress Chat protocol
215              
216             =head1 SYNOPSIS
217              
218             use Net::Vypress::Chat;
219             my $vyc = Net::Vypress::Chat->new(
220             'localip' => '192.168.0.1',
221             'debug' => 0
222             );
223             # This causes to shut down properly on kill signals.
224             $SIG{INT} = sub { $vyc->shutdown() };
225             $SIG{KILL} = sub { $vyc->shutdown() };
226             $vyc->nick('some_nick');
227             $vyc->startup;
228             # Anything goes here.
229             $vyc->msg("person", "message");
230             $vyc->shutdown;
231              
232             =head1 ABSTRACT
233              
234             Net::Vypress::Chat provides API for using vypress chat functions like
235             sending messages, setting topics and so on. It is also capable of recognising
236             incoming UDP message type and returning information from it.
237              
238             =head1 DESCRIPTION
239              
240             Net::Vypress::Chat is object oriented module and can only be used this way.
241             What's about recognise() function i tried to stay as consistent as i can,
242             but some values are mixed up.
243             Module has these methods:
244              
245             =cut
246              
247             # }}}
248              
249             =head2 new()
250              
251             Initialises new instance of module. Sets these variables (if not explained:
252             0 - off, 1 - on):
253              
254             =over
255              
256             =item nick - your nick.
257              
258             =item autoanswer - auto answer for messages
259              
260             =item active - current active state. Default: 1
261              
262             =over
263              
264             =item *
265             0 - not active;
266              
267             =item *
268             1 - active;
269              
270             =back
271              
272             =item send_info - automaticaly send info about this client. Default: 1
273              
274             =item sign_topic - automaticaly sign topic. Default: 1
275              
276             =item gender - current gender.
277             Is not used, but it is in protocol. Also it seems that Vypress Chat 1.9 has
278             preference for that.
279             Default: 0
280              
281             =over
282              
283             =item *
284             0 - male
285              
286             =item *
287             1 - female
288              
289             =back
290              
291             =item status
292             - current status. Default: 0
293              
294             =over
295              
296             =item *
297             0 - Active
298              
299             =item *
300             1 - Do Not Disturb
301              
302             =item *
303             2 - Away
304              
305             =item *
306             3 - Offline
307              
308             =back
309              
310             =item port
311             - UDP port to bind on. Default: 8167
312              
313             =item localip
314             - local IP address broadcast to. Used for multihomed hosts. Default: gets
315             current canonical hostname (like my.host.net) and converts it into ip address.
316             If it cannot do that or you don't have canonical hostname set up it will be set
317             to '127.0.0.1'. Note: module cannot function properly in such mode and you will
318             be warned in console. Also $vyc->{badip} variable will be set to 1.
319              
320             =item host
321             - your hostname. Defaults to: hostname()
322              
323             =item debug
324             - debug level. Debug messages are printed to STDOUT. Default: 0
325              
326             =over
327              
328             =item *
329             0 - no debug
330              
331             =item *
332             1 - actions level.
333              
334             =item *
335             2 - protocol level.
336              
337             =back
338              
339             =item uc_fail
340             - toggles sending thru broadcast socket when unicast socket fails (ip cannot be
341             found). Default: 1.
342              
343             =item coll_avoid
344             - toggle nick collision evasion. If someone changes nick to your nickname
345             modules will prepend number. Default: 1.
346              
347             =back
348              
349             =cut
350              
351             sub new { # {{{
352             # Shift module name.
353 1     1 1 14 shift;
354            
355             # Make a hash of rest args.
356 1         6 my %args = @_;
357 1         5 my $self = {};
358            
359 1         5 my @vars = qw(send listen init);
360 1         11 $self->{$_} = undef for (@vars);
361 1         4 $self->{nick} = "default";
362 1         2 $self->{oldnick} = "";
363 1   50     9 $self->{port} = $args{port} || 8167;
364 1   50     8 $self->{debug} = $args{debug} || 0;
365 1 50       6 $self->{uc_fail} = (defined $args{uc_fail}) ? $args{uc_fail} : 1;
366 1 50       5 $self->{coll_avoid} = (defined $args{coll_avoid}) ? $args{coll_avoid} : 1;
367 1 50       4 $self->{send_info} = (defined $args{send_info}) ? $args{send_info} : 1;
368 1 50       4 $self->{sign_topic} = (defined $args{sign_topic}) ? $args{sign_topic} : 1;
369 1   33     11 $self->{host} = $args{host} || hostname();
370 1   33     21 $self->{'localip'} = $args{'localip'}
371             || inet_ntoa(scalar gethostbyname($self->{host} || 'localhost'));
372 1 50 33     7 if (!defined $args{'localip'} && $self->{'localip'} eq "127.0.0.1") {
373 0         0 carp ("Your hostname resolution returned '127.0.0.1'. This probably "
374             ."indicates broken dns. Make sure that resolving your hostname "
375             ."returns your actual IP address. On most systems this can be done "
376             ."by editing /etc/resolv.conf file.\n");
377 0         0 $self->{badip} = 1;
378             }
379 1         6 return bless $self;
380             } # }}}
381              
382             =head2 init_users()
383              
384             Reinitialises userlist, but leaves information about self.
385              
386             E.g.: $vyc->init_users();
387              
388             =cut
389              
390             sub init_users { # {{{
391             # We need this function cause we store information about self in userlist too.
392             # So we can't just plain use $self->{'users'} = ().
393 3     3 1 6 my $self = shift;
394             # We save current values here...
395 3   50     34 my $tmpstatus = $self->{'users'}{$self->{'nick'}}{'status'} || 0;
396 3   50     22 my $tmpactive = $self->{'users'}{$self->{'nick'}}{'active'} || 0;
397 3   50     17 my $tmpgender = $self->{'users'}{$self->{'nick'}}{'gender'} || 0;
398 3   50     20 my $tmpaa = $self->{'users'}{$self->{'nick'}}{'autoanswer'} || '';
399 3   100     19 my @tmpchats = $self->{users}{$self->{nick}}{chats} || [];
400             # And then clear userlist and set those values back.
401 3         29 $self->{'users'} = {
402             $self->{'nick'} => {
403             'status' => $tmpstatus,
404             'active' => $tmpactive,
405             'gender' => $tmpgender,
406             'autoanswer' => $tmpaa,
407             'chats' => @tmpchats,
408             'ip' => $self->{localip},
409             }
410             };
411 3         16 $self->debug("init_users(), Status: "
412             . $self->num2status($tmpstatus). ", Active: "
413             . $self->num2active($tmpactive). ", Gender: "
414             . $tmpgender .", AA: $tmpaa.");
415             } # }}}
416              
417             =head2 change_net($port, $localip)
418              
419             Function to change network/port combination on the fly.
420              
421             E.g.: $vyc->change_net(8168, '10.0.0.1');
422              
423             =cut
424              
425             sub change_net { # {{{
426 0     0 1 0 my ($self, $port, $localip) = @_;
427 0 0 0     0 unless ($self->{'port'} eq $port && $self->{'localip'} eq $localip) {
428 0         0 $self->shutdown;
429 0         0 $self->{'port'} = $port;
430 0         0 $self->{'localip'} = $localip;
431 0         0 $self->startup;
432             }
433             else {
434 0         0 $self->debug("Ports are the same");
435             }
436 0         0 return 1;
437             } # }}}
438              
439             =head2 nick($nick)
440              
441             Changes your nickname that is being held in $object->{'nick'}. Truncates
442             it to 20 characters (maximum in protocol) and broadcasts it if module is initialised.
443              
444             E.g.: $vyc->nick("SimpleGuy");
445              
446             =cut
447              
448             sub nick { # {{{
449 1     1 1 3 my ($self, $nick) = @_;
450 1 50       7 if ($self->on_userlist($nick)) {
    50          
451 0         0 $self->debug("F: nick, Nick: $nick, Err: exists.");
452             }
453             elsif ($self->{'nick'} ne $nick) {
454 1         3 my $oldnick = $self->{'nick'};
455            
456             # Protocol doesn't allow nicks longer than 20 chars.
457             # In fact Windows clients even segfaults ;-)
458 1 50       4 $self->{'nick'} = (length($nick) > 20) ? substr($nick, 0, 20) : $nick;
459            
460             # We assign oldnick data structure here.
461 1         5 $self->{'users'}{$self->{'nick'}} = $self->{'users'}{$oldnick};
462 1         3 delete $self->{'users'}{$oldnick};
463              
464             # Changing in channels
465 1         5 $self->change_in_channels($oldnick, $self->{nick});
466            
467             # If we are connected to net announce nick change.
468 1 50 33     10 if (defined $self->{'send'} && $self->{init}) {
469 1         4 $self->{oldnick} = $oldnick;
470            
471 1         4 my $str = header()."3".$oldnick."\0".$self->{'nick'}."\0"
472             .$self->{'users'}{$self->{'nick'}}{'gender'};
473 1         6 $self->{'send'}->send($str);
474 1         71 $self->debug("F: nick(), Old: $oldnick, New: $self->{'nick'}", $str);
475             }
476             else {
477 0         0 $self->debug("F: nick(), Warn: network off.");
478             }
479             }
480             else {
481 0         0 $self->debug("F: nick(), E: Same nicks.");
482             }
483             } # }}}
484              
485             =head2 num2status($status)
486              
487             Translates numeric status to word status. Mainly used in module itself.
488              
489             E.g.: $vyc->num2status(0) would return Available.
490              
491             =cut
492              
493             sub num2status { # {{{
494 19     19 1 1809 my ($self, $status) = @_;
495 19 100       67 if ($status == 0) {
    100          
    100          
    50          
496 10         36 $self->debug("F: num2status(), Status: Available");
497 10         51 return "Available";
498             }
499             elsif ($status == 1) {
500 3         27 $self->debug("F: num2status(), Status: DND");
501 3         14 return "DND";
502             }
503             elsif ($status == 2) {
504 3         7 $self->debug("F: num2status(), Status: Away");
505 3         13 return "Away";
506             }
507             elsif ($status == 3) {
508 3         9 $self->debug("F: num2status(), Status: Offline");
509 3         16 return "Offline";
510             }
511             else {
512 0         0 $self->debug("F: num2status(), Status: Unknown");
513 0         0 return "Unknown";
514             }
515             } # }}}
516              
517             =head2 num2active($active)
518              
519             Does same as num2status(), but with active state.
520              
521             E.g.: $vyc->num2active(1) would return Active.
522              
523             =cut
524              
525             sub num2active { # {{{
526 12     12 1 25 my ($self, $status) = @_;
527 12 100       32 if ($status == 0) {
    100          
528 9         20 $self->debug("F: num2active(), Active: Inactive");
529 9         37 return "Inactive"
530             }
531             elsif ($status == 1) {
532 2         6 $self->debug("F: num2active(), Active: Active");
533 2         11 return "Active"
534             }
535             else {
536 1         12 $self->debug("F: num2active(), Active: Unknown");
537 1         5 return "Unknown"
538             }
539             } # }}}
540              
541             =head2 who()
542              
543             Asks who is here in LAN. Used to build user lists.
544              
545             E.g.: $vyc->who();
546              
547             =cut
548              
549             sub who { # {{{
550 2     2 1 4 my ($self) = @_;
551             # See init_users()
552 2         10 $self->init_users;
553 2         6 my $str = header()."0".$self->{'nick'}."\0";
554 2         14 $self->{'send'}->send($str);
555 2         139 $self->debug("Asked who is here with nick $self->{'nick'}", $str);
556             } # }}}
557              
558             =head2 remote_exec($to, $command, $password)
559              
560             Sends remote execution request.
561              
562             E.g.: $vyc->remote_exec("OtherGuy", "iexplore.exe", "secret");
563              
564             =cut
565              
566             sub remote_exec { # {{{
567 1     1 1 4 my ($self, $to, $command, $password) = @_;
568 1         3 my $str = header()."8".$self->{nick}."\0".$to."\0".$command."\0".$password
569             ."\0";
570 1         5 $self->usend($str, $to);
571 1         77 $self->debug("Sent remote execution request to $to:\n"
572             ."Password: $password\n"
573             ."Command line: $command\n", $str);
574             } # }}}
575              
576             =head2 remote_exec_ack($to, $execution_text)
577              
578             Returns execution status to requester.
579              
580             E.g.: $vyc->remote_exec_ack('OtherGuy', 'Some text');
581              
582             =cut
583              
584             sub remote_exec_ack { # {{{
585 1     1 1 287 my ($self, $to, $text) = @_;
586 1         3 my $str = header()."9".$to."\0".$self->{nick}."\0".$text."\0";
587 1         4 $self->usend($str, $to);
588 1         50 $self->debug("Sent remote execution acknowledgement to $to:\n"
589             ."Execution text: $text", $str);
590             } # }}}
591              
592             =head2 sound_req($channel, $filename)
593              
594             Send sound request to channel.
595              
596             E.g.: $vyc->sound_req("#Main", 'clap.wav');
597              
598             =cut
599              
600             sub sound_req { # {{{
601 1     1 1 264 my ($self, $chan, $file) = @_;
602 1         4 my $str = header()."I".$self->{nick}."\0".$file."\0".$chan."\0";
603 1         6 $self->usend_chan($str, $chan);
604 1         47 $self->debug("Sent sound request for file $file to $chan", $str);
605             } # }}}
606              
607             =head2 me($channel, $chat_string)
608              
609             Send chat string to channel in /me fashion.
610              
611             E.g.: $vyc->me("#Main", "jumps around.");
612              
613             =cut
614              
615             sub me { # {{{
616 1     1 1 275 my ($self, $chan, $text) = @_;
617 1         3 my $str = header()."A".$chan."\0".$self->{nick}."\0".$text."\0";
618 1         5 $self->usend_chan($str, $chan);
619 1         45 $self->debug("Did /me action in $chan: $text", $str);
620             } # }}}
621              
622             =head2 chat($channel, $chat_string)
623              
624             Sends chat string to channel.
625              
626             E.g.: $vyc->chat("#Main", "Hello!");
627              
628             =cut
629              
630             sub chat { # {{{
631 1     1 1 321 my ($self, $chan, $text) = @_;
632 1         5 my $str = header()."2".$chan."\0".$self->{'nick'}."\0".$text."\0";
633 1         5 $self->usend_chan($str, $chan);
634 1         60 $self->debug("Sent chat string to $chan: $text", $str);
635             } # }}}
636              
637             =head2 join($channel)
638              
639             Joins channel and adds it to channel list.
640              
641             E.g.: $vyc->join("#Main");
642              
643             =cut
644              
645             sub join { # Join to channel {{{
646 2     2 1 297 my ($self, $chan) = @_;
647 2 50       26 if (!$self->on_chan($self->{nick}, $chan)) {
648 2         7 my $str = header()."4".$self->{'nick'}."\0".$chan."\0"
649             .$self->{'users'}{$self->{'nick'}}{'status'}
650             .$self->{'users'}{$self->{'nick'}}{'gender'};
651             # if ($chan eq '#Main') {
652 2         15 $self->{send}->send($str);
653             # }
654             # else {
655             # $self->usend_chan($str, $chan);
656             # }
657 2         167 $self->add_to_channel($self->{nick}, $chan);
658 2         5 $self->{last_joined_chan} = $chan;
659 2         8 $self->debug("F: join(), Chan: $chan", $str);
660             }
661             else {
662 0         0 $self->debug("F: join(), Warn: already in $chan.");
663             }
664             } # }}}
665              
666             =head2 part($channel)
667              
668             Parts channel and deletes it from channel list.
669              
670             E.g.: $vyc->part("#Main");
671              
672             =cut
673              
674             sub part { # {{{
675 2     2 1 4 my ($self, $chan) = @_;
676 2 50       8 if ($self->on_chan($self->{nick}, $chan)) {
677 2         6 my $str = header()."5".$self->{'nick'}."\0".$chan."\0"
678             .$self->{'users'}{$self->{'nick'}}{'gender'};
679 2         7 $self->usend_chan($str, $chan);
680              
681 2         89 $self->delete_from_channel($self->{nick}, $chan);
682 2         7 $self->debug("F: part(), Chan: $chan", $str);
683             }
684             else {
685 0         0 $self->debug("F: part(), Chan: $chan, Err: not in chan.");
686             }
687             } # }}}
688              
689             =head2 topic($channel, $topic)
690              
691             Changes topic on channel. Adds your nick in ().
692              
693             E.g.: $vyc->topic("#Main", "Hi folks") would give this topic - "Hi folks (SimpleGuy)".
694              
695             =cut
696              
697             sub topic { # {{{
698 1     1 1 3 my ($self, $chan, $topic) = @_;
699 1         8 my $signature = '';
700 1 50 33     14 $signature = ' ('.$self->{'nick'}.')' if $topic && $self->{sign_topic};
701 1         4 my $str = header()."B".$chan."\0".$topic.$signature."\0";
702 1         4 $self->{'channels'}{$chan}{'topic'} = $topic;
703 1         3 $self->usend_chan($str, $chan);
704 1         47 $self->debug("F: topic(), Chan: $chan, Topic: \"$topic\"", $str);
705             } # }}}
706              
707              
708             =head2 msg($to, $message)
709              
710             Sends message to person.
711              
712             E.g.: $vyc->msg("John", "Hello there...");
713              
714             =cut
715              
716             sub msg { # {{{
717 1     1 1 2 my ($self, $to, $msg) = @_;
718 1         4 my $str = header()."6".$self->{'nick'}."\0".$to."\0".$msg."\0";
719 1         4 $self->usend($str, $to);
720 1         48 $self->debug("Sent msg for $to: \"$msg\"", $str);
721             } # }}}
722              
723             =head2 mass($message)
724              
725             Sends message to all people in userlist. The message is marked as multi-user message.
726              
727             E.g.: $vyc->mass("Hi everyone, I'm back.");
728              
729             =cut
730              
731             sub mass { # {{{
732 0     0 1 0 my ($self, $msg) = @_;
733 0         0 for (keys %{$self->{'users'}}) {
  0         0  
734 0 0       0 unless ($_ eq $self->{'nick'}) {
735 0         0 my $str = header()."E".$self->{'nick'}."\0".$_."\0".$msg."\0";
736 0         0 $self->usend($str, $_);
737 0         0 $self->debug("F: mass(), To: $_, Text: \"$msg\"", $str);
738             }
739             else {
740 0         0 $self->debug("F: mass(), Warn: send to self.");
741             }
742             }
743             } # }}}
744              
745             =head2 mass_to(@to, $message)
746              
747             Sends message to people in array. The message is marked as multi-user message.
748              
749             E.g.: $vyc->mass(('John', 'Paul'), "Hi everyone, I'm back.");
750              
751             =cut
752              
753             sub mass_to { # {{{
754 1     1 1 492 my $self = shift;
755 1         3 my $msg = pop;
756 1         2 my @to = @_;
757 1         11 for (@to) {
758 1         3 my $str = header()."E".$self->{'nick'}."\0".$_."\0".$msg."\0";
759 1         4 $self->usend($str, $_);
760 1         43 $self->debug("F: mass_to(), To: $_, Text: \"$msg\"", $str);
761             }
762             } # }}}
763              
764              
765             =head2 status($status, $autoanswer)
766              
767             Changes your status into one of four states mentioned in new() and
768             sets your autoanswer to messages.
769              
770             E.g.: $vyc->status(0, "I like core dumps (C) zed");
771              
772             =cut
773              
774             sub status { # {{{
775 4     4 1 1093 my $self = shift;
776             (
777 4         23 $self->{'users'}{$self->{'nick'}}{'status'},
778             $self->{'users'}{$self->{'nick'}}{'autoanswer'}
779             ) = @_;
780            
781 4 50       22 $self->{'users'}{$self->{'nick'}}{'autoanswer'} = '' unless
782             $self->{'users'}{$self->{'nick'}}{'autoanswer'};
783            
784 4 50       19 if ($self->{'send'}) {
785 4         10 my $str = header()."D".$self->{'nick'}."\0"
786             .$self->{'users'}{$self->{'nick'}}{'status'}
787             .$self->{'users'}{$self->{'nick'}}{'gender'}
788             .$self->{'users'}{$self->{'nick'}}{'autoanswer'}."\0";
789 4         16 $self->{'send'}->send($str);
790 4         172 $self->debug("F: status(), Status: "
791             . $self->num2status($self->{'users'}{$self->{'nick'}}{'status'})
792             . ", AA: \"$self->{'users'}{$self->{'nick'}}{'autoanswer'}\"."
793             , $str);
794             }
795             } # }}}
796              
797             =head2 active($activity)
798              
799             Sets your activity. See new().
800              
801             E.g.: $vyc->active(1);
802              
803             =cut
804              
805             sub active { # {{{
806 2     2 1 560 my $self = shift;
807 2         9 ($self->{'users'}{$self->{'nick'}}{'active'}) = @_;
808 2         6 my $str = header()."M".$self->{'nick'}."\0"
809             .$self->{'users'}{$self->{'nick'}}{'active'};
810 2         9 $self->{'send'}->send($str);
811 2         106 $self->debug("F: active(), Active: "
812             . $self->num2active($self->{'users'}{$self->{'nick'}}{'active'}), $str);
813             } # }}}
814              
815             =head2 beep($to)
816              
817             Beeps user.
818              
819             E.g.: $vyc->beep('OtherGuy');
820              
821             =cut
822              
823             sub beep { # {{{
824 1     1 1 300 my ($self, $to) = @_;
825 1         14 my $str = header()."H0".$to."\0".$self->{send}."\0";
826 1         5 $self->usend($str, $to);
827 1         51 $self->debug("F: beep(), To: $to", $str);
828             } # }}}
829              
830             =head2 chanlist()
831              
832             Requests channel list. Todo: Maybe specification is bad? Don't use it for now.
833              
834             E.g.: $vyc->chanlist();
835              
836             =cut
837              
838             sub chanlist { # {{{
839 0     0 1 0 my ($self) = @_;
840 0         0 my $str = header()."N".$self->{nick}."\0";
841 0         0 $self->{send}->send($str);
842 0         0 $self->debug("F: chanlist()", $str);
843             } # }}}
844              
845             =head2 info($user)
846              
847             Asks user to give his information.
848              
849             E.g.: $vyc->info("John");
850              
851             =cut
852              
853             sub info { # {{{
854 1     1 1 8 my ($self, $to) = @_;
855 1         3 my $str = header()."F".$to."\0".$self->{'nick'}."\0";
856 1         4 $self->usend($str, $to);
857 1         40 $self->debug("F: info(), To: $to", $str);
858             } # }}}
859              
860             =head2 info_ack($user)
861              
862             Sends user your information.
863              
864             E.g.: $vyc->info_ack("John");
865              
866             By default module sends following information automatically
867             whenever requested by another client (see new()):
868              
869             =over
870              
871             =item host
872             - see new();
873              
874             =item user
875             - gets enviroment variable USER;
876              
877             =item channel list
878             - gets it from $self->{users}{$self->{nick}}{channels};
879              
880             =item auto answer
881             - gets it from $self->{users}{$self->{nick}}{autoanswer}
882              
883             =back
884              
885             =head2 info_ack($user, $host, $ip, $user, $channels, $autoanswer)
886              
887             If you turn off send_info variable (see new()) module won't send
888             any information automatically. Then you can access this method to
889             generate answer for information request.
890              
891             Channels variable can have these values:
892              
893             =over
894              
895             =item *
896             1 - send actual channel list
897              
898             =item *
899             0 - send nothing but #Main
900              
901             =item *
902             array - array of channels.
903              
904             =back
905              
906             E.g.: $vyc->info_ack("John", "made.up.host", "user", "1.2.3.4",
907             ['#Main'], "");
908              
909             =cut
910              
911             sub info_ack { # {{{
912 2     2 1 663 my ($self, $to, $host, $ip, $user, $chans, $aa) = @_;
913 2 100       8 $host = $self->{host} unless $host;
914 2 100       16 $ip = $self->{localip} unless $ip;
915 2 100       8 $user = $ENV{USER} unless $user;
916 2 100       9 $aa = $self->{users}{$self->{nick}}{autoanswer} unless $aa;
917              
918 2 100 66     21 if (!defined $chans || $chans eq '1') {
    50          
919 1         6 $chans = CORE::join '', $self->get_chans($self->{nick});
920             }
921             elsif ($chans eq '0') {
922 0         0 $chans = '#Main';
923             }
924             else {
925 1         2 my $tempchans;
926 1         2 $tempchans .= $_ for @{$chans};
  1         5  
927 1         4 $chans = $tempchans;
928             }
929            
930 2         6 my $str = header() ."G". $to ."\0". $self->{'nick'} ."\0". $host
931             ."\0". $user ."\0". $ip ."\0". $chans ."#\0"
932             . $aa ."\0";
933 2         9 $self->usend($str, $to);
934 2         127 $self->debug("F: info_ack(), To: $to, Nick: $self->{'nick'}, Host: $host "
935             . "User: $user, IP: $ip, Chans: $chans, AA: $aa", $str);
936             } # }}}
937              
938             =head2 pjoin($user)
939              
940             Joins to private chat.
941              
942             E.g.: $vyc->pjoin("John");
943              
944             =cut
945              
946             sub pjoin { # {{{
947 2     2 1 4 my ($self, $to) = @_;
948 2 50       5 unless ($self->on_priv($to)) {
949 2         26 my $str = header() ."J0". $self->{nick} ."\0". $to ."\0"
950             . $self->{users}{$self->{nick}}{gender};
951 2         11 $self->usend($str, $to);
952 2         83 $self->add_to_private($to);
953 2         8 $self->debug("F: pjoin(), To: $to", $str);
954             }
955             else {
956 0         0 $self->debug("F: pjoin(), To: $to, Err: Already in.");
957             }
958             } # }}}
959              
960             =head2 ppart($user)
961              
962             Parts private chat.
963              
964             E.g.: $vyc->ppart("John");
965              
966             =cut
967              
968             sub ppart { # {{{
969 1     1 1 3 my ($self, $to) = @_;
970 1 50       4 if ($self->on_priv($to)) {
971 1         3 my $str = header() ."J1". $self->{nick} ."\0". $to ."\0"
972             . $self->{users}{$self->{nick}}{gender};
973 1         4 $self->usend($str, $to);
974 1         40 $self->delete_from_private($to);
975 1         4 $self->debug("F: ppart(), To: $to", $str);
976             }
977             else {
978 0         0 $self->debug("F: ppart(), To: $to, Err: Already out.");
979             }
980             } # }}}
981              
982             =head2 pchat($user, $text)
983              
984             Sends string to private chat.
985              
986             E.g.: $vyc->pchat("John", "Some message");
987              
988             =cut
989              
990             sub pchat { # {{{
991 1     1 1 4 my ($self, $to, $text) = @_;
992 1 50       4 $text = '' unless $text;
993 1 50       5 if ($self->on_priv($to)) {
994 1         14 my $str = header() ."J2". $self->{nick} ."\0". $to ."\0"
995             . $text ."\0";
996 1         4 $self->usend($str, $to);
997 1         51 $self->debug("F: pchat(), To: $to", $str);
998             }
999             else {
1000 0         0 $self->debug("F: pchat(), To: $to, Err: not in chat.");
1001             }
1002             } # }}}
1003              
1004             =head2 pme($user, $text)
1005              
1006             Sends /me action to private chat.
1007              
1008             E.g.: $vyc->pme("John", "Some action");
1009              
1010             =cut
1011              
1012             sub pme { # {{{
1013 1     1 1 2 my ($self, $to, $text) = @_;
1014 1 50       5 $text = '' unless $text;
1015 1 50       11 if ($self->on_priv($to)) {
1016 1         3 my $str = header() ."J3". $self->{nick} ."\0". $to ."\0"
1017             . $text ."\0";
1018 1         4 $self->usend($str, $to);
1019 1         39 $self->debug("F: pme(), To: $to", $str);
1020             }
1021             else {
1022 0         0 $self->debug("F: pme(), To: $to, Err: not in chat.");
1023             }
1024             } # }}}
1025              
1026              
1027             =head2 startup()
1028              
1029             Initialises two sockets (send and listen) for sending UDP messages and getting them.
1030             Also joins channel #Main and requests who list.
1031              
1032             E.g.: $vyc->startup;
1033              
1034             =cut
1035              
1036             sub startup { # {{{
1037 1     1 1 1270 my $self = shift;
1038             # First users hash...
1039 1         7 $self->init_users();
1040             # Outgoing port.
1041 1         8 $self->debug("Trying to open socket from $self->{localip} to port "
1042             ."$self->{port}...");
1043 1   33     33 $self->{'send'} = IO::Socket::INET->new(
1044             PeerAddr => inet_ntoa(INADDR_BROADCAST),
1045             PeerPort => $self->{'port'},
1046             Proto => 'udp',
1047             LocalAddr => $self->{'localip'},
1048             Type => SOCK_DGRAM,
1049             Broadcast => 1 ) || croak ("Failed! ($!)");
1050 1         522 $self->debug("Success.");
1051             # Outgoing unicast port.
1052 1         8 $self->debug("Trying to open unicast socket from $self->{localip} to port "
1053             ."$self->{port}...");
1054 1   33     7 $self->{'usend'} = IO::Socket::INET->new(
1055             PeerPort => $self->{'port'},
1056             Proto => 'udp',
1057             Type => SOCK_DGRAM,
1058             LocalAddr => $self->{'localip'}
1059             ) || croak ("Failed! ($!)");
1060 1         192 $self->debug("Success.");
1061              
1062             # Incoming port.
1063 1         8 $self->debug("Trying to estabilsh socket on $self->{localip}:"
1064             ."$self->{port}...");
1065 1   33     63 $self->{'listen'} = IO::Socket::INET->new (
1066             # LocalAddr => $self->{'localip'},
1067             LocalPort => $self->{'port'},
1068             ReuseAddr => 0,
1069             Type => SOCK_DGRAM,
1070             # Listen => 1,
1071             Proto => 'udp') || croak ("Failed! ($!)");
1072 1         190 $self->debug("Success.");
1073              
1074             # We'll use this later to check if we're on the net.
1075 1         2 $self->{'init'} = 1;
1076             # We gotta be on #Main all the time ;-)
1077 1         7 $self->join("#Main");
1078 1         5 $self->who();
1079             } # }}}
1080              
1081             =head2 shutdown()
1082              
1083             Ends module job. Exits all channels and closes all sockets.
1084              
1085             E.g.: $vyc->shutdown();
1086              
1087             =cut
1088              
1089             sub shutdown { # {{{
1090 1     1 1 430 my $self = shift;
1091 1         4 $self->part($_) for $self->get_chans($self->{nick});
1092             # Close sockets
1093 1         13 $self->{'listen'}->close();
1094 1         56 $self->{'send'}->close();
1095 1         23 $self->{'usend'}->close();
1096             # Undef sockets
1097 1         18 undef $self->{'listen'};
1098 1         12 undef $self->{'send'};
1099 1         5 undef $self->{'usend'};
1100             # We'll use this later to check if we're on the net.
1101 1         4 $self->{'init'} = 0;
1102             } # }}}
1103              
1104             =head2 on_chan($channel)
1105              
1106             Checks if you are on some specific channel.
1107              
1108             E.g.: $vyc->on_chan("#Main") would return 1.
1109              
1110             =head2 on_chan($nick, $channel)
1111              
1112             Checks if someone are on some specific channel.
1113              
1114             =cut
1115              
1116             sub on_chan { # {{{
1117 14     14 1 341 my ($self, $nick, $chan) = @_;
1118 14 100       39 unless (defined $chan) {
1119 6         10 $chan = $nick;
1120 6         11 $nick = $self->{nick};
1121             }
1122 14 100 66     51 if (
1123 10         143 defined $self->{channels}{$chan} &&
1124             grep(/^\Q$nick\E$/, @{$self->{channels}{$chan}{users}})
1125             ) {
1126 10         38 $self->debug("F: on_chan(), Nick: $nick, Chan: $chan, Status: 1");
1127 10         57 return 1;
1128             }
1129             else {
1130 4         19 $self->debug("F: on_chan(), Nick: $nick, Chan: $chan, Status: 0");
1131 4         21 return 0;
1132             }
1133             } # }}}
1134              
1135             =head2 on_priv($person)
1136              
1137             Checks if you are in private chat with someone.
1138              
1139             E.g.: $vyc->on_priv("John") would return 1 if you were in chat with John.
1140              
1141             =cut
1142              
1143             sub on_priv { # {{{
1144 8     8 1 324 my ($self, $to) = @_;
1145 8 100       9 if (grep(/^\Q$to\E$/, @{$self->{users}{$self->{nick}}{chats}})) {
  8         83  
1146 4         15 $self->debug("F: on_priv(), To: $to, Status: 1");
1147 4         17 return 1;
1148             }
1149             else {
1150 4         14 $self->debug("F: on_priv(), To: $to, Status: 0");
1151 4         14 return 0;
1152             }
1153             } # }}}
1154              
1155             =head2 on_userlist($user)
1156              
1157             Checks if user is in userlist.
1158              
1159             E.g.: $vyc->on_userlist("Dude") would return 1 if Dude would be logged in.
1160              
1161             =cut
1162              
1163             sub on_userlist { # {{{
1164 4     4 1 8 my ($self, $user) = @_;
1165 4 100       6 if (grep(/^\Q$user\E$/, keys %{$self->{'users'}})) {
  4         82  
1166 3         11 $self->debug("F: on_userlist(), User: $user, Status: 1");
1167 3         12 return 1
1168             }
1169             else {
1170 1         6 $self->debug("F: on_userlist(), User: $user, Status: 0");
1171 1         7 return 0;
1172             }
1173             } # }}}
1174              
1175             =head2 get_chans($nick)
1176              
1177             Returns array containing all channels user is on.
1178              
1179             E.g.: @chans = $vyc->get_chans('John');
1180              
1181             =cut
1182              
1183             sub get_chans { # {{{
1184 2     2 1 4 my ($self, $nick) = @_;
1185 2         3 my (@chans, $chans);
1186 2         3 for (keys %{$self->{channels}}) {
  2         11  
1187 2 50       4 if (grep /^\Q$nick\E$/, @{$self->{channels}{$_}{users}}) {
  2         33  
1188 2         6 push @chans, $_;
1189 2         5 $chans .= $_;
1190             }
1191             }
1192 2         11 $self->debug("F: get_chans(), Nick: $nick, Chans: $chans");
1193 2         12 return @chans;
1194             } # }}}
1195              
1196             =head2 readsock()
1197              
1198             Reads socket and recognises string it received.
1199             Returns array. See recognise().
1200              
1201             E.g.:
1202              
1203             while (my @args = $vyc->readsock()) {
1204             # Remove first array element.
1205             my $packet_type = shift @args;
1206             if ($packet_type eq 'msg') {
1207             my ($from, $message) = @args;
1208             }
1209             }
1210              
1211             =cut
1212              
1213             sub readsock { # {{{
1214 32     32 1 256 my $self = shift;
1215 32         37 my $buffer;
1216 32         116 my $ip = $self->{'listen'}->recv($buffer, 1024);
1217 32         532 (undef, $ip) = sockaddr_in($ip);
1218 32         376 $ip = inet_ntoa($ip);
1219 32         84 return $self->recognise($buffer, $ip);
1220             } # }}}
1221              
1222             =head2 recognise($buffer, $ip)
1223              
1224             Recognises string in a buffer if it is Vypress Chat protocol command.
1225             Returns type of command and its arguments. Also executes actions when needed.
1226              
1227             Values are returned in array. First value will always be type of command.
1228             Other values may differ. Possible values are:
1229              
1230             =cut
1231              
1232             sub recognise {
1233 32     32 1 60 my ($self, $buffer, $ip) = @_;
1234 32         46 my @re;
1235 32 50       144 if ($buffer eq 'IPTEST') {
    50          
1236 0         0 return $ip;
1237             }
1238             elsif ($buffer !~ /^\x58.{9}/) {
1239 0         0 return ("badpckt");
1240             }
1241             else {
1242 32         61 @re = ("unknown");
1243             }
1244 32         120 my @args = split /\0/, substr $buffer, 11;
1245 32         59 my $pkttype = substr $buffer, 10, 1;
1246              
1247             =head4 who is here
1248              
1249             Returns: "who", $updater.
1250              
1251             =cut
1252              
1253             # Who's here?
1254 32 100       68 if ($pkttype eq '0') { # {{{
1255 2         3 my $updater = $args[0];
1256 2         8 $self->debug("F: recognise(), Type: who, From: $updater", $buffer);
1257 2         11 $self->i_am_here($updater);
1258 2         6 @re = ("who", $updater);
1259             } # }}}
1260              
1261             =head4 I am here
1262              
1263             Returns: "who_ack", $from, $status, $active
1264              
1265             =cut
1266              
1267             # I'm here
1268 32 100       330 if ($pkttype eq '1') { # {{{
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    50          
    100          
1269 2         5 my ($updater, $responder, $statusactive) = @args;
1270 2         11 my ($status, $active) = split //, $statusactive;
1271 2 50 33     18 if (($updater eq $self->{'nick'}) &&
      33        
1272             (
1273             ($responder eq $self->{'nick'}) ||
1274             (!$self->on_userlist($responder))
1275             )
1276             ) {
1277 2         8 $self->debug("F: recognise(), T: who_ack, From: $responder, Status: "
1278             . $self->num2status($status) .", Active: "
1279             . $self->num2active($active)
1280             , $buffer);
1281 2         6 $self->{users}{$responder}{status} = $status;
1282 2         5 $self->{users}{$responder}{active} = $active;
1283 2         5 $self->{users}{$responder}{ip} = $ip;
1284 2 50       5 $self->add_to_channel($updater, '#Main') unless $self->on_chan('#Main');
1285 2         7 @re = ("who_ack", $responder, $status, $active);
1286             }
1287             } # }}}
1288              
1289             =head4 channel chat
1290              
1291             Returns: "chat", $chan, $from, $text
1292              
1293             =cut
1294              
1295             # Channel chat
1296             elsif ($pkttype eq '2') { # {{{
1297 1         3 my ($chan, $from, $text) = @args;
1298 1 50       71 if ($self->on_userlist($from)) {
1299 1 50       5 $text = '' unless $text;
1300 1 50 33     8 if ($chan && $from) {
1301 1 50       5 if ($self->on_chan($self->{nick}, $chan)) {
1302 1         5 $self->debug($chan .":<$from> $text", $buffer);
1303 1         5 @re = ("chat", $chan, $from, $text);
1304             }
1305             }
1306             }
1307             } # }}}
1308              
1309             =head4 nick change
1310              
1311             Returns: "nick", $oldnick, $newnick
1312              
1313             =cut
1314              
1315             # Nick change
1316             elsif ($pkttype eq '3') { # {{{
1317 1         3 my ($oldnick, $newnick) = @args;
1318 1 0 33     7 if ($ip ne $self->{localip} &&
      33        
1319             $self->on_userlist($oldnick) &&
1320             $oldnick ne $newnick) {
1321 0 0 0     0 if ($oldnick eq $self->{oldnick}) {
    0          
1322 0         0 $self->{oldnick} = '';
1323             }
1324             elsif ($newnick eq $self->{nick} && $self->{coll_avoid}) {
1325 0         0 for (0..99) {
1326 0         0 my $nick = $self->{nick};
1327 0         0 $nick =~ s/^\[\d*\]//;
1328 0 0       0 unless ($self->on_userlist("[$_]".$nick)) {
1329 0         0 $self->nick("[$_]".$nick);
1330 0         0 last;
1331             }
1332             }
1333             }
1334 0         0 $self->{'users'}{$newnick} = $self->{'users'}{$oldnick};
1335 0         0 delete $self->{'users'}{$oldnick};
1336 0         0 $self->debug("F: recognise(), T: nick, From: $oldnick, To: $newnick"
1337             , $buffer);
1338 0         0 @re = ("nick", $oldnick, $newnick);
1339             }
1340             } # }}}
1341              
1342             =head4 channel join
1343              
1344             Returns: "join", $from, $chan, $status
1345              
1346             =cut
1347              
1348             elsif ($pkttype eq '4') { # {{{
1349 2         4 my ($who, $chan, $status) = @args;
1350 2         5 $status = substr $status, 0, 1;
1351 2 50       10 if ($ip ne $self->{localip}) {
1352 0 0       0 if ($self->{last_joined_chan} eq $chan) {
    0          
1353 0         0 $self->{last_joined_chan} = '';
1354             }
1355             elsif ($who eq $self->{nick}) {
1356 0         0 for (0..99) {
1357 0         0 my $nick = $self->{nick};
1358 0         0 $nick =~ s/^\[\d*\]//;
1359 0 0       0 unless ($self->on_userlist("[$_]".$nick)) {
1360 0         0 $self->nick("[$_]".$nick);
1361 0         0 last;
1362             }
1363             }
1364             }
1365 0 0       0 if ($self->on_chan($chan)) {
1366 0         0 $self->debug("F: recognise(), T: join, From: $who, "
1367             . "Chan: $chan, Status: "
1368             . $self->num2status($status)
1369             , $buffer);
1370              
1371 0         0 $self->send_topic($who, $chan);
1372 0         0 $self->{users}{$who}{status} = $status;
1373 0         0 $self->{users}{$who}{active} = 1;
1374 0         0 $self->{users}{$who}{ip} = $ip;
1375 0         0 $self->add_to_channel($who, $chan);
1376 0         0 @re = ("join", $who, $chan, $status);
1377             }
1378             }
1379             } # }}}
1380              
1381             =head4 channel part
1382              
1383             Returns: "part", $who, $chan
1384              
1385             =cut
1386              
1387             elsif ($pkttype eq '5') { # {{{
1388 1         4 my ($who, $chan) = @args;
1389 1 50 33     6 if ($who ne $self->{nick} && $self->on_chan($who, $chan)) {
1390 0         0 $self->delete_from_channel($who, $chan);
1391 0         0 $self->debug("F: recognise(), T: part, From: $who, Chan: $chan", $buffer);
1392 0         0 @re = ("part", $who, $chan);
1393             }
1394             } # }}}
1395              
1396             =head4 message
1397              
1398             Returns: "msg", $from, $text
1399              
1400             =cut
1401              
1402             # Message
1403             elsif ($pkttype eq '6') { # {{{
1404 1         3 my ($from, $to, $text) = @args;
1405 1 50       4 if ($self->on_userlist($from)) {
1406 1 50       4 $text = '' unless $text;
1407 1 50       11 if ($to eq $self->{'nick'}) {
1408 1         5 $self->debug("F: recognise(), T: msg, From: $from, Msg: \"$text\""
1409             , $buffer);
1410 1         4 $self->msg_ack($from);
1411 1         3 @re = ("msg",$from,$text);
1412             }
1413             }
1414             } # }}}
1415              
1416             =head4 mass message
1417              
1418             Returns: "mass", $from, $text
1419              
1420             =cut
1421              
1422             # Mass message
1423             elsif ($pkttype eq 'E') { # {{{
1424 1         90 my ($from, $to, $text) = @args;
1425 1 50       5 if ($self->on_userlist($from)) {
1426 1 50       5 $text = '' unless $text;
1427             #$buffer =~ /^\x58.{9}E(.+?)\0(.+?)\0(.+?)\0+$/s;
1428 1 50       34 if ($to eq $self->{'nick'}) {
1429 1         6 $self->debug("Got mass msg from $from:\n$text", $buffer);
1430 1         3 $self->msg_ack($from);
1431 1         3 @re = ("mass", $from, $text);
1432             }
1433             }
1434             } # }}}
1435              
1436             =head4 message acknowledgment
1437              
1438             Returns: "msg_ack", $from, $aa, $status, $gender
1439              
1440             =cut
1441              
1442             # Msg acck
1443             elsif ($pkttype eq '7') { # {{{
1444 1         3 my ($to, $from, $aa) = @args;
1445 1         4 my $status = substr $to, 0, 1, '';
1446 1         3 my $gender = substr $aa, 0, 1, '';
1447             #$buffer =~ /^\x58.{9}7([0123])(.+?)\0(.+?)\0([01])(.*)\0+$/s;
1448 1 50       5 if ($to eq $self->{'nick'}) {
1449 1         4 $self->{'users'}{$from}{'status'} = $status;
1450 1         4 $self->debug("Got msg ack that $from received msg with aa: $aa",
1451             $buffer);
1452 1         4 @re = ("msg_ack", $from, $aa, $status, $gender);
1453             }
1454             } # }}}
1455              
1456             =head4 remote execution
1457              
1458             Returns: "remote_exec", $who, $command, $password
1459              
1460             =cut
1461              
1462             elsif ($pkttype eq '8') {
1463             # {{{
1464 1         3 my ($who, $to, $cmd, $pass) = @args;
1465 1 50       5 $cmd = '' unless $cmd;
1466 1 50       5 $pass = '' unless $pass;
1467 1 50       16 if ($to eq $self->{nick}) {
1468 1         6 $self->debug("Remote execution req. from $who: $cmd (pw: $pass)",
1469             $buffer);
1470 1         3 @re = ("remote_exec", $who, $cmd, $pass);
1471             }
1472             # }}}
1473             }
1474              
1475             =head4 remote execution acknowledgement
1476              
1477             Returns: "remote_exec_ack", $from_who, $execution_text
1478              
1479             =cut
1480              
1481             elsif ($pkttype eq '9') {
1482             # {{{
1483 1         2 my ($to, $from, $text) = @args;
1484 1 50       5 $text = '' unless $text;
1485 1 50       5 if ($to eq $self->{nick}) {
1486 1         6 $self->debug("Remote exec ack from $from: $text", $buffer);
1487 1         3 @re = ("remote_exec_ack", $from, $text);
1488             }
1489             # }}}
1490             }
1491              
1492             =head4 channel /me
1493              
1494             Returns: "me", $chan, $fromwho, $text
1495              
1496             =cut
1497              
1498             # /me on chan
1499             elsif ($pkttype eq 'A') {
1500             # {{{
1501 1         3 my ($chan, $fromwho, $text) = @args;
1502 1 50       4 $text = '' unless $text;
1503 1 50 33     18 if ($chan && $fromwho) {
1504 1 50       4 if ($self->on_chan($self->{nick}, $chan)) {
1505 1         5 $self->debug("$chan * $fromwho $text", $buffer);
1506 1         3 @re = ("me", $chan, $fromwho, $text);
1507             }
1508             }
1509             # }}}
1510             }
1511              
1512             =head4 topic change
1513              
1514             Returns: "topic", $chan, $topic
1515              
1516             =cut
1517              
1518             # Topic change
1519             elsif ($pkttype eq 'B') {
1520             # {{{
1521 1         3 my ($chan, $topic) = @args;
1522             #$buffer =~ /^\x58.{9}B(#.+?)\0(.*)\0+$/s;
1523              
1524 1 50       4 if ($self->on_chan($self->{nick}, $chan)) {
1525 1         4 $self->{'channels'}{$chan}{'topic'} = $topic;
1526 1         7 $self->debug("Topic changed on $chan:\n$topic", $buffer);
1527 1         3 @re = ("topic", $chan, $topic);
1528             }
1529             # }}}
1530             }
1531              
1532             =head4 topic send
1533              
1534             Returns: "topic", $chan, $topic
1535              
1536             =cut
1537              
1538             # Topic send
1539             elsif ($pkttype eq 'C') {
1540             # {{{
1541 0         0 my ($forwho, $chan, $topic) = @args;
1542 0 0       0 $topic = '' unless $topic;
1543             #$buffer =~ /^\x58.{9}C(.+?)\0(#.+?)\0(.+?)\0+$/s;
1544 0 0 0     0 if (
1545             !$self->{'channels'}{$chan}{'topic'} &&
1546             ($forwho eq $self->{'nick'})
1547             ) {
1548 0         0 $self->{'channels'}{$chan}{'topic'} = $topic;
1549 0         0 $self->debug("Topic for $chan ["
1550             .gethostbyaddr($self->{'listen'}->peeraddr, AF_INET)." "
1551             .$self->{'listen'}->peerhost."]:\n"
1552             .$self->{'channels'}{$chan}{'topic'}, $buffer);
1553 0         0 @re = ("topicsend", $chan, $topic);
1554             }
1555             else {
1556 0         0 $self->debug("Topic for $chan is already known.", $buffer);
1557             }
1558             # }}}
1559             }
1560              
1561             =head4 status change
1562              
1563             Returns: "statuschange", $status, $aa
1564              
1565             =cut
1566              
1567             # Status change
1568             elsif ($pkttype eq 'D') {
1569             # {{{
1570 4         7 my ($who, $temp) = @args;
1571 4         10 my ($status, $gender, $aa) = split //, $temp, 3;
1572             #$buffer =~ /^\x58.{9}D(.+?)\0([0123])[01](.*)\0+$/s;
1573 4         13 $self->debug("$who changed status to "
1574             .$self->num2status($status)." ($aa)", $buffer);
1575 4 50       15 if ($who ne $self->{'nick'}) {
1576 0         0 $self->{'users'}{$who}{'status'} = $status;
1577 0         0 $self->{'users'}{$who}{'autoanswer'} = $aa;
1578             }
1579 4         11 @re = ("status", $who);
1580             # }}}
1581             }
1582              
1583             =head4 info request
1584              
1585             Returns: "info", $from
1586              
1587             =cut
1588              
1589             # Info req.
1590             elsif ($pkttype eq 'F') {
1591             # {{{
1592 1         2 my ($forwho,$from) = @args;
1593             #$buffer =~ /^\x58.{9}F(.+?)\0(.+?)\0+$/;
1594 1 50       31 if ($forwho =~ $self->{'nick'}) {
1595 1         5 $self->debug("F: recognise(), T: info, From: $from", $buffer);
1596 1 50       5 $self->info_ack($from) if $self->{send_info};
1597 1         3 @re = ("info", $from);
1598             }
1599             # }}}
1600             }
1601              
1602             =head4 info request acknowledgment
1603              
1604             Returns: "info_ack", $from, $host, $user, $ip, $chans, $aa
1605              
1606             =cut
1607              
1608             # Info req. ack.
1609             elsif ($pkttype eq 'G') { # {{{
1610 2         7 my ($forwho, $from, $host, $user, $ip, $chans, $aa) = @args;
1611             #$buffer =~ /^\x58.{9}G(.+?)\0(.+?)\0(.+?)\0(.+?)\0(.+?)\0#(.+?)#\0(.+?)\0+$/s;
1612 2 50       10 if ($forwho eq $self->{'nick'}) {
1613             # Remove #'s from end of string.
1614 2         25 $chans =~ s/^#*(.+?)#*$/$1/;
1615 2         6 my @chans = split(/#/, $chans);
1616 2         3 $chans = undef;
1617 2         4 foreach (@chans) { $chans .= "#$_,"; }
  3         8  
1618 2         5 chop $chans;
1619 2         12 $self->debug("F: recognise(), T: info_ack, From: $from, Host: $host, "
1620             . "User: $user, Ip: $ip, Chans: $chans, AA: $aa"
1621             , $buffer);
1622 2         8 @re = ("info_ack", $from, $host, $user, $ip, $chans, $aa);
1623             }
1624             } # }}}
1625            
1626             =head4 beep
1627              
1628             Returns: "beep", $from
1629              
1630             =cut
1631              
1632             =head4 beep acknowledgement
1633              
1634             Returns: "beep_ack", $from, $gender
1635              
1636             =cut
1637              
1638             elsif ($pkttype eq 'H') {
1639             # {{{
1640             # we split second type here.
1641 1         4 my ($pkttype, $to) = split //, $args[1], 2;
1642 1         3 shift @args;
1643 1         3 my ($from, $gender) = @args;
1644 1 50       6 if ($to eq $self->{nick}) {
1645 0 0       0 if ($pkttype eq '0') {
    0          
1646 0         0 $self->debug("F: recognise(), Type: beep, From: $from", $buffer);
1647 0         0 @re = ("beep", $from);
1648             }
1649             elsif ($pkttype eq '1') {
1650 0         0 $self->debug("F: recognise(), Type: beep_ack, From: $from", $buffer);
1651 0         0 @re = ("beep_ack", $from, $gender);
1652             }
1653             }
1654             # }}}
1655             }
1656              
1657             =head4 sound request
1658              
1659             Returns: "sound_req", $from, $filename, $channel
1660              
1661             =cut
1662              
1663             elsif ($pkttype eq 'I') {
1664             # {{{
1665 1         3 my ($from, $file, $chan) = @args;
1666 1 50       4 $file = '' unless $file;
1667 1 50       5 if ($self->on_chan($self->{nick}, $chan)) {
1668 1         4 $self->debug("$from requested sound: $file", $buffer);
1669 1         4 @re = ("sound_req", $from, $file, $chan);
1670             }
1671             # }}}
1672             }
1673            
1674             =head4 private chat join
1675              
1676             Returns: "pjoin", $from
1677              
1678             =head4 private chat leave
1679              
1680             Returns: "ppart", $from
1681              
1682             =head4 private chat string
1683              
1684             Returns: "pchat", $from, $text
1685              
1686             =head4 private chat /me
1687              
1688             Returns: "pme", $from, $text
1689              
1690             =cut
1691              
1692             elsif ($pkttype eq 'J') { # {{{
1693 5         12 my ($temp, $to, $text) = @_;
1694 5         13 my ($subtype, $from) = split //, $temp, 2;
1695 5 50       14 if ($to eq $self->{nick}) {
1696 0 0       0 if ($subtype eq '0') {
    0          
    0          
    0          
1697 0         0 $self->add_to_private($from);
1698 0         0 $self->debug("F: recognise(), T: pjoin, From: $from", $buffer);
1699 0         0 @re = ("pjoin", $from);
1700             }
1701             elsif ($subtype eq '1') {
1702 0         0 $self->delete_from_private($from);
1703 0         0 $self->debug("F: recognise(), T: ppart, From: $from", $buffer);
1704 0         0 @re = ("ppart", $from);
1705             }
1706             elsif ($subtype eq '2') {
1707 0         0 $self->debug("F: recognise(), T: pchat, From: $from, Text: \"$text\""
1708             , $buffer);
1709 0         0 @re = ("pchat", $from, $text);
1710             }
1711             elsif ($subtype eq '3') {
1712 0         0 $self->debug("F: recognise(), T: pme, From: $from, Text: \"$text\""
1713             , $buffer);
1714 0         0 @re = ("pme", $from, $text);
1715             }
1716             }
1717             } # }}}
1718            
1719             =head4 here request
1720              
1721             Returns: "here", $fromwho, $chan
1722              
1723             =cut
1724              
1725             # Here req.
1726             elsif ($pkttype eq 'L') {
1727             # {{{
1728 0         0 my ($fromwho, $chan) = @args;
1729             #$buffer =~ /^\x58.{9}L(.+?)\0(#.+?)\0+$/;
1730 0 0       0 if ($self->on_chan($self->{nick}, $chan)) {
1731 0         0 $self->debug("$fromwho requested here on $chan", $buffer);
1732 0         0 $self->here_ack($fromwho, $chan);
1733 0         0 @re = ("here", $fromwho, $chan);
1734             }
1735             # }}}
1736             }
1737              
1738             =head4 here acknowledgement
1739              
1740             Returns: "here_ack", $from, $chan, $active
1741              
1742             =cut
1743              
1744             elsif ($pkttype eq 'K') {
1745             # {{{
1746 0         0 my ($to, $chan, $from, $active) = @args;
1747 0 0       0 if ($to eq $self->{nick}) {
1748 0         0 $self->debug("F: recognise(), T:here_ack,From: $from, Chan $chan"
1749             . ", status " .$self->num2status($active), $buffer);
1750 0         0 @re = ("here_ack", $from, $chan, $active);
1751             }
1752             # }}}
1753             }
1754              
1755             =head4 activity change
1756              
1757             Returns: "active", $fromwho, $active
1758              
1759             =cut
1760              
1761             # Active change
1762             elsif ($pkttype eq 'M') {
1763             # {{{
1764 2         6 my ($fromwho, $active) = @args;
1765             #$buffer =~ /^\x58.{9}M(.+?)\0([01])/;
1766 2         5 $self->{'users'}{$fromwho}{'active'} = $active;
1767 2 100       8 if ($active == 1) {
1768 1         4 $self->debug($fromwho." became active", $buffer);
1769             }
1770             else {
1771 1         6 $self->debug($fromwho." became inactive", $buffer);
1772             }
1773 2         7 @re = ("active", $fromwho, $active);
1774             # }}}
1775             }
1776             else {
1777 2 50       6 $self->debug("Received unknown buffer", $buffer) if $self->{debug} == 2;
1778             }
1779 32         153 return @re;
1780             }
1781             1;
1782             __END__