Changeset b6a253c for perl/modules


Ignore:
Timestamp:
Nov 3, 2006, 10:54:00 PM (15 years ago)
Author:
Alejandro R. Sedeño <asedeno@mit.edu>
Branches:
master, barnowl_perlaim, debian, release-1.4, release-1.5, release-1.6, release-1.7, release-1.8, release-1.9
Children:
6a6dd47
Parents:
a75309a
Message:
jabber.pl:
  * Roster added to buddy list.
  * Command jlist added to get roster.

perlglue.xs:
  * Exposed owl_fuction_popless_text()  as owl::popless_text()
  * Exposed owl_fuction_popless_ztext() as owl::popless_ztext()
File:
1 edited

Legend:

Unmodified
Added
Removed
  • perl/modules/jabber.pl

    r38ffdf9 rb6a253c  
    55# owl perl jabber support
    66#
    7 # Todo:
    8 # Connect command.
     7# XXX Todo:
     8# Rosters for MUCs
     9# More user feedback
     10#  * joining MUC
     11#  * parting MUC
     12#  * presence (Roster and MUC)
     13# Implementing formatting and logging callbacks for C
     14# Appropriate callbacks for presence subscription messages.
     15#  * Current behavior => auto-accept (default for Net::Jabber)
    916#
    1017################################################################################
     
    1219our $client;
    1320our $jid;
     21our $roster;
    1422
    1523sub onStart
     
    1826    {
    1927        register_owl_commands();
     28        push @::onMainLoop, sub { owl_jabber::onMainLoop(@_) };
     29        push @::onGetBuddyList, sub { owl_jabber::onGetBuddyList(@_) };
    2030    }
    2131    else
     
    2636    }
    2737}
    28 push @::onStartSubs, \&onStart;
     38push @::onStartSubs, sub { owl_jabber::onStart(@_) };
    2939
    3040sub onMainLoop
     
    4050    {
    4151        queue_admin_msg("Jabber disconnected.");
     52        $roster = undef;
    4253        $client = undef;
    4354        return;
     
    4657    if ($::shutdown)
    4758    {
     59        $roster = undef;
    4860        $client->Disconnect();
    4961        $client = undef;
     
    5163    }
    5264}
    53 push @::onMainLoop, \&onMainLoop;
     65
     66sub blist_listBuddy
     67{
     68    my $buddy = shift;
     69    my $blistStr .= "    ";
     70    my %jq = $roster->query($buddy);
     71    my $res = $roster->resource($buddy);
     72
     73    $blistStr .= $jq{name} ? $jq{name} : $buddy->GetJID();
     74   
     75    if ($res)
     76    {
     77        my %rq = $roster->resourceQuery($buddy, $res);
     78        $blistStr .= " [".($rq{show} ? $rq{show} : 'online')."]";
     79        $blistStr .= " ".$rq{status} if $rq{status};
     80        $blistStr = boldify($blistStr);
     81    }
     82    else
     83    {
     84        $blistStr .= $jq{ask} ? " [pending]" : " [offline]";
     85    }
     86
     87    return $blistStr."\n";
     88}
     89
     90sub onGetBuddyList
     91{
     92    return "" if ($client == undef);
     93    my $blist = "\n".boldify("Jabber Roster for ".$jid->GetJID('base'))."\n";
     94
     95    foreach my $group ($roster->groups())
     96    {
     97        $blist .= "  Group: $group\n";
     98        foreach my $buddy ($roster->jids('group',$group))
     99        {
     100            $blist .= blist_listBuddy($buddy);
     101        }
     102    }
     103   
     104    my @unsorted = $roster->jids('nogroup');
     105    if (@unsorted)
     106    {
     107        $blist .= "  [unsorted]\n";
     108        foreach my $buddy (@unsorted)
     109        {
     110            $blist .= blist_listBuddy($buddy);
     111        }
     112    }
     113
     114    $blist .= "\n";
     115}
    54116
    55117################################################################################
     
    69131        {
    70132            summary     => "Send a Jabber Message",
    71             usage       => "jwrite JID [-t thread]"
     133            usage       => "jwrite JID [-g] [-t thread] [-s subject]"
    72134        }
    73135    );
    74136    owl::new_command(
    75         jchat => \&cmd_jwrite_gc,
     137        jlist => \&cmd_jlist,
    76138        {
    77             summary => "Send a Jabber Message",
    78             usage       => "jchat [room]@[server]"
     139            summary     => "Show your Jabber roster.",
     140            usage       => "jlist"
    79141        }
    80142    );
    81143    owl::new_command(
    82         jjoin => \&cmd_join_gc,
     144        jmuc => \&cmd_jmuc,
    83145        {
    84             summary     => "Joins a jabber groupchat.",
    85             usage       => "jjoin [room]@[server]/[nick]"
     146            summary     => "Jabber MUC related commands.",
     147            description => "jmuc sends jabber commands related to muc.\n\n".
     148                "The following commands are available\n\n".
     149                "join {muc}  Join a muc.\n\n".
     150                "part [muc]  Part a muc.".
     151                "            The muc is taken from the current message if not supplied.\n\n".
     152                "invite {jid} [muc]\n\n".
     153                "            Invite {jid} to [muc].\n".
     154                "            The muc is taken from the current message if not supplied.\n\n",
     155            usage       => "jmuc {command} {args}"
    86156        }
    87157    );
    88     owl::new_command(
    89         jpart => \&cmd_part_gc,
    90         {
    91             summary     => "Parts a jabber groupchat.",
    92             usage       => "jpart [room]@[server]/[nick]"
    93         }
    94     );
    95158}
    96159
     
    102165        return;
    103166    }
    104    
    105     # These strings should not be hard-coded here.
     167
     168    %muc_roster = ();
    106169    $client = Net::Jabber::Client->new();
     170    $roster = $client->Roster();
     171
     172    #XXX Todo: Add more callbacks.
     173    # MUC presence handlers
    107174    $client->SetMessageCallBacks(chat => sub { owl_jabber::process_incoming_chat_message(@_) },
    108175                                 error => sub { owl_jabber::process_incoming_error_message(@_) },
     
    110177                                 headline => sub { owl_jabber::process_incoming_headline_message(@_) },
    111178                                 normal => sub { owl_jabber::process_incoming_normal_message(@_) });
     179
     180    #XXX Todo: Parameterize the arguments to Connect()
    112181    my $status = $client->Connect(hostname => 'jabber.mit.edu',
    113182                                  tls => 1,
     
    118187    {
    119188        owl::error("We failed to connect");
    120         return;
    121     }
     189        $client = undef;
     190        return;
     191    }
     192
    122193
    123194    my @result = $client->AuthSend(username => $ENV{USER}, resource => 'owl', password => '');
    124195    if($result[0] ne 'ok') {
    125196        owl::error("Error in connect: " . join(" ", $result[1..$#result]));
     197        $roster = undef;
    126198        $client->Disconnect();
    127199        $client = undef;
     
    135207                 resource => 'owl');
    136208   
     209    $roster->fetch();
    137210    $client->PresenceSend(priority => 1);
    138211    queue_admin_msg("Connected to jabber as ".$jid->GetJID('full'));
     
    145218    if ($client)
    146219    {
     220        $roster = undef;
    147221        $client->Disconnect();
    148222        $client = undef;
     
    150224    }
    151225    return "";
     226}
     227
     228sub cmd_jlist
     229{
     230    if (!$client)
     231    {
     232        owl::error("You are not logged in to Jabber.");
     233        return;
     234    }
     235    owl::popless_ztext(onGetBuddyList());
    152236}
    153237
     
    160244    if (!$client)
    161245    {
    162         # Error here
     246        owl::error("You are not logged in to Jabber.");
    163247        return;
    164248    }
     
    173257  JW_ARG: for (my $i = 1; $i < $argsLen; $i++)
    174258    {
    175         $args[$i] =~ /^-t$/ && ($jwrite_thread = $args[++$i]  && next JW_ARG);
    176         $args[$i] =~ /^-s$/ && ($jwrite_subject = $args[++$i] && next JW_ARG);
     259        $args[$i] =~ /^-t$/ && ($jwrite_thread = $args[++$i]  and next JW_ARG);
     260        $args[$i] =~ /^-s$/ && ($jwrite_subject = $args[++$i] and next JW_ARG);
     261        $args[$i] =~ /^-g$/ && ($jwrite_type = "groupchat" and next JW_ARG);
     262
    177263        if ($jwrite_to ne '')
    178264        {
     
    189275    }
    190276
    191     if(!$jwrite_to) {
     277    if(!$jwrite_to)
     278    {
    192279        owl::error("Usage: jwrite JID [-t thread] [-s 'subject']");
    193280        return;
    194281    }
    195    
     282
     283
    196284    owl::message("Type your message below.  End with a dot on a line by itself.  ^C will quit.");
    197285    owl::start_edit_win(join(' ', @args), \&process_owl_jwrite);
    198286}
    199287
    200 sub cmd_join_gc
     288sub cmd_jmuc
    201289{
    202290    if (!$client)
    203291    {
    204         # Error here
    205         return;
    206     }
    207     if(!$_[1])
    208     {
    209         owl::error("Usage: jchat [room]@[server]/[nick]");
    210         return;
    211     }
    212 
    213     my $x = new XML::Stream::Node('x');
    214     $x->put_attrib(xmlns => 'http://jabber.org/protocol/muc');
    215     $x->add_child('history')->put_attrib(maxchars => '0');
    216 
    217 
    218     my $presence = new Net::Jabber::Presence;
    219     $presence->SetPresence(to => $_[1]);
    220     $presence->AddX($x);
    221 
    222     $client->Send($presence);
     292        owl::error("You are not logged in to Jabber.");
     293        return;
     294    }
     295   
     296    if (!$_[1])
     297    {
     298        #XXX TODO: Write general usage for jmuc command.
     299        return;
     300    }
     301
     302    my $cmd = $_[1];
     303
     304    if ($cmd eq 'join')
     305    {
     306        if (!$_[2])
     307        {
     308            owl::error('Usage: jmuc join {muc} [password]');
     309            return;
     310        }
     311        my $muc = $_[2];
     312        my $x = new XML::Stream::Node('x');
     313        $x->put_attrib(xmlns => 'http://jabber.org/protocol/muc');
     314        $x->add_child('history')->put_attrib(maxchars => '0');
     315       
     316        if ($_[3]) #password
     317        {
     318            $x->add_child('password')->add_cdata($_[3]);
     319        }
     320
     321        my $presence = new Net::Jabber::Presence;
     322        $presence->SetPresence(to => $muc);
     323        $presence->AddX($x);
     324        $client->Send($presence);
     325    }
     326    elsif ($cmd eq 'part')
     327    {
     328        my $muc;
     329        if (!$_[2])
     330        {
     331            my $m = owl::getcurmsg();
     332            if ($m->is_jabber && $m->{jtype} eq 'groupchat')
     333            {
     334                $muc = $m->{muc};
     335            }
     336            else
     337            {
     338                owl::error('Usage: "jmuc part [muc]"');
     339                return;
     340            }
     341        }
     342        else
     343        {
     344            $muc = $_[2];
     345        }
     346        $client->PresenceSend(to => $muc, type => 'unavailable');
     347    }
     348    elsif ($cmd eq 'invite')
     349    {
     350        my $jid;
     351        my $muc;
     352
     353        owl::error('Usage: jmuc invite {jid} [muc]') if (!$_[2]);
     354       
     355        if (!@_[3])
     356        {       
     357            my $m = owl::getcurmsg();
     358            if ($m->is_jabber && $m->{jtype} eq 'groupchat')
     359            {
     360                $muc = $m->{muc};
     361            }
     362            else
     363            {
     364                owl::error('Usage: jmuc invite {jid} [muc]');
     365                return;
     366            }
     367        }
     368        else
     369        {
     370            $muc = $_[3];
     371        }
     372       
     373        my $x = new XML::Stream::Node('x');
     374        $x->put_attrib(xmlns => 'http://jabber.org/protocol/muc#user');
     375        $x->add_child('invite')->put_attrib(to => $_[2]);
     376       
     377        my $message = new Net::Jabber::Message;
     378        $message->SetTo($muc);
     379        $message->AddX($x);
     380       
     381        $client->Send($message);
     382    }
     383    else
     384    {
     385        owl::error('jmuc: unrecognized command.');
     386    }
    223387    return "";
    224 }
    225 
    226 sub cmd_part_gc
    227 {
    228     if (!$client)
    229     {
    230         # Error here
    231         return;
    232     }
    233     if(!$_[1])
    234     {
    235         owl::error("Usage: jchat [room]@[server]/[nick]");
    236         return;
    237     }
    238 
    239     $client->PresenceSend(to=>$_[1], type=>'unavailable');
    240     return "";
    241 }
    242 
    243 sub cmd_jwrite_gc
    244 {
    245     if (!$client)
    246     {
    247         # Error here
    248         return;
    249     }
    250 
    251     $jwrite_to = $_[1];
    252     $jwrite_thread = "";
    253     $jwrite_subject = "";
    254     $jwrite_type = "groupchat";
    255     my @args = @_;
    256     my $argsLen = @args;
    257 
    258     owl::message("Type your message below.  End with a dot on a line by itself.  ^C will quit.");
    259     owl::start_edit_win(join(' ', @args), \&process_owl_jwrite);
    260388}
    261389
     
    296424{
    297425    my ($session, $j) = @_;
    298     queue_admin_msg("Error ".$j->GetErrorCode()." sending to ".$j->GetFrom('jid')->GetJID('base'));
     426    my %jhash = j2hash($j, 'in');
     427    $jhash{type} = 'admin';
     428    owl::queue_message(owl::Message->new(%jhash));
    299429}
    300430
     
    316446{
    317447    my ($session, $j) = @_;
    318     owl::queue_message(j2o($j, 'in'));
     448    my %props = j2hash($j, 'in');
     449
     450    # XXX TODO: handle things such as MUC invites here.
     451
     452#    if ($j->HasX('http://jabber.org/protocol/muc#user'))
     453#    {
     454#       my $x = $j->GetX('http://jabber.org/protocol/muc#user');
     455#       if ($x->HasChild('invite'))
     456#       {
     457#           $props         
     458#       }
     459#    }
     460#   
     461    owl::queue_message(owl::Message->new(%props));
     462}
     463
     464sub process_muc_presence
     465{
     466    my ($session, $p) = @_;
     467    return unless ($p->HasX('http://jabber.org/protocol/muc#user'));
     468   
    319469}
    320470
     
    322472### Helper functions
    323473
    324 sub j2o
     474sub j2hash
    325475{
    326476    my $j = shift;
     
    330480                 direction => $dir);
    331481
    332 
    333     $props{replycmd} = "jwrite";
    334 
    335     $props{jtype} = $j->GetType();
    336     $props{jtype} =~ /^(?:headline|error)$/ && {$props{replycmd} = undef};
    337     $props{jtype} =~ /^groupchat$/ && {$props{replycmd} = "jchat"};
    338 
    339     $props{isprivate} = $props{jtype} =~ /^(?:normal|chat)$/;
    340 
    341     my $reply_to;
    342     if ($j->DefinedTo())
    343     {
    344         my $jid = $j->GetTo('jid');
    345         $props{recipient} = $jid->GetJID('base');
    346         $props{to_jid} = $jid->GetJID('full');
    347         if ($dir eq 'out')
    348         {
    349             $reply_to = $props{to_jid};
    350             $props{jtype} =~ /^groupchat$/ && {$reply_to = $jid->GetJID('base')};
    351         }
    352     }
    353     if ($j->DefinedFrom())
    354     {
    355         my $jid = $j->GetFrom('jid');
    356         $props{sender} = $jid->GetJID('base');
    357         $props{from_jid} = $jid->GetJID('full');
    358         $reply_to = $props{from_jid} if ($dir eq 'in');
    359         if ($dir eq 'in')
    360         {
    361             $reply_to = $props{from_jid};
    362             $props{jtype} =~ /^groupchat$/ && {$reply_to = $jid->GetJID('base')};
    363         }
    364     }
    365 
    366     $props{subject} = $j->GetSubject() if ($j->DefinedSubject());
    367     $props{body} = $j->GetBody() if ($j->DefinedBody());
    368 #    if ($j->DefinedThread())
    369 #    {
    370 #       $props{thread} = $j->GetThread() if ($j->DefinedThread());
    371 #       $props{replycmd} .= " -t $props{thread}";
    372 #    }
    373     $props{error} = $j->GetError() if ($j->DefinedError());
     482    my $jtype = $props{jtype} = $j->GetType();
     483    my $from  = $j->GetFrom('jid');
     484    my $to    = $j->GetTo('jid');
     485
     486    $props{from} = $from->GetJID('full');
     487    $props{to}   = $to->GetJID('full');
     488
     489    $props{recipient}  = $to->GetJID('base');
     490    $props{sender}     = $from->GetJID('base');
     491    $props{subject}    = $j->GetSubject() if ($j->DefinedSubject());
     492    $props{thread}     = $j->GetThread() if ($j->DefinedThread());
     493    $props{body}       = $j->GetBody() if ($j->DefinedBody());
     494    $props{error}      = $j->GetError() if ($j->DefinedError());
    374495    $props{error_code} = $j->GetErrorCode() if ($j->DefinedErrorCode());
    375     $props{replycmd} .= " $reply_to";
     496    $props{xml}        = $j->GetXML();
     497
     498    if ($jtype eq 'chat')
     499    {
     500        $props{replycmd} = "jwrite ".(($dir eq 'in') ? $props{from} : $props{to});
     501        $props{isprivate} = 1;
     502    }
     503    elsif ($jtype eq 'groupchat')
     504    {
     505        my $nick = $props{nick} = $from->GetResource();
     506        my $room = $props{room} = $from->GetJID('base');
     507        $props{replycmd} = "jwrite -g $room";
     508       
     509        $props{sender} = $nick;
     510        $props{recipient} = $room;
     511
     512        if ($props{subject} && !$props{body})
     513        {
     514            $props{body} = '['.$nick." has set the topic to: ".$props{subject}."]"
     515        }
     516    }
     517    elsif ($jtype eq 'normal')
     518    {
     519        $props{replycmd} = undef;
     520        $props{isprivate} = 1;
     521    }
     522    elsif ($jtype eq 'headline')
     523    {
     524        $props{replycmd} = undef;
     525    }
     526    elsif ($jtype eq 'error')
     527    {
     528        $props{replycmd} = undef;
     529        $props{body} = "Error ".$props{error_code}." sending to ".$props{from}."\n".$props{error};
     530    }
     531   
    376532    $props{replysendercmd} = $props{replycmd};
    377 
    378     return owl::Message->new(%props);
     533    return %props;
     534}
     535
     536sub j2o
     537{
     538    return owl::Message->new(j2hash(@_));
    379539}
    380540
     
    387547    owl::queue_message($m);
    388548}
     549
     550sub boldify($)
     551{
     552    $str = shift;
     553
     554    return '@b('.$str.')' if ( $str !~ /\)/ );
     555    return '@b<'.$str.'>' if ( $str !~ /\>/ );
     556    return '@b{'.$str.'}' if ( $str !~ /\}/ );
     557    return '@b['.$str.']' if ( $str !~ /\]/ );
     558
     559    my $txt = "\@b($str";
     560    $txt =~ s/\)/\)\@b\[\)\]\@b\(/g;
     561    return $txt.')';
     562}
     563
Note: See TracChangeset for help on using the changeset viewer.