ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-IRC3/lib/Net/IRC3/Util.pm
Revision: 1.3
Committed: Mon Jul 17 16:11:32 2006 UTC (18 years, 4 months ago) by elmex
Branch: MAIN
Changes since 1.2: +1 -1 lines
Log Message:
fixed typo in copyright

File Contents

# User Rev Content
1 elmex 1.1 package Net::IRC3::Util;
2     use strict;
3     use Exporter;
4     our @ISA = qw/Exporter/;
5     our @EXPORT_OK =
6     qw(mk_msg parse_irc_msg split_prefix prefix_nick
7     decode_ctcp prefix_user prefix_host);
8    
9     =head1 NAME
10    
11     Net::IRC3::Util - Common utilities that help with IRC protocol handling
12    
13 elmex 1.2 =head1 SYNOPSIS
14    
15     use Net::IRC3 qw/parse_irc_msg mk_msg/;
16    
17     my $msgdata = mk_msg (undef, PRIVMSG
18    
19 elmex 1.1 =head1 FUNCTIONS
20    
21     These are some utility functions that might come in handy when
22     handling the IRC protocol.
23    
24     You can export these with eg.:
25    
26     use Net::IRC3 qw/parse_irc_msg/;
27    
28     =over 4
29    
30     =item B<parse_irc_msg ($ircline)>
31    
32     This method parses the C<$ircline>, which is one line of the IRC protocol
33     without the trailing "\015\012".
34    
35     It returns a hash which has the following entrys:
36    
37     =over 4
38    
39     =item prefix
40    
41     The message prefix.
42    
43     =item command
44    
45     The IRC command.
46    
47     =item params
48    
49     The parameters to the IRC command in a array reference,
50     this includes the trailing parameter (the one after the ':' or
51     the 14th parameter).
52    
53     =item trailing
54    
55     This is set if there was a trailing parameter (the one after the ':' or
56     the 14th parameter).
57    
58     =back
59    
60     =cut
61    
62     sub parse_irc_msg {
63     my ($msg) = @_;
64    
65     my $cmd;
66     my $pref;
67     my $t;
68     my @a;
69    
70     my $p = $msg =~ s/^(:([^ ]+)[ ])?([A-Za-z]+|\d{3})//;
71     $pref = $2;
72     $cmd = $3;
73    
74     my $i = 0;
75    
76     while ($msg =~ s/^[ ]([^ :\015\012\0][^ \015\012\0]*)//) {
77    
78     push @a, $1 if defined $1;
79     if (++$i > 13) { last; }
80     }
81    
82     if ($i == 14) {
83    
84     if ($msg =~ s/^[ ]:?([^\015\012\0]*)//) {
85     $t = $1 if $1 ne "";
86     }
87    
88     } else {
89    
90     if ($msg =~ s/^[ ]:([^\015\012\0]*)//) {
91     $t = $1 if $1 ne "";
92     }
93     }
94    
95     push @a, $t if defined $t;
96    
97     my $m = { prefix => $pref, command => $cmd, params => \@a, trailing => $t };
98     return $p ? $m : undef;
99     }
100    
101     =item B<mk_msg ($prefix, $command, $trailing, @params)>
102    
103     This function assembles a IRC message. The generated
104     message will look like (pseudo code!)
105    
106     :<prefix> <command> <params> :<trail>
107    
108     Please refer to RFC 2812 how IRC messages normally look like.
109    
110     The prefix and the trailing string will be omitted if they are C<undef>.
111    
112     EXAMPLES:
113    
114     mk_msg (undef, "PRIVMSG", "you suck!", "magnus");
115     # will return: "PRIVMSG magnus :you suck!\015\012"
116    
117     mk_msg (undef, "JOIN", undef, "#test");
118     # will return: "JOIN #magnus\015\012"
119    
120     =cut
121    
122     sub mk_msg {
123     my ($prefix, $command, $trail, @params) = @_;
124     my $msg = "";
125    
126     $msg .= defined $prefix ? ":$prefix " : "";
127     $msg .= "$command";
128    
129     # FIXME: params must be counted, and if > 13 they have to be
130     # concationated with $trail
131     map { $msg .= " $_" } @params;
132    
133     $msg .= defined $trail ? " :$trail" : "";
134     $msg .= "\015\012";
135    
136     return $msg;
137     }
138    
139    
140     =item B<decode_ctcp ($ircmsg)> or B<decode_ctcp ($line)>
141    
142     =cut
143    
144     sub decode_ctcp {
145     my ($self, $msg) = @_;
146     my $line = ref $msg ? $msg->{trailing} : $msg;
147     my $msg = ref $msg ? $msg : { };
148    
149     if ($line =~ m/^\001(.*?)\001$/) {
150     my $ctcpdata = $1;
151    
152     # XXX: implement!
153    
154     } else {
155     return { trailing => $line };
156     }
157    
158    
159     return $msg;
160     }
161    
162     =item B<split_prefix ($prefix)>
163    
164     This function splits an IRC user prefix as described by RFC 2817
165     into the three parts: nickname, user and host. Which will be
166     returned as a list with that order.
167    
168     C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
169    
170     =cut
171    
172     sub split_prefix {
173     my ($prfx) = @_;
174    
175     if (ref ($prfx) eq 'HASH') {
176     $prfx = $prfx->{prefix};
177     }
178    
179     $prfx =~ m/^\s*([^!]*)!([^@]*)@(.*?)\s*$/;
180     return ($1, $2, $3);
181     }
182    
183     =item B<prefix_nick ($prefix)>
184    
185     A shortcut to extract the nickname from the C<$prefix>.
186    
187     C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
188    
189     =cut
190    
191     sub prefix_nick {
192     my ($prfx) = @_;
193     return (split_prefix ($prfx))[0];
194     }
195    
196     =item B<prefix_user ($prefix)>
197    
198     A shortcut to extract the username from the C<$prefix>.
199    
200     C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
201    
202     =cut
203    
204     sub prefix_user {
205     my ($prfx) = @_;
206     return (split_prefix ($prfx))[1];
207     }
208    
209     =item B<prefix_host ($prefix)>
210    
211     A shortcut to extract the hostname from the C<$prefix>.
212    
213     C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
214    
215     =cut
216    
217     sub prefix_host {
218     my ($self, $prfx) = @_;
219     return (split_prefix ($prfx))[2];
220     }
221    
222     =back
223    
224     =head1 AUTHOR
225    
226     Robin Redeker, C<< <elmex@ta-sa.org> >>
227    
228     =head1 SEE ALSO
229    
230     L<Net::IRC3>
231    
232     L<Net::IRC3::Client>
233    
234     RFC 2812 - Internet Relay Chat: Client Protocol
235    
236     =head1 COPYRIGHT & LICENSE
237    
238 elmex 1.3 Copyright 2006 Robin Redeker, all rights reserved.
239 elmex 1.1
240     This program is free software; you can redistribute it and/or modify it
241     under the same terms as Perl itself.
242    
243     =cut
244    
245     1;