Net/IRC3/Client.pm

package Net::IRC3::Client;
use Net::IRC3;

our $DEBUG = 0;

sub new
{
  my $this = shift;
  my $class = ref($this) || $this;

  my $self = {
     cfg  => { @_ },
     pirc => Net::IRC3->new
  };

  bless $self, $class;

  return $self;
}

sub connect {
   my ($self, $host, $port, $nick, $user, $real) = @_;

   my $ncon;

   my $con = $self->{pirc}->connect_server ($host, $port, $self);

   my $ncon =
      $self->{conns}->{"$host:$port"} =
      Net::IRC3::Client::Connection->new (
         $self->{pirc}, $con, $host, $port, $nick, $user, $real
      );

   return $ncon;
}

sub connections {
   my ($self) = @_;
   return %{$self->{conns}};
}

sub connection {
   my ($self, $host, $port) = @_;
   if ($host =~ m/^[^:]+:(\d+)$/) {
      return $self->{conns}->{$host}
   } else {
      return $self->{conns}->{$host.':'.$port}
   }
}

package Net::IRC3::Client::Connection;
use Net::IRC3;

sub new
{
  my $this = shift;
  my $class = ref($this) || $this;

  my $self = {
     pirc => $_[0],
     con  => $_[1],
     host => $_[2],
     port => $_[3],
     nick => lc $_[4],
     user => lc $_[5],
     real => $_[6]
  };

  bless $self, $class;

  return $self;
}

sub nick { $_[0]->{nick} }

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

   $self->{con}->disconnect_server;
}

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

   delete $self->{con};
   delete $self->{pirc};
}

sub register {
   my ($self) = @_;
   my ($con, $nick, $user, $real) = @$self{qw/con nick user real/};

   $self->reg_cb (irc_001    => \&welcome_cb);
   $self->reg_cb (irc_join   => \&join_cb);
   $self->reg_cb (irc_part   => \&part_cb);
   $self->reg_cb (irc_353    => \&namereply_cb);
   $self->reg_cb (irc_366    => \&endofnames_cb);
   $self->reg_cb (irc_ping   => \&ping_cb);

   $self->reg_cb (irc_privmsg => \&privmsg_cb);
   $self->reg_cb (irc_notice  => \&privmsg_cb);

   $self->reg_cb ('irc_*'     => \&debug_cb)
      if $DEBUG;
   $self->reg_cb ('irc_*'     => \&anymsg_cb);

   $self->reg_cb (disconnect => \&disconnect_cb);

   $con->send_msg (undef, "NICK", undef, $nick);
   $con->send_msg (undef, "USER", $real || $nick, $user || $nick, "*", "0");
}

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

   if ($self->{connected}) {
      $self->{con}->send_msg (undef, @msg);

   } else {
      push @{$self->{con_queue}}, \@msg;
   }
}

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

   if ($self->{channels}->{$chan}) {
      $self->{con}->send_msg (undef, @msg);

   } else {
      push @{$self->{chan_queue}->{lc $chan}}, \@msg;
   }
}

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

   my $cmd = lc $msg->{command};

   if (    $cmd ne "privmsg" 
       and $cmd ne "notice"
       and $cmd ne "part"
       and $cmd ne "join"
      ) 
   {
      $self->event (statmsg => $msg);
   }

   1;
}

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

   if ($msg->{params}->[0] =~ m/^[#!]/) {
      $self->event (chanmsg => $msg->{params}->[0], $msg);

   } else {
      $self->event (querymsg => $msg->{params}->[0], $msg);
   }

   1;
}

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

   $self->{connected} = 1;

   for (@{$self->{con_queue}}) {
      $self->{con}->send_msg (undef, @$_);
      $self->event (connected => $chan);
   }

   1;
}

sub ping_cb {
   my ($self, $msg) = @_;
   $self->send_srv ("PONG", $msg->{params}->[0]);
}

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

}

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

sub reg_cb {
   my ($self, $cmd, $cb) = @_;
   $self->{con}->reg_cb ($cmd => sub { my ($_self) = shift; $cb->($self, @_) });
}

