Changeset b9766ea for perl/modules

Timestamp:

Dec 19, 2014, 1:49:13 AM (7 years ago)

Author:

Edward Z. Yang <ezyang@mit.edu>

Parents:

5f3f1e4 (diff), 416a7e5 (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.

Message:

Merge 416a7e53b80360ba0764edaa41a78445e5a9465c into 5f3f1e484f3c4b262b481efbd32602853bb41a27

Location:

perl/modules

Files:

• Jabber/lib/BarnOwl/Module/Jabber.pm (modified) (4 diffs)
• .gitignore (added)
• Facebook/.gitignore (deleted)
• Facebook/README (modified) (1 diff)
• IRC/lib/BarnOwl/Module/IRC.pm (modified) (12 diffs)
• IRC/lib/BarnOwl/Module/IRC/Completion.pm (modified) (2 diffs)
• IRC/lib/BarnOwl/Module/IRC/Connection.pm (modified) (4 diffs)
• Twitter/.gitignore (deleted)
• Twitter/.hgignore (deleted)
• Twitter/lib/BarnOwl/Module/Twitter.pm (modified) (3 diffs)
• Twitter/lib/BarnOwl/Module/Twitter/Handle.pm (modified) (2 diffs)

perl/modules/Jabber/lib/BarnOwl/Module/Jabber.pm

@@ -171 +171 @@
 our $showOffline = 0;
 
+sub blist_getBuddyStatus {
+    my $jid = shift;
+    my $buddy = shift;
+    my $roster = $conn->getRosterFromJID($jid);
+    my %jq  = $roster->query($buddy);
+    my $res = $roster->resource($buddy);
+    if ($res) {
+        my %rq = $roster->resourceQuery( $buddy, $res );
+        return $rq{show} ? $rq{show} : 'online';
+    } else {
+        return "unknown";
+    }
+}
+
 sub blist_listBuddy {
     my $roster = shift;
@@ -303 +317 @@
             summary => "Show your Jabber roster.",
             usage   => "jlist"
+        }
+    );
+    BarnOwl::new_command(
+        jabber_get_buddy_status => \&cmd_jabber_get_buddy_status,
+        {
+            summary => "Get the status of a given buddy.",
+            usage   => "jabber_get_buddy_status [-a account] buddy"
         }
     );
@@ -859 +880 @@
 }
 
+sub cmd_jabber_get_buddy_status {
+    my $cmd = shift;
+    local @ARGV = @_;
+    my $getopt = Getopt::Long::Parser->new;
+    my ($jid, $buddy);
+
+    $getopt->configure('no_getopt_compat');
+    $getopt->getoptions(
+        'account=s' => \$jid,
+    );
+    $jid ||= defaultJID();
+    if ($jid) {
+        $jid = resolveConnectedJID($jid);
+        return unless $jid;
+    }
+    else {
+        die("You must specify an account with -a <jid>\n");
+    }
+    $buddy = shift @ARGV;
+    if(!$buddy) {
+        die("You must specify a JID to get the status of.\n");
+    }
+    my $buddy_jid = resolveDestJID($buddy, $jid);
+    return blist_getBuddyStatus($jid, $buddy_jid);
+}
+
 
 sub jroster_sub {
@@ -1491 +1538 @@
 }
 
+sub complete_jabber_get_buddy_status {
+    my $ctx = shift;
+    return complete_flags($ctx,
+                          [qw()],
+                          {
+                              "-a" => \&complete_account,
+                          },
+                          \&complete_user_or_muc
+        );
+}
+
 BarnOwl::Completion::register_completer(jwrite => sub { BarnOwl::Module::Jabber::complete_jwrite(@_) });
 BarnOwl::Completion::register_completer(jabberlogout => sub { BarnOwl::Module::Jabber::complete_jabberlogout(@_) });
+BarnOwl::Completion::register_completer(jabber_get_buddy_status => sub { BarnOwl::Module::Jabber::complete_jabber_get_buddy_status(@_) });
 
 1;

perl/modules/Facebook/README

@@ -14 +14 @@
 
   This token will persist across BarnOwls until you change your
-  Facebook password or you revoke permissions for Barnowl at:
+  Facebook password or you revoke permissions for BarnOwl at:
     http://www.facebook.com/settings/?tab=applications&app_id=235537266461636
 
-  (3) Start receiving wall updates in Barnowl!
+  (3) Start receiving wall updates in BarnOwl!
   You can post updates with the ":facebook" command.
 

perl/modules/IRC/lib/BarnOwl/Module/IRC.pm

@@ -21 +21 @@
 
 use AnyEvent::IRC;
+use Encode;
+use File::Spec;
 use Getopt::Long;
-use Encode;
 use Text::Wrap;
 
 our $VERSION = 0.02;
+
+our $IRC_SUBS_FILENAME = "ircchannels";
 
 our $irc;
@@ -169 +172 @@
             summary => 'Connect to an IRC server',
             usage =>
-'irc-connect [-a ALIAS ] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
+'irc-connect [-a ALIAS] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
             description => <<END_DESCR
 Connect to an IRC server. Supported options are:
@@ -230 +233 @@
         {
             summary => 'Join an IRC channel',
-            usage   => 'irc-join [-a ALIAS] #channel [KEY]',
-
-            description => <<END_DESCR
-Join an IRC channel.
+            usage   => 'irc-join [-a ALIAS] [-t] #channel [KEY]',
+
+            description => <<END_DESCR
+Join an IRC channel.  If the -t option is present the subscription will only be
+temporary, i.e., it will not be written to the subscription file and will
+therefore not be present the next time BarnOwl is started, and will disappear
+if the connection is lost.
 END_DESCR
         }
@@ -242 +248 @@
         {
             summary => 'Leave an IRC channel',
-            usage   => 'irc-part [-a ALIAS] #channel',
-
-            description => <<END_DESCR
-Part from an IRC channel.
+            usage   => 'irc-part [-a ALIAS] [-t] #channel',
+
+            description => <<END_DESCR
+Part from an IRC channel.  If the -t option is present the unsubscription will
+only be temporary, i.e., it will not be updated in the subscription file and
+will therefore not be in effect the next time BarnOwl is started, or if the
+connection is lost.
 END_DESCR
         }
@@ -342 +351 @@
 This can be used to perform some operation not yet supported by
 BarnOwl, or to define new IRC commands.
+END_DESCR
+        }
+    );
+
+    BarnOwl::new_command(
+        'irc-loadchannels' => \&cmd_loadchannels,
+        {
+            summary => 'Reload persistent channels',
+            usage   => 'irc-loadchannels [-a ALIAS] [<file>]',
+
+            description => <<END_DESCR
+Load persistent channels from a file.  The file defaults to
+\$HOME/.owl/$IRC_SUBS_FILENAME.  If the ALIAS is present, only channels
+on the given alias are loaded.  The ALIAS is case-sensitive.
+
+Each line of the file should describe a single channel, in the format
+'\$alias \$channel' (without quotes).
 END_DESCR
         }
@@ -356 +382 @@
 ######################## Owl command handlers ##################################
 ################################################################################
+
+sub make_autoconnect_filename {
+    # can't use ||, or else we'll treat '0' as invalid.  We could check for eq "" ...
+    # TODO(jgross): When we move to requiring perl 5.10, combine the
+    # following two lines using //
+    my $filename = shift;
+    $filename = File::Spec->catfile(BarnOwl::get_config_dir(), $IRC_SUBS_FILENAME) unless defined $filename;
+    if (!File::Spec->file_name_is_absolute($filename)) {
+        $filename = File::Spec->catfile($ENV{HOME}, $filename);
+    }
+    return $filename;
+}
+
+sub _get_autoconnect_lines {
+    my $filename = shift;
+
+    # TODO(jgross): Write a C-side function to do this, asynchronously;
+    #               AIUI, perl doesn't do asynchronous I/O in any useful way
+    if (open (my $subsfile, "<:encoding(UTF-8)", $filename)) {
+        my @lines = <$subsfile>;
+        close($subsfile);
+
+        # strip trailing newlines
+        local $/ = "";
+        chomp(@lines);
+
+        return @lines;
+    }
+
+    return ();
+}
+
+sub get_autoconnect_channels {
+    my $filename = make_autoconnect_filename(shift);
+    my %channel_hash = ();
+
+    # Load the subs from the file
+    my @lines = _get_autoconnect_lines($filename);
+
+    foreach my $line (@lines) {
+        my @parsed_args = split(' ', $line);
+        if (scalar @parsed_args == 2) {
+            push @{$channel_hash{$parsed_args[0]}}, $parsed_args[1];
+        } else {
+            warn "Trouble parsing irc configuration file '$filename' line '$line'; the format is '\$alias \$channel', with no spaces in either\n";
+        }
+    }
+
+    return %channel_hash;
+}
+
+sub add_autoconnect_channel {
+    my $conn = shift;
+    my $channel = shift;
+    my $alias = $conn->alias;
+    my $filename = make_autoconnect_filename(shift);
+
+    # we already checked for spaces in $channel in cmd_join, but we still need
+    # to check $alias
+    die "Alias name '$alias' contains a space; parsing will fail.  Use the -t flag.\n" unless index($alias, " ") == -1;
+
+    my $line = "$alias $channel";
+
+    my @lines = _get_autoconnect_lines($filename);
+
+    # We don't want to be noisy about duplicated joins.  For example, some
+    # people might have :irc-join in startup files, even though that doesn't
+    # work correctly anymore because connect is asynchronous and so join on
+    # startup races with connect.  Regardless, just fail silently if the line
+    # already exists.
+    return if grep { $_ eq $line } @lines;
+
+    open (my $subsfile, ">>:encoding(UTF-8)", make_autoconnect_filename($filename))
+        or die "Cannot open $filename for writing: $!\n";
+    local $, = "";
+    local $/ = "";
+    print $subsfile "$line\n";
+    close($subsfile);
+}
+
+sub remove_autoconnect_channel {
+    my $conn = shift;
+    my $channel = shift;
+    my $alias = $conn->alias;
+    my $filename = make_autoconnect_filename(shift);
+
+    BarnOwl::Internal::file_deleteline($filename, "$alias $channel", 1);
+}
+
+sub cmd_loadchannels {
+    my $cmd = shift;
+    my $alias;
+    my $getopt = Getopt::Long::Parser->new;
+
+    local @ARGV = @_;
+    $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
+    $getopt->getoptions("alias=s" => \$alias);
+
+    my %channel_hash = get_autoconnect_channels(@ARGV);
+
+    my $aliases = (defined $alias) ? [$alias] : [keys %channel_hash];
+
+    foreach my $cur_alias (@$aliases) {
+        # get_connection_by_alias might die, and we don't want to
+        eval {
+            my $conn = get_connection_by_alias($cur_alias, 1);
+            my %existing_channels = map { $_ => 1 } @{$conn->autoconnect_channels}, @{$channel_hash{$cur_alias}};
+            $conn->autoconnect_channels([keys %existing_channels]);
+        };
+        foreach my $channel (@{$channel_hash{$cur_alias}}) {
+            if ($cur_alias eq "") {
+                BarnOwl::command("irc-join", "-t", $channel);
+            } else {
+                BarnOwl::command("irc-join", "-t", "-a", $cur_alias, $channel);
+            }
+        }
+    }
+}
 
 sub cmd_connect {
@@ -393 +537 @@
     }
 
+    my %channel_hash = get_autoconnect_channels;
+
     my $conn = BarnOwl::Module::IRC::Connection->new($alias, $host, $port, {
-        nick      => $nick,
-        user      => $username,
-        real      => $ircname,
-        password  => $password,
-        SSL       => $ssl,
-        timeout   => sub {0}
+        nick                 => $nick,
+        user                 => $username,
+        real                 => $ircname,
+        password             => $password,
+        SSL                  => $ssl,
+        timeout              => sub {0},
+        autoconnect_channels => $channel_hash{$alias}
        });
     $ircnets{$alias} = $conn;
@@ -486 +633 @@
 sub cmd_join {
     my $cmd = shift;
-    my $conn = shift;
-    my $chan = shift or die("Usage: $cmd channel\n");
-    $conn->conn->send_msg(join => $chan, @_);
+    my $is_temporary;
+
+    my $getopt = Getopt::Long::Parser->new;
+
+    local @ARGV = @_;
+    $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
+    $getopt->getoptions("temporary" => \$is_temporary);
+
+    my $conn = shift @ARGV;
+    my $chan = shift @ARGV or die("Usage: $cmd channel\n");
+
+    die "Channel name '$chan' contains a space.  As per RFC 2812, IRC channel names may not contain spaces.\n" unless index($chan, " ") == -1;
+
+    $conn->conn->send_msg(join => $chan, @ARGV);
+
+    # regardless of whether or not this is temporary, we want to persist it
+    # across reconnects.
+
+    # check if the channel is already in the list
+    if (!grep { $_ eq $chan } @{$conn->autoconnect_channels}) {
+        push @{$conn->autoconnect_channels}, $chan;
+    }
+
+    if (!$is_temporary) {
+        # add the line to the subs file
+        add_autoconnect_channel($conn, $chan);
+    }
+
     return;
 }
@@ -494 +666 @@
 sub cmd_part {
     my $cmd = shift;
-    my $conn = shift;
-    my $chan = shift;
+    my $is_temporary;
+
+    my $getopt = Getopt::Long::Parser->new;
+
+    local @ARGV = @_;
+    $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
+    $getopt->getoptions("temporary" => \$is_temporary);
+
+    my $conn = shift @ARGV;
+    my $chan = shift @ARGV or die("Usage: $cmd channel\n");
+
     $conn->conn->send_msg(part => $chan);
+
+    # regardless of whether or not this is temporary, we want to persist it
+    # across reconnects
+    my %existing_channels = map { $_ => 1 } @{$conn->autoconnect_channels};
+    delete $existing_channels{$chan};
+    $conn->autoconnect_channels([keys %existing_channels]);
+
+    if (!$is_temporary) {
+        # remove the line from the subs file
+        remove_autoconnect_channel($conn, $chan);
+    }
+
     return;
 }
@@ -596 +789 @@
         my $alias;
         my $channel;
+        my $is_temporary;
         my $getopt = Getopt::Long::Parser->new;
         my $m = BarnOwl::getcurmsg();
@@ -601 +795 @@
         local @ARGV = @_;
         $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
-        $getopt->getoptions("alias=s" => \$alias);
+        $getopt->getoptions("alias=s" => \$alias,
+                            "temporary" => \$is_temporary);
 
         if(defined($alias)) {
@@ -640 +835 @@
             die("You must specify an IRC network using -a.\n");
         }
+        push @ARGV, "-t" if $is_temporary;
         if($flags & CHANNEL_ARG) {
             $sub->($cmd, $conn, $channel, @ARGV);

perl/modules/IRC/lib/BarnOwl/Module/IRC/Completion.pm

@@ -57 +57 @@
 }
 
+sub complete_irc_join_part {
+    my $ctx = shift;
+    return complete_flags($ctx,
+        [qw(-t)],
+        {
+            "-a" => \&complete_networks,
+        },
+        \&complete_channels
+       );
+}
+
 sub complete_irc_channel {
     my $ctx = shift;
@@ -95 +106 @@
 BarnOwl::Completion::register_completer('irc-msg'        => \&complete_irc_dest);
 BarnOwl::Completion::register_completer('irc-mode'       => \&complete_irc_dest);
-BarnOwl::Completion::register_completer('irc-join'       => \&complete_irc_channel);
-BarnOwl::Completion::register_completer('irc-part'       => \&complete_irc_channel);
+BarnOwl::Completion::register_completer('irc-join'       => \&complete_irc_join_part);
+BarnOwl::Completion::register_completer('irc-part'       => \&complete_irc_join_part);
 BarnOwl::Completion::register_completer('irc-names'      => \&complete_irc_channel);
 BarnOwl::Completion::register_completer('irc-whois'      => \&complete_irc_nick);

perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm

@@ -39 +39 @@
     my $self = bless({}, $class);
     $self->conn($conn);
-    $self->autoconnect_channels([]);
+    # TODO(jgross): use // when we move to requiring perl 5.10
+    $self->autoconnect_channels(defined $args->{autoconnect_channels} ? $args->{autoconnect_channels} : []);
     $self->alias($alias);
     $self->server($host);
@@ -412 +413 @@
         $self->{reconnect_timer}->stop;
     }
-    $self->{reconnect_timer} = 
+    $self->{reconnect_timer} =
         BarnOwl::Timer->new( {
             name  => 'IRC (' . $self->alias . ') reconnect_timer',
@@ -445 +446 @@
             $self->conn->send_msg(join => $c);
         }
-        $self->autoconnect_channels([]);
     }
     $self->conn->enable_ping(60, sub {
@@ -458 +458 @@
     my $backoff = $self->backoff;
 
-    $self->autoconnect_channels([keys(%{$self->{channel_list}})]);
     $self->conn->connect(@{$self->connect_args});
 }

perl/modules/Twitter/lib/BarnOwl/Module/Twitter.pm

@@ -137 +137 @@
         my $twitter_args = { username   => $cfg->{user},
                              password   => $cfg->{password},
-                             source     => 'barnowl', 
+                             source     => 'barnowl',
+                             ssl        => 1,
+                             legacy_lists_api => 0,
                          };
         if (defined $cfg->{service}) {
@@ -274 +276 @@
 );
 
+BarnOwl::new_command( 'twitter-favorite' => sub { cmd_twitter_favorite(@_) },
+    {
+    summary     => 'Favorite the current Twitter message',
+    usage       => 'twitter-favorite [ACCOUNT]',
+    description => <<END_DESCRIPTION
+Favorite the current Twitter message using ACCOUNT (defaults to the
+account that received the tweet).
+END_DESCRIPTION
+    }
+);
+
 BarnOwl::new_command( 'twitter-follow' => sub { cmd_twitter_follow(@_); },
     {
@@ -355 +368 @@
     $account = $m->account unless defined($account);
     find_account($account)->twitter_retweet($m);
+    return;
+}
+
+sub cmd_twitter_favorite {
+    my $cmd = shift;
+    my $account = shift;
+    my $m = BarnOwl::getcurmsg();
+    if(!$m || $m->type ne 'Twitter') {
+        die("$cmd must be used with a Twitter message selected.\n");
+    }
+
+    $account = $m->account unless defined($account);
+    find_account($account)->twitter_favorite($m);
     return;
 }

perl/modules/Twitter/lib/BarnOwl/Module/Twitter/Handle.pm

@@ -371 +371 @@
         $self->twitter_direct($1, $2);
     } elsif(defined $self->{twitter}) {
-        if(length($msg) > 140) {
-            die("Twitter: Message over 140 characters long.\n");
-        }
         $self->twitter_command('update', {
             status => $msg,
@@ -432 +429 @@
 }
 
+sub twitter_favorite {
+    my $self = shift;
+    my $msg = shift;
+
+    if($msg->service ne $self->{cfg}->{service}) {
+        die("Cannot favorite a message from a different service.\n");
+    }
+    $self->twitter_command(create_favorite => $msg->{status_id});
+}
+
+
 sub twitter_follow {
     my $self = shift;