Changeset a827529 for perl/modules/IRC
- Timestamp:
- Jan 11, 2008, 2:28:36 PM (17 years ago)
- Branches:
- master, barnowl_perlaim, debian, release-1.10, release-1.4, release-1.5, release-1.6, release-1.7, release-1.8, release-1.9
- Children:
- fac5463
- Parents:
- 16c6cca (diff), 9e02bb7 (diff)
Note: this is a merge changeset, the changes displayed below correspond to the merge itself.
Use the (diff) links above to see all the changes relative to each parent. - Location:
- perl/modules/IRC/lib/BarnOwl
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
perl/modules/IRC/lib/BarnOwl/Message/IRC.pm
r0e52069 r2fb58e4 56 56 sub long_sender {shift->{from} || ""}; 57 57 58 sub login_extra { shift->channel; } 59 58 60 59 61 1; -
perl/modules/IRC/lib/BarnOwl/Module/IRC.pm
r6286f26 rb0c8011 30 30 31 31 sub startup { 32 BarnOwl::new_variable_string('irc:nick', {default => $ENV{USER}}); 33 BarnOwl::new_variable_string('irc:user', {default => $ENV{USER}}); 34 BarnOwl::new_variable_string('irc:name', {default => ""}); 35 BarnOwl::new_variable_bool('irc:spew', {default => 0}); 32 BarnOwl::new_variable_string('irc:nick', { 33 default => $ENV{USER}, 34 summary => 'The default IRC nickname', 35 description => 'By default, irc-connect will use this nick ' . 36 'when connecting to a new server. See :help irc-connect for ' . 37 'more information.' 38 }); 39 40 BarnOwl::new_variable_string('irc:user', { 41 default => $ENV{USER}, 42 summary => 'The IRC "username" field' 43 }); 44 BarnOwl::new_variable_string('irc:name', { 45 default => "", 46 summary => 'A short name field for IRC', 47 description => 'A short (maybe 60 or so chars) piece of text, ' . 48 'originally intended to display your real name, which people ' . 49 'often use for pithy quotes and URLs.' 50 }); 51 52 BarnOwl::new_variable_bool('irc:spew', { 53 default => 0, 54 summary => 'Show unhandled IRC events', 55 description => 'If set, display all unrecognized IRC events as ' . 56 'admin messages. Intended for debugging and development use only ' 57 }); 58 36 59 register_commands(); 37 60 register_handlers(); … … 61 84 62 85 sub register_commands { 63 BarnOwl::new_command('irc-connect' => \&cmd_connect); 86 BarnOwl::new_command('irc-connect' => \&cmd_connect, 87 { 88 summary => 'Connect to an IRC server', 89 usage => 'irc-connect [-a ALIAS ] [-s] [-p PASSWORD] [-n NICK] SERVER [port]', 90 description => 91 92 "Connect to an IRC server. Supported options are\n\n" . 93 "-a <alias> Define an alias for this server\n" . 94 "-s Use SSL\n" . 95 "-p <password> Specify the password to use\n" . 96 "-n <nick> Use a non-default nick" 97 }); 64 98 BarnOwl::new_command('irc-disconnect' => \&cmd_disconnect); 65 BarnOwl::new_command('irc-msg' => \&cmd_msg); 66 BarnOwl::new_command('irc-join' => \&cmd_join); 67 BarnOwl::new_command('irc-nick' => \&cmd_nick); 99 BarnOwl::new_command('irc-msg' => \&cmd_msg); 100 BarnOwl::new_command('irc-join' => \&cmd_join); 101 BarnOwl::new_command('irc-part' => \&cmd_part); 102 BarnOwl::new_command('irc-nick' => \&cmd_nick); 103 BarnOwl::new_command('irc-names' => \&cmd_names); 104 BarnOwl::new_command('irc-whois' => \&cmd_whois); 68 105 } 69 106 … … 94 131 "ssl" => \$ssl, 95 132 "password=s" => \$password, 96 " port=i" => \$port,133 "nick=s" => \$nick, 97 134 ); 98 135 $host = shift @ARGV or die("Usage: $cmd HOST\n"); 99 136 if(!$alias) { 100 $alias = $1 if $host =~ /^(?:irc[.])?(\w+)[.]\w+$/; 101 $alias ||= $host; 137 if($host =~ /^(?:irc[.])?(\w+)[.]\w+$/) { 138 $alias = $1; 139 } else { 140 $alias = $host; 141 } 102 142 } 103 $port ||=6667;143 $port = shift @ARGV || 6667; 104 144 $ssl ||= 0; 145 } 146 147 if(exists $ircnets{$alias}) { 148 die("Already connected to a server with alias '$alias'. Either disconnect or specify an alias with -a.\n"); 105 149 } 106 150 … … 148 192 my $msg = BarnOwl::Message->new( 149 193 type => 'IRC', 150 direction => 'out',194 direction => is_private($to) ? 'out' : 'in', 151 195 server => $conn->server, 152 196 network => $conn->alias, … … 169 213 } 170 214 215 sub cmd_part { 216 my $cmd = shift; 217 my $conn = get_connection(\@_); 218 my $chan = get_channel(\@_) || die("Usage: $cmd <channel>\n"); 219 $conn->part($chan); 220 } 221 171 222 sub cmd_nick { 172 223 my $cmd = shift; 173 224 my $conn = get_connection(\@_); 174 my $nick = shift or die("Usage: $cmd <new nick> ");225 my $nick = shift or die("Usage: $cmd <new nick>\n"); 175 226 $conn->nick($nick); 227 } 228 229 sub cmd_names { 230 my $cmd = shift; 231 my $conn = get_connection(\@_); 232 my $chan = get_channel(\@_) || die("Usage: $cmd <channel>\n"); 233 $conn->names($chan); 234 } 235 236 sub cmd_whois { 237 my $cmd = shift; 238 my $conn = get_connection(\@_); 239 my $who = shift || die("Usage: $cmd <user>\n"); 240 $conn->whois($who); 176 241 } 177 242 … … 196 261 } 197 262 263 sub get_channel { 264 my $args = shift; 265 if(scalar @$args) { 266 return shift @$args; 267 } 268 my $m = BarnOwl::getcurmsg(); 269 if($m && $m->type eq 'IRC') { 270 return $m->channel if !$m->is_private; 271 } 272 return undef; 273 } 274 198 275 sub get_connection_by_alias { 199 276 my $key = shift; -
perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm
r0e52069 r9e02bb7 16 16 17 17 use base qw(Net::IRC::Connection Class::Accessor Exporter); 18 __PACKAGE__->mk_accessors(qw(alias channels ));18 __PACKAGE__->mk_accessors(qw(alias channels motd)); 19 19 our @EXPORT_OK = qw(&is_private); 20 20 … … 29 29 $self->alias($alias); 30 30 $self->channels([]); 31 $self->motd(""); 31 32 bless($self, $class); 32 33 33 $self->add_global_handler(376 => sub { goto &on_connect }); 34 $self->add_global_handler(['msg', 'notice', 'public', 'caction'], 34 $self->add_default_handler(sub { goto &on_event; }); 35 $self->add_handler(376 => sub { goto &on_connect }); 36 $self->add_handler(['msg', 'notice', 'public', 'caction'], 35 37 sub { goto &on_msg }); 36 $self->add_global_handler(cping => sub { goto &on_ping }); 37 $self->add_default_handler(sub { goto &on_event; }); 38 $self->add_handler(['welcome', 'yourhost', 'created', 39 'luserclient', 'luserop', 'luserchannels', 'luserme'], 40 sub { goto &on_admin_msg }); 41 $self->add_handler(['myinfo', 'map', 'n_local', 'n_global', 42 'luserconns'], 43 sub { }); 44 $self->add_handler(motdstart => sub { goto &on_motdstart }); 45 $self->add_handler(motd => sub { goto &on_motd }); 46 $self->add_handler(endofmotd => sub { goto &on_endofmotd }); 47 $self->add_handler(join => sub { goto &on_join }); 48 $self->add_handler(part => sub { goto &on_part }); 49 $self->add_handler(disconnect => sub { goto &on_disconnect }); 50 $self->add_handler(nicknameinuse => sub { goto &on_nickinuse }); 51 $self->add_handler(cping => sub { goto &on_ping }); 38 52 39 53 return $self; … … 49 63 } 50 64 51 sub on_msg { 52 my ($self, $evt) = @_; 53 my ($recipient) = $evt->to; 54 my $body = strip_irc_formatting([$evt->args]->[0]); 55 $body = BarnOwl::Style::boldify($evt->nick.' '.$body) if $evt->type eq 'caction'; 56 my $msg = BarnOwl::Message->new( 65 sub new_message { 66 my $self = shift; 67 my $evt = shift; 68 return BarnOwl::Message->new( 57 69 type => 'IRC', 58 direction => 'in',59 70 server => $self->server, 60 71 network => $self->alias, 61 recipient => $recipient,62 body => $body,63 72 sender => $evt->nick, 64 73 hostname => $evt->host, 65 74 from => $evt->from, 75 @_ 76 ); 77 } 78 79 sub on_msg { 80 my ($self, $evt) = @_; 81 my ($recipient) = $evt->to; 82 my $body = strip_irc_formatting([$evt->args]->[0]); 83 my $nick = $self->nick; 84 BarnOwl::beep() if $body =~ /\b\Q$nick\E\b/; 85 $body = BarnOwl::Style::boldify($evt->nick.' '.$body) if $evt->type eq 'caction'; 86 my $msg = $self->new_message($evt, 87 direction => 'in', 88 recipient => $recipient, 89 body => $body, 66 90 $evt->type eq 'notice' ? 67 91 (notice => 'true') : (), … … 70 94 replycmd => 'irc-msg ' . 71 95 (is_private($recipient) ? $evt->nick : $recipient), 72 replysendercmd => 'irc-msg ' . $evt->nick ,96 replysendercmd => 'irc-msg ' . $evt->nick 73 97 ); 98 74 99 BarnOwl::queue_message($msg); 75 100 } … … 80 105 } 81 106 107 sub on_admin_msg { 108 my ($self, $evt) = @_; 109 BarnOwl::admin_message("IRC", 110 BarnOwl::Style::boldify('IRC ' . $evt->type . ' message from ' 111 . $evt->alias) . "\n" 112 . strip_irc_formatting(join '\n', cdr $evt->args)); 113 } 114 115 sub on_motdstart { 116 my ($self, $evt) = @_; 117 $self->motd(join "\n", cdr $evt->args); 118 } 119 120 sub on_motd { 121 my ($self, $evt) = @_; 122 $self->motd(join "\n", $self->motd, cdr $evt->args); 123 } 124 125 sub on_endofmotd { 126 my ($self, $evt) = @_; 127 $self->motd(join "\n", $self->motd, cdr $evt->args); 128 BarnOwl::admin_message("IRC", 129 BarnOwl::Style::boldify('MOTD for ' . $evt->alias) . "\n" 130 . strip_irc_formatting($self->motd)); 131 } 132 133 sub on_join { 134 my ($self, $evt) = @_; 135 my $msg = $self->new_message($evt, 136 loginout => 'login', 137 channel => $evt->to, 138 ); 139 BarnOwl::queue_message($msg); 140 } 141 142 sub on_part { 143 my ($self, $evt) = @_; 144 my $msg = $self->new_message($evt, 145 loginout => 'logout', 146 channel => $evt->to, 147 ); 148 BarnOwl::queue_message($msg); 149 } 150 151 sub on_disconnect { 152 my $self = shift; 153 delete $BarnOwl::Module::IRC::ircnets{$self->alias}; 154 155 BarnOwl::admin_message('IRC', 156 "[" . $self->alias . "] Disconnected from server"); 157 } 158 159 sub on_nickinuse { 160 my ($self, $evt) = @_; 161 BarnOwl::admin_message("IRC", 162 "[" . $self->alias . "] " . 163 [$evt->args]->[1] . ": Nick already in use"); 164 } 165 82 166 sub on_event { 83 167 my ($self, $evt) = @_; 84 168 BarnOwl::admin_message("IRC", 85 " Unhandled IRC event of type " . $evt->type . ":\n"169 "[" . $self->alias . "] Unhandled IRC event of type " . $evt->type . ":\n" 86 170 . strip_irc_formatting(join("\n", $evt->args))) 87 171 if BarnOwl::getvar('irc:spew') eq 'on'; 88 172 } 89 173 174 90 175 ################################################################################ 91 176 ########################### Utilities/Helpers ################################## … … 94 179 sub strip_irc_formatting { 95 180 my $body = shift; 96 my @pieces = split /\x02/, $body; 181 # Strip mIRC colors. If someone wants to write code to convert 182 # these to zephyr colors, be my guest. 183 $body =~ s/\cC\d+(?:,\d+)?//g; 184 $body =~ s/\cO//g; 185 186 my @pieces = split /\cB/, $body; 97 187 my $out; 98 188 while(@pieces) { … … 109 199 } 110 200 201 sub cdr { 202 shift; 203 return @_; 204 } 205 111 206 1;
Note: See TracChangeset
for help on using the changeset viewer.