sub event {
   my ($self, $ev, @args) = @_;
   $self->{con}->event ($ev => @args);
}

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

   my $chan = lc $msg->{params}->[0];

   $self->{channels}->{$chan} = {};

   if (lc Net::IRC3::prefix_nick ($msg) eq lc $self->{nick}) {

      for (@{$self->{chan_queue}->{$chan}}) {
         $self->{con}->send_msg (undef, @$_);
      }

      $self->event (join => Net::IRC3::prefix_nick ($msg), $chan, 1);

   } else {
      $self->event (join => Net::IRC3::prefix_nick ($msg), $chan, 0);
   }

   1;
}

sub channel_list {
   my ($self) = @_;
   return keys %{$self->{channels}};
}

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

   my $chan = lc $msg->{params}->[0];
   my $nick = lc Net::IRC3::prefix_nick ($msg);

   if ($self->{nick} eq $nick) {

      delete $self->{chan_queue}->{$chan};
      delete $self->{channels}->{$chan};
      $self->event (part => Net::IRC3::prefix_nick ($msg), $chan, 1, $msg->{params}->[1]);

   } else {
      $self->event (part => Net::IRC3::prefix_nick ($msg), $chan, 0, $msg->{params}->[1]);
   }

   1;
}

sub debug_cb {
   my ($self, $msg) = @_;
   print "$self->{host}:$self->{port} > ";
   my $par = delete $msg->{params};
   print (join " ", map { $_ => $msg->{$_} } sort keys %$msg);
   print " params:";
   print (join ",", @$par);
   print "\n";
}

