Changeset 2cedb7a for perl/modules
- Timestamp:
- Mar 18, 2007, 4:28:31 PM (18 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:
- 300b470
- Parents:
- 2622450
- git-author:
- Nelson Elhage <nelhage@mit.edu> (03/18/07 16:28:18)
- git-committer:
- Nelson Elhage <nelhage@mit.edu> (03/18/07 16:28:31)
- Location:
- perl/modules/Jabber
- Files:
-
- 4 added
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
perl/modules/Jabber/lib/BarnOwl/Module/Jabber.pm
rd47d5fc r2cedb7a 1 # -*- mode: cperl; cperl-indent-level: 4; indent-tabs-mode: nil -*- 1 use strict; 2 2 use warnings; 3 use strict; 4 5 package BarnOwl::Jabber; 3 4 package BarnOwl::Module::Jabber; 5 6 =head1 NAME 7 8 BarnOwl::Module::Jabber 9 10 =head1 DESCRIPTION 11 12 This module implements Jabber support for barnowl. 13 14 =cut 15 16 use BarnOwl; 17 use BarnOwl::Hooks; 18 use BarnOwl::Message::Jabber; 19 use BarnOwl::Module::Jabber::Connection; 20 use BarnOwl::Module::Jabber::ConnectionManager; 6 21 7 22 use Authen::SASL qw(Perl); … … 10 25 use Net::DNS; 11 26 use Getopt::Long; 27 28 our $VERSION = 0.1; 12 29 13 30 BEGIN { … … 38 55 ################################################################################ 39 56 40 41 ################################################################################ 42 ################################################################################ 43 package BarnOwl::Jabber::Connection; 44 45 use base qw(Net::Jabber::Client); 46 47 sub new { 48 my $class = shift; 49 50 my %args = (); 51 if(BarnOwl::getvar('debug') eq 'on') { 52 $args{debuglevel} = 1; 53 $args{debugfile} = 'jabber.log'; 54 } 55 my $self = $class->SUPER::new(%args); 56 $self->{_BARNOWL_MUCS} = []; 57 return $self; 58 } 59 60 =head2 MUCJoin 61 62 Extends MUCJoin to keep track of the MUCs we're joined to as 63 Net::Jabber::MUC objects. Takes the same arguments as 64 L<Net::Jabber::MUC/new> and L<Net::Jabber::MUC/Connect> 65 66 =cut 67 68 sub MUCJoin { 69 my $self = shift; 70 my $muc = Net::Jabber::MUC->new(connection => $self, @_); 71 $muc->Join(@_); 72 push @{$self->MUCs}, $muc; 73 } 74 75 =head2 MUCLeave ARGS 76 77 Leave a MUC. The MUC is specified in the same form as L</FindMUC> 78 79 =cut 80 81 sub MUCLeave { 82 my $self = shift; 83 my $muc = $self->FindMUC(@_); 84 return unless $muc; 85 86 $muc->Leave(); 87 $self->{_BARNOWL_MUCS} = [grep {$_->BaseJID ne $muc->BaseJID} $self->MUCs]; 88 } 89 90 =head2 FindMUC ARGS 91 92 Return the Net::Jabber::MUC object representing a specific MUC we're 93 joined to, undef if it doesn't exists. ARGS can be either JID => $JID, 94 or Room => $room, Server => $server. 95 96 =cut 97 98 sub FindMUC { 99 my $self = shift; 100 101 my %args; 102 while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); } 103 104 my $jid; 105 if($args{jid}) { 106 $jid = $args{jid}; 107 } elsif($args{room} && $args{server}) { 108 $jid = Net::Jabber::JID->new(userid => $args{room}, 109 server => $args{server}); 110 } 111 $jid = $jid->GetJID('base') if UNIVERSAL::isa($jid, 'Net::XMPP::JID'); 112 113 foreach my $muc ($self->MUCs) { 114 return $muc if $muc->BaseJID eq $jid; 115 } 116 return undef; 117 } 118 119 =head2 MUCs 120 121 Returns a list (or arrayref in scalar context) of Net::Jabber::MUC 122 objects we believe ourself to be connected to. 123 124 =cut 125 126 sub MUCs { 127 my $self = shift; 128 my $mucs = $self->{_BARNOWL_MUCS}; 129 return wantarray ? @$mucs : $mucs; 130 } 131 132 ################################################################################ 133 ################################################################################ 134 package BarnOwl::Jabber::ConnectionManager; 135 sub new { 136 my $class = shift; 137 return bless { }, $class; 138 } 139 140 sub addConnection { 141 my $self = shift; 142 my $jidStr = shift; 143 144 my $client = BarnOwl::Jabber::Connection->new; 145 146 $self->{$jidStr}->{Client} = $client; 147 $self->{$jidStr}->{Roster} = $client->Roster(); 148 $self->{$jidStr}->{Status} = "available"; 149 return $client; 150 } 151 152 sub removeConnection { 153 my $self = shift; 154 my $jidStr = shift; 155 return 0 unless exists $self->{$jidStr}; 156 157 $self->{$jidStr}->{Client}->Disconnect() 158 if $self->{$jidStr}->{Client}; 159 delete $self->{$jidStr}; 160 161 return 1; 162 } 163 164 sub connected { 165 my $self = shift; 166 return scalar keys %{ $self }; 167 } 168 169 sub getJIDs { 170 my $self = shift; 171 return keys %{ $self }; 172 } 173 174 sub jidExists { 175 my $self = shift; 176 my $jidStr = shift; 177 return exists $self->{$jidStr}; 178 } 179 180 sub sidExists { 181 my $self = shift; 182 my $sid = shift || ""; 183 foreach my $c ( values %{ $self } ) { 184 return 1 if ($c->{Client}->{SESSION}->{id} eq $sid); 185 } 186 return 0; 187 } 188 189 sub getConnectionFromSid { 190 my $self = shift; 191 my $sid = shift; 192 foreach my $c (values %{ $self }) { 193 return $c->{Client} if $c->{Client}->{SESSION}->{id} eq $sid; 194 } 195 return undef; 196 } 197 198 sub getConnectionFromJID { 199 my $self = shift; 200 my $jid = shift; 201 $jid = $jid->GetJID('full') if UNIVERSAL::isa($jid, 'Net::XMPP::JID'); 202 return $self->{$jid}->{Client} if exists $self->{$jid}; 203 } 204 205 sub getRosterFromSid { 206 my $self = shift; 207 my $sid = shift; 208 foreach my $c (values %{ $self }) { 209 return $c->{Roster} 210 if $c->{Client}->{SESSION}->{id} eq $sid; 211 } 212 return undef; 213 } 214 215 sub getRosterFromJID { 216 my $self = shift; 217 my $jid = shift; 218 $jid = $jid->GetJID('full') if UNIVERSAL::isa($jid, 'Net::XMPP::JID'); 219 return $self->{$jid}->{Roster} if exists $self->{$jid}; 220 } 221 ################################################################################ 222 223 package BarnOwl::Jabber; 224 225 our $conn = new BarnOwl::Jabber::ConnectionManager unless $conn;; 57 our $conn = BarnOwl::Module::Jabber::ConnectionManager->new unless $conn;; 226 58 our %vars; 227 59 … … 229 61 if ( *BarnOwl::queue_message{CODE} ) { 230 62 register_owl_commands(); 231 register_keybindings() unless $BarnOwl::reload;232 register_filters() unless $BarnOwl::reload;233 push @::onMainLoop, sub { BarnOwl::Jabber::onMainLoop(@_) };234 push @::onGetBuddyList, sub { BarnOwl::Jabber::onGetBuddyList(@_) };63 register_keybindings(); 64 register_filters(); 65 $BarnOwl::Hooks::mainLoop->add(\&onMainLoop); 66 $BarnOwl::Hooks::getBuddyList->add(\&onGetBuddyList); 235 67 $vars{show} = ''; 236 68 } else { … … 241 73 } 242 74 243 push @::onStartSubs, sub { BarnOwl::Jabber::onStart(@_) };75 $BarnOwl::Hooks::startup->add(\&onStart); 244 76 245 77 sub onMainLoop { … … 303 135 $blistStr .= " [" . ( $rq{show} ? $rq{show} : 'online' ) . "]"; 304 136 $blistStr .= " " . $rq{status} if $rq{status}; 305 $blistStr = boldify($blistStr);137 $blistStr = BarnOwl::Style::boldify($blistStr); 306 138 } 307 139 else { … … 326 158 my $roster = $conn->getRosterFromJID($jid); 327 159 if ($roster) { 328 $blist .= "\n" . boldify("Jabber Roster for $jid\n");160 $blist .= "\n" . BarnOwl::Style::boldify("Jabber Roster for $jid\n"); 329 161 330 162 foreach my $group ( $roster->groups() ) { … … 497 329 # when we reload 498 330 $client->SetMessageCallBacks( 499 chat => sub { BarnOwl:: Jabber::process_incoming_chat_message(@_) },500 error => sub { BarnOwl:: Jabber::process_incoming_error_message(@_) },501 groupchat => sub { BarnOwl:: Jabber::process_incoming_groupchat_message(@_) },502 headline => sub { BarnOwl:: Jabber::process_incoming_headline_message(@_) },503 normal => sub { BarnOwl:: Jabber::process_incoming_normal_message(@_) }331 chat => sub { BarnOwl::Module::Jabber::process_incoming_chat_message(@_) }, 332 error => sub { BarnOwl::Module::Jabber::process_incoming_error_message(@_) }, 333 groupchat => sub { BarnOwl::Module::Jabber::process_incoming_groupchat_message(@_) }, 334 headline => sub { BarnOwl::Module::Jabber::process_incoming_headline_message(@_) }, 335 normal => sub { BarnOwl::Module::Jabber::process_incoming_normal_message(@_) } 504 336 ); 505 337 $client->SetPresenceCallBacks( 506 available => sub { BarnOwl:: Jabber::process_presence_available(@_) },507 unavailable => sub { BarnOwl:: Jabber::process_presence_available(@_) },508 subscribe => sub { BarnOwl:: Jabber::process_presence_subscribe(@_) },509 subscribed => sub { BarnOwl:: Jabber::process_presence_subscribed(@_) },510 unsubscribe => sub { BarnOwl:: Jabber::process_presence_unsubscribe(@_) },511 unsubscribed => sub { BarnOwl:: Jabber::process_presence_unsubscribed(@_) },512 error => sub { BarnOwl:: Jabber::process_presence_error(@_) });338 available => sub { BarnOwl::Module::Jabber::process_presence_available(@_) }, 339 unavailable => sub { BarnOwl::Module::Jabber::process_presence_available(@_) }, 340 subscribe => sub { BarnOwl::Module::Jabber::process_presence_subscribe(@_) }, 341 subscribed => sub { BarnOwl::Module::Jabber::process_presence_subscribed(@_) }, 342 unsubscribe => sub { BarnOwl::Module::Jabber::process_presence_unsubscribe(@_) }, 343 unsubscribed => sub { BarnOwl::Module::Jabber::process_presence_unsubscribed(@_) }, 344 error => sub { BarnOwl::Module::Jabber::process_presence_error(@_) }); 513 345 514 346 my $status = $client->Connect( %{ $vars{jlogin_connhash} } ); … … 800 632 my $str = ""; 801 633 foreach my $jid ($conn->getJIDs()) { 802 $str .= boldify("Conferences for $jid:\n");634 $str .= BarnOwl::Style::boldify("Conferences for $jid:\n"); 803 635 my $connection = $conn->getConnectionFromJID($jid); 804 636 foreach my $muc ($connection->MUCs) { … … 1307 1139 } 1308 1140 1309 sub boldify($) {1310 my $str = shift;1311 1312 return '@b(' . $str . ')' if ( $str !~ /\)/ );1313 return '@b<' . $str . '>' if ( $str !~ /\>/ );1314 return '@b{' . $str . '}' if ( $str !~ /\}/ );1315 return '@b[' . $str . ']' if ( $str !~ /\]/ );1316 1317 my $txt = "$str";1318 $txt =~ s{[)]}{)\@b[)]\@b(}g;1319 return '@b(' . $txt . ')';1320 }1321 1322 1141 sub getServerFromJID { 1323 1142 my $jid = shift; … … 1457 1276 } 1458 1277 1459 #####################################################################1460 #####################################################################1461 1462 package BarnOwl::Message::Jabber;1463 1464 our @ISA = qw( BarnOwl::Message );1465 1466 sub jtype { shift->{jtype} };1467 sub from { shift->{from} };1468 sub to { shift->{to} };1469 sub room { shift->{room} };1470 sub status { shift->{status} }1471 1472 sub login_extra {1473 my $self = shift;1474 my $show = $self->{show};1475 my $status = $self->status;1476 my $s = "";1477 $s .= $show if $show;1478 $s .= ", $status" if $status;1479 return $s;1480 }1481 1482 sub long_sender {1483 my $self = shift;1484 return $self->from;1485 }1486 1487 sub context {1488 return shift->room;1489 }1490 1491 sub smartfilter {1492 my $self = shift;1493 my $inst = shift;1494 1495 my ($filter, $ftext);1496 1497 if($self->jtype eq 'chat') {1498 my $user;1499 if($self->direction eq 'in') {1500 $user = $self->from;1501 } else {1502 $user = $self->to;1503 }1504 return smartfilter_user($user, $inst);1505 } elsif ($self->jtype eq 'groupchat') {1506 my $room = $self->room;1507 $filter = "jabber-room-$room";1508 $ftext = qq{type ^jabber\$ and room ^$room\$};1509 BarnOwl::filter("$filter $ftext");1510 return $filter;1511 } elsif ($self->login ne 'none') {1512 return smartfilter_user($self->from, $inst);1513 }1514 }1515 1516 sub smartfilter_user {1517 my $user = shift;1518 my $inst = shift;1519 1520 $user = Net::Jabber::JID->new($user)->GetJID( $inst ? 'full' : 'base' );1521 my $filter = "jabber-user-$user";1522 my $ftext =1523 qq{type ^jabber\$ and ( ( direction ^in\$ and from ^$user ) }1524 . qq{or ( direction ^out\$ and to ^$user ) ) };1525 BarnOwl::filter("$filter $ftext");1526 return $filter;1527 1528 }1529 1530 1531 1278 1;
Note: See TracChangeset
for help on using the changeset viewer.