File Coverage

blib/lib/Bot/ICB.pm
Criterion Covered Total %
statement 9 80 11.2
branch 0 38 0.0
condition 0 6 0.0
subroutine 3 17 17.6
pod 0 14 0.0
total 12 155 7.7


line stmt bran cond sub pod time code
1             # -*- Mode: Perl; indent-tabs-mode: nil -*-
2              
3             package Bot::ICB;
4              
5 1     1   881 use strict;
  1         2  
  1         39  
6 1     1   877 use Net::ICB qw/:client/;
  1         34419  
  1         286  
7              
8             {
9 1     1   10 no strict;
  1         7  
  1         955  
10             $VERSION = 0.12;
11             }
12              
13             sub newconn
14             {
15 0     0 0   my $pkg = shift;
16 0   0       my $class = ref($pkg) || $pkg;
17              
18 0           my $self = bless {}, $class;
19 0           $self->conn(new Net::ICB());
20              
21 0 0         $self->login(@_) if @_;
22              
23 0           return $self;
24             }
25              
26             sub conn
27             {
28 0     0 0   my $self = shift;
29              
30 0 0         $self->{conn} = shift if @_;
31              
32 0           return $self->{conn};
33             }
34              
35             sub handler
36             {
37 0     0 0   my $self = shift;
38 0           my ($name) = @_;
39 0 0         $name or
40             return undef;
41              
42 0 0         $self->{handlers} or
43             return undef;
44              
45 0           return $self->{handlers}->{$name};
46             }
47              
48             sub login
49             {
50 0     0 0   my $self = shift;
51 0           my %args = @_;
52              
53 0           my $c = $self->conn;
54 0 0         $c->connect(%args) or
55             die $c->error;
56              
57 0           my $type = "";
58 0           my $err = "";
59              
60 0           ($type, $err) = $c->readmsg;
61 0 0         $type eq $M_ERROR and
62             die "Server error when receiving protocol packet: $err\n";
63 0 0         $type eq $M_PROTO or
64             die "Expected protocol packet [$M_PROTO] but received [$type]\n";
65              
66 0           ($type, $err) = $c->readmsg;
67 0 0         $type eq $M_ERROR and
68             die "Server error when receiving loginok packet: $err\n";
69 0 0         $type eq $M_LOGINOK or
70             die "Expected loginok packet [$M_LOGINOK] but received [$type]\n";
71              
72 0           my $handler = $self->handler('connect');
73 0 0         &$handler($self) if $handler;
74              
75 0           return 1;
76             }
77              
78             sub add_handler
79             {
80 0     0 0   my $self = shift;
81 0           my ($name, $handler) = @_;
82 0 0 0       $name && $handler or
83             return undef;
84              
85 0 0         $self->{handlers} = {} unless $self->{handlers};
86              
87 0 0         $name = $M_OPEN if $name eq 'public';
88 0 0         $name = $M_PERSONAL if $name eq 'msg';
89 0 0         $name = $M_STATUS if $name eq 'status';
90 0 0         $name = $M_EXIT if $name eq 'exit';
91              
92 0           $self->{handlers}->{$name} = $handler;
93              
94 0           return 1;
95             }
96              
97             sub start
98             {
99 0     0 0   my $self = shift;
100              
101 0           my $type = "";
102 0           my $event = "";
103 0           my @msg;
104             my $handler;
105 0           my $str;
106              
107 0           while (1)
108             {
109 0 0         if (! $self->conn)
110             {
111 0           $handler = $self->handler($M_EXIT);
112 0 0         &$handler($self) if $handler;
113 0           exit;
114             }
115              
116 0           ($type, $event, @msg) = $self->readmsg;
117              
118 0           for $str ($type, $event, 'default')
119             {
120 0           $handler = $self->handler(lc $str);
121 0 0         &$handler($self, $event, @msg) if $handler;
122             }
123             }
124              
125 0           return 1;
126             }
127              
128             sub disconnect
129             {
130 0     0 0   my $self = shift;
131              
132 0           $self->conn(undef);
133              
134 0           return 1;
135             }
136              
137             sub debug
138             {
139 0     0 0   my $self = shift;
140 0           return $self->conn->debug(@_);
141             }
142              
143             sub error
144             {
145 0     0 0   my $self = shift;
146 0           return $self->conn->error(@_);
147             }
148              
149             sub readmsg
150             {
151 0     0 0   my $self = shift;
152 0           return $self->conn->readmsg(@_);
153             }
154              
155             sub sendopen
156             {
157 0     0 0   my $self = shift;
158 0           return $self->conn->sendopen(@_);
159             }
160              
161             sub sendpriv
162             {
163 0     0 0   my $self = shift;
164 0           return $self->conn->sendpriv(@_);
165             }
166              
167             sub sendraw
168             {
169 0     0 0   my $self = shift;
170 0           return $self->conn->sendraw(@_);
171             }
172              
173             sub sendcmd
174             {
175 0     0 0   my $self = shift;
176 0           return $self->conn->sendcmd(@_);
177             }
178              
179             1;
180             __END__