1;
Revision:	1.1
Committed:	Sun Jul 16 02:09:12 2006 UTC (20 years, 3 months ago) by elmex
Branch:	MAIN
Log Message:	initial checkin
#	User	Rev	Content
1	elmex	1.1	package Net::IRC3::Client;
2			use Net::IRC3;
3
4			our $DEBUG = 0;
5
6			sub new
7			{
8			my $this = shift;
9			my $class = ref($this) \|\| $this;
10
11			my $self = {
12			cfg => { @_ },
13			pirc => Net::IRC3->new
14			};
15
16			bless $self, $class;
17
18			return $self;
19			}
20
21			sub connect {
22			my ($self, $host, $port, $nick, $user, $real) = @_;
23
24			my $ncon;
25
26			my $con = $self->{pirc}->connect_server ($host, $port, $self);
27
28			my $ncon =
29			$self->{conns}->{"$host:$port"} =
30			Net::IRC3::Client::Connection->new (
31			$self->{pirc}, $con, $host, $port, $nick, $user, $real
32			);
33
34			return $ncon;
35			}
36
37			sub connections {
38			my ($self) = @_;
39			return %{$self->{conns}};
40			}
41
42			sub connection {
43			my ($self, $host, $port) = @_;
44			if ($host =~ m/^[^:]+:(\d+)$/) {
45			return $self->{conns}->{$host}
46			} else {
47			return $self->{conns}->{$host.':'.$port}
48			}
49			}
50
51			package Net::IRC3::Client::Connection;
52			use Net::IRC3;
53
54			sub new
55			{
56			my $this = shift;
57			my $class = ref($this) \|\| $this;
58
59			my $self = {
60			pirc => $_[0],
61			con => $_[1],
62			host => $_[2],
63			port => $_[3],
64			nick => lc $_[4],
65			user => lc $_[5],
66			real => $_[6]
67			};
68
69			bless $self, $class;
70
71			return $self;
72			}
73
74			sub nick { $_[0]->{nick} }
75
76			sub disconnect {
77			my ($self) = @_;
78
79			$self->{con}->disconnect_server;
80			}
81
82			sub disconnect_cb {
83			my ($self) = @_;
84
85			delete $self->{con};
86			delete $self->{pirc};
87			}
88
89			sub register {
90			my ($self) = @_;
91			my ($con, $nick, $user, $real) = @$self{qw/con nick user real/};
92
93			$self->reg_cb (irc_001 => \&welcome_cb);
94			$self->reg_cb (irc_join => \&join_cb);
95			$self->reg_cb (irc_part => \&part_cb);
96			$self->reg_cb (irc_353 => \&namereply_cb);
97			$self->reg_cb (irc_366 => \&endofnames_cb);
98			$self->reg_cb (irc_ping => \&ping_cb);
99
100			$self->reg_cb (irc_privmsg => \&privmsg_cb);
101			$self->reg_cb (irc_notice => \&privmsg_cb);
102
103			$self->reg_cb ('irc_*' => \&debug_cb)
104			if $DEBUG;
105			$self->reg_cb ('irc_*' => \&anymsg_cb);
106
107			$self->reg_cb (disconnect => \&disconnect_cb);
108
109			$con->send_msg (undef, "NICK", undef, $nick);
110			$con->send_msg (undef, "USER", $real \|\| $nick, $user \|\| $nick, "*", "0");
111			}
112
113			sub send_srv {
114			my ($self, @msg) = @_;
115
116			if ($self->{connected}) {
117			$self->{con}->send_msg (undef, @msg);
118
119			} else {
120			push @{$self->{con_queue}}, \@msg;
121			}
122			}
123
124			sub send_chan {
125			my ($self, $chan, @msg) = @_;
126
127			if ($self->{channels}->{$chan}) {
128			$self->{con}->send_msg (undef, @msg);
129
130			} else {
131			push @{$self->{chan_queue}->{lc $chan}}, \@msg;
132			}
133			}
134
135			sub anymsg_cb {
136			my ($self, $msg) = @_;
137
138			my $cmd = lc $msg->{command};
139
140			if ( $cmd ne "privmsg"
141			and $cmd ne "notice"
142			and $cmd ne "part"
143			and $cmd ne "join"
144			)
145			{
146			$self->event (statmsg => $msg);
147			}
148
149			1;
150			}
151
152			sub privmsg_cb {
153			my ($self, $msg) = @_;
154
155			if ($msg->{params}->[0] =~ m/^[#!]/) {
156			$self->event (chanmsg => $msg->{params}->[0], $msg);
157
158			} else {
159			$self->event (querymsg => $msg->{params}->[0], $msg);
160			}
161
162			1;
163			}
164
165			sub welcome_cb {
166			my ($self, $msg) = @_;
167
168			$self->{connected} = 1;
169
170			for (@{$self->{con_queue}}) {
171			$self->{con}->send_msg (undef, @$_);
172			$self->event (connected => $chan);
173			}
174
175			1;
176			}
177
178			sub ping_cb {
179			my ($self, $msg) = @_;
180			$self->send_srv ("PONG", $msg->{params}->[0]);
181			}
182
183			sub namereply_cb {
184			my ($self, $msg) = @_;
185
186			}
187
188			sub endofnames_cb {
189			my ($self, $msg) = @_;
190			}
191
192			sub reg_cb {
193			my ($self, $cmd, $cb) = @_;
194			$self->{con}->reg_cb ($cmd => sub { my ($_self) = shift; $cb->($self, @_) });
195			}
196
197			sub event {
198			my ($self, $ev, @args) = @_;
199			$self->{con}->event ($ev => @args);
200			}
201
202			sub join_cb {
203			my ($self, $msg) = @_;
204
205			my $chan = lc $msg->{params}->[0];
206
207			$self->{channels}->{$chan} = {};
208
209			if (lc Net::IRC3::prefix_nick ($msg) eq lc $self->{nick}) {
210
211			for (@{$self->{chan_queue}->{$chan}}) {
212			$self->{con}->send_msg (undef, @$_);
213			}
214
215			$self->event (join => Net::IRC3::prefix_nick ($msg), $chan, 1);
216
217			} else {
218			$self->event (join => Net::IRC3::prefix_nick ($msg), $chan, 0);
219			}
220
221			1;
222			}
223
224			sub channel_list {
225			my ($self) = @_;
226			return keys %{$self->{channels}};
227			}
228
229			sub part_cb {
230			my ($self, $msg) = @_;
231
232			my $chan = lc $msg->{params}->[0];
233			my $nick = lc Net::IRC3::prefix_nick ($msg);
234
235			if ($self->{nick} eq $nick) {
236
237			delete $self->{chan_queue}->{$chan};
238			delete $self->{channels}->{$chan};
239			$self->event (part => Net::IRC3::prefix_nick ($msg), $chan, 1, $msg->{params}->[1]);
240
241			} else {
242			$self->event (part => Net::IRC3::prefix_nick ($msg), $chan, 0, $msg->{params}->[1]);
243			}
244
245			1;
246			}
247
248			sub debug_cb {
249			my ($self, $msg) = @_;
250			print "$self->{host}:$self->{port} > ";
251			my $par = delete $msg->{params};
252			print (join " ", map { $_ => $msg->{$_} } sort keys %$msg);
253			print " params:";
254			print (join ",", @$par);
255			print "\n";
256			}
257
258			1;