Changeset b9766ea for perl/modules


Ignore:
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:
1 added
3 deleted
7 edited

Legend:

Unmodified
Added
Removed
  • perl/modules/Jabber/lib/BarnOwl/Module/Jabber.pm

    r41064be rb9766ea  
    171171our $showOffline = 0;
    172172
     173sub blist_getBuddyStatus {
     174    my $jid = shift;
     175    my $buddy = shift;
     176    my $roster = $conn->getRosterFromJID($jid);
     177    my %jq  = $roster->query($buddy);
     178    my $res = $roster->resource($buddy);
     179    if ($res) {
     180        my %rq = $roster->resourceQuery( $buddy, $res );
     181        return $rq{show} ? $rq{show} : 'online';
     182    } else {
     183        return "unknown";
     184    }
     185}
     186
    173187sub blist_listBuddy {
    174188    my $roster = shift;
     
    303317            summary => "Show your Jabber roster.",
    304318            usage   => "jlist"
     319        }
     320    );
     321    BarnOwl::new_command(
     322        jabber_get_buddy_status => \&cmd_jabber_get_buddy_status,
     323        {
     324            summary => "Get the status of a given buddy.",
     325            usage   => "jabber_get_buddy_status [-a account] buddy"
    305326        }
    306327    );
     
    859880}
    860881
     882sub cmd_jabber_get_buddy_status {
     883    my $cmd = shift;
     884    local @ARGV = @_;
     885    my $getopt = Getopt::Long::Parser->new;
     886    my ($jid, $buddy);
     887
     888    $getopt->configure('no_getopt_compat');
     889    $getopt->getoptions(
     890        'account=s' => \$jid,
     891    );
     892    $jid ||= defaultJID();
     893    if ($jid) {
     894        $jid = resolveConnectedJID($jid);
     895        return unless $jid;
     896    }
     897    else {
     898        die("You must specify an account with -a <jid>\n");
     899    }
     900    $buddy = shift @ARGV;
     901    if(!$buddy) {
     902        die("You must specify a JID to get the status of.\n");
     903    }
     904    my $buddy_jid = resolveDestJID($buddy, $jid);
     905    return blist_getBuddyStatus($jid, $buddy_jid);
     906}
     907
    861908
    862909sub jroster_sub {
     
    14911538}
    14921539
     1540sub complete_jabber_get_buddy_status {
     1541    my $ctx = shift;
     1542    return complete_flags($ctx,
     1543                          [qw()],
     1544                          {
     1545                              "-a" => \&complete_account,
     1546                          },
     1547                          \&complete_user_or_muc
     1548        );
     1549}
     1550
    14931551BarnOwl::Completion::register_completer(jwrite => sub { BarnOwl::Module::Jabber::complete_jwrite(@_) });
    14941552BarnOwl::Completion::register_completer(jabberlogout => sub { BarnOwl::Module::Jabber::complete_jabberlogout(@_) });
     1553BarnOwl::Completion::register_completer(jabber_get_buddy_status => sub { BarnOwl::Module::Jabber::complete_jabber_get_buddy_status(@_) });
    14951554
    149615551;
  • perl/modules/Facebook/README

    rf4037cf r441fd42  
    1414
    1515  This token will persist across BarnOwls until you change your
    16   Facebook password or you revoke permissions for Barnowl at:
     16  Facebook password or you revoke permissions for BarnOwl at:
    1717    http://www.facebook.com/settings/?tab=applications&app_id=235537266461636
    1818
    19   (3) Start receiving wall updates in Barnowl!
     19  (3) Start receiving wall updates in BarnOwl!
    2020  You can post updates with the ":facebook" command.
    2121
  • perl/modules/IRC/lib/BarnOwl/Module/IRC.pm

    r4f7b1f4 r926c721  
    2121
    2222use AnyEvent::IRC;
     23use Encode;
     24use File::Spec;
    2325use Getopt::Long;
    24 use Encode;
    2526use Text::Wrap;
    2627
    2728our $VERSION = 0.02;
     29
     30our $IRC_SUBS_FILENAME = "ircchannels";
    2831
    2932our $irc;
     
    169172            summary => 'Connect to an IRC server',
    170173            usage =>
    171 'irc-connect [-a ALIAS ] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
     174'irc-connect [-a ALIAS] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
    172175            description => <<END_DESCR
    173176Connect to an IRC server. Supported options are:
     
    230233        {
    231234            summary => 'Join an IRC channel',
    232             usage   => 'irc-join [-a ALIAS] #channel [KEY]',
    233 
    234             description => <<END_DESCR
    235 Join an IRC channel.
     235            usage   => 'irc-join [-a ALIAS] [-t] #channel [KEY]',
     236
     237            description => <<END_DESCR
     238Join an IRC channel.  If the -t option is present the subscription will only be
     239temporary, i.e., it will not be written to the subscription file and will
     240therefore not be present the next time BarnOwl is started, and will disappear
     241if the connection is lost.
    236242END_DESCR
    237243        }
     
    242248        {
    243249            summary => 'Leave an IRC channel',
    244             usage   => 'irc-part [-a ALIAS] #channel',
    245 
    246             description => <<END_DESCR
    247 Part from an IRC channel.
     250            usage   => 'irc-part [-a ALIAS] [-t] #channel',
     251
     252            description => <<END_DESCR
     253Part from an IRC channel.  If the -t option is present the unsubscription will
     254only be temporary, i.e., it will not be updated in the subscription file and
     255will therefore not be in effect the next time BarnOwl is started, or if the
     256connection is lost.
    248257END_DESCR
    249258        }
     
    342351This can be used to perform some operation not yet supported by
    343352BarnOwl, or to define new IRC commands.
     353END_DESCR
     354        }
     355    );
     356
     357    BarnOwl::new_command(
     358        'irc-loadchannels' => \&cmd_loadchannels,
     359        {
     360            summary => 'Reload persistent channels',
     361            usage   => 'irc-loadchannels [-a ALIAS] [<file>]',
     362
     363            description => <<END_DESCR
     364Load persistent channels from a file.  The file defaults to
     365\$HOME/.owl/$IRC_SUBS_FILENAME.  If the ALIAS is present, only channels
     366on the given alias are loaded.  The ALIAS is case-sensitive.
     367
     368Each line of the file should describe a single channel, in the format
     369'\$alias \$channel' (without quotes).
    344370END_DESCR
    345371        }
     
    356382######################## Owl command handlers ##################################
    357383################################################################################
     384
     385sub make_autoconnect_filename {
     386    # can't use ||, or else we'll treat '0' as invalid.  We could check for eq "" ...
     387    # TODO(jgross): When we move to requiring perl 5.10, combine the
     388    # following two lines using //
     389    my $filename = shift;
     390    $filename = File::Spec->catfile(BarnOwl::get_config_dir(), $IRC_SUBS_FILENAME) unless defined $filename;
     391    if (!File::Spec->file_name_is_absolute($filename)) {
     392        $filename = File::Spec->catfile($ENV{HOME}, $filename);
     393    }
     394    return $filename;
     395}
     396
     397sub _get_autoconnect_lines {
     398    my $filename = shift;
     399
     400    # TODO(jgross): Write a C-side function to do this, asynchronously;
     401    #               AIUI, perl doesn't do asynchronous I/O in any useful way
     402    if (open (my $subsfile, "<:encoding(UTF-8)", $filename)) {
     403        my @lines = <$subsfile>;
     404        close($subsfile);
     405
     406        # strip trailing newlines
     407        local $/ = "";
     408        chomp(@lines);
     409
     410        return @lines;
     411    }
     412
     413    return ();
     414}
     415
     416sub get_autoconnect_channels {
     417    my $filename = make_autoconnect_filename(shift);
     418    my %channel_hash = ();
     419
     420    # Load the subs from the file
     421    my @lines = _get_autoconnect_lines($filename);
     422
     423    foreach my $line (@lines) {
     424        my @parsed_args = split(' ', $line);
     425        if (scalar @parsed_args == 2) {
     426            push @{$channel_hash{$parsed_args[0]}}, $parsed_args[1];
     427        } else {
     428            warn "Trouble parsing irc configuration file '$filename' line '$line'; the format is '\$alias \$channel', with no spaces in either\n";
     429        }
     430    }
     431
     432    return %channel_hash;
     433}
     434
     435sub add_autoconnect_channel {
     436    my $conn = shift;
     437    my $channel = shift;
     438    my $alias = $conn->alias;
     439    my $filename = make_autoconnect_filename(shift);
     440
     441    # we already checked for spaces in $channel in cmd_join, but we still need
     442    # to check $alias
     443    die "Alias name '$alias' contains a space; parsing will fail.  Use the -t flag.\n" unless index($alias, " ") == -1;
     444
     445    my $line = "$alias $channel";
     446
     447    my @lines = _get_autoconnect_lines($filename);
     448
     449    # We don't want to be noisy about duplicated joins.  For example, some
     450    # people might have :irc-join in startup files, even though that doesn't
     451    # work correctly anymore because connect is asynchronous and so join on
     452    # startup races with connect.  Regardless, just fail silently if the line
     453    # already exists.
     454    return if grep { $_ eq $line } @lines;
     455
     456    open (my $subsfile, ">>:encoding(UTF-8)", make_autoconnect_filename($filename))
     457        or die "Cannot open $filename for writing: $!\n";
     458    local $, = "";
     459    local $/ = "";
     460    print $subsfile "$line\n";
     461    close($subsfile);
     462}
     463
     464sub remove_autoconnect_channel {
     465    my $conn = shift;
     466    my $channel = shift;
     467    my $alias = $conn->alias;
     468    my $filename = make_autoconnect_filename(shift);
     469
     470    BarnOwl::Internal::file_deleteline($filename, "$alias $channel", 1);
     471}
     472
     473sub cmd_loadchannels {
     474    my $cmd = shift;
     475    my $alias;
     476    my $getopt = Getopt::Long::Parser->new;
     477
     478    local @ARGV = @_;
     479    $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
     480    $getopt->getoptions("alias=s" => \$alias);
     481
     482    my %channel_hash = get_autoconnect_channels(@ARGV);
     483
     484    my $aliases = (defined $alias) ? [$alias] : [keys %channel_hash];
     485
     486    foreach my $cur_alias (@$aliases) {
     487        # get_connection_by_alias might die, and we don't want to
     488        eval {
     489            my $conn = get_connection_by_alias($cur_alias, 1);
     490            my %existing_channels = map { $_ => 1 } @{$conn->autoconnect_channels}, @{$channel_hash{$cur_alias}};
     491            $conn->autoconnect_channels([keys %existing_channels]);
     492        };
     493        foreach my $channel (@{$channel_hash{$cur_alias}}) {
     494            if ($cur_alias eq "") {
     495                BarnOwl::command("irc-join", "-t", $channel);
     496            } else {
     497                BarnOwl::command("irc-join", "-t", "-a", $cur_alias, $channel);
     498            }
     499        }
     500    }
     501}
    358502
    359503sub cmd_connect {
     
    393537    }
    394538
     539    my %channel_hash = get_autoconnect_channels;
     540
    395541    my $conn = BarnOwl::Module::IRC::Connection->new($alias, $host, $port, {
    396         nick      => $nick,
    397         user      => $username,
    398         real      => $ircname,
    399         password  => $password,
    400         SSL       => $ssl,
    401         timeout   => sub {0}
     542        nick                 => $nick,
     543        user                 => $username,
     544        real                 => $ircname,
     545        password             => $password,
     546        SSL                  => $ssl,
     547        timeout              => sub {0},
     548        autoconnect_channels => $channel_hash{$alias}
    402549       });
    403550    $ircnets{$alias} = $conn;
     
    486633sub cmd_join {
    487634    my $cmd = shift;
    488     my $conn = shift;
    489     my $chan = shift or die("Usage: $cmd channel\n");
    490     $conn->conn->send_msg(join => $chan, @_);
     635    my $is_temporary;
     636
     637    my $getopt = Getopt::Long::Parser->new;
     638
     639    local @ARGV = @_;
     640    $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
     641    $getopt->getoptions("temporary" => \$is_temporary);
     642
     643    my $conn = shift @ARGV;
     644    my $chan = shift @ARGV or die("Usage: $cmd channel\n");
     645
     646    die "Channel name '$chan' contains a space.  As per RFC 2812, IRC channel names may not contain spaces.\n" unless index($chan, " ") == -1;
     647
     648    $conn->conn->send_msg(join => $chan, @ARGV);
     649
     650    # regardless of whether or not this is temporary, we want to persist it
     651    # across reconnects.
     652
     653    # check if the channel is already in the list
     654    if (!grep { $_ eq $chan } @{$conn->autoconnect_channels}) {
     655        push @{$conn->autoconnect_channels}, $chan;
     656    }
     657
     658    if (!$is_temporary) {
     659        # add the line to the subs file
     660        add_autoconnect_channel($conn, $chan);
     661    }
     662
    491663    return;
    492664}
     
    494666sub cmd_part {
    495667    my $cmd = shift;
    496     my $conn = shift;
    497     my $chan = shift;
     668    my $is_temporary;
     669
     670    my $getopt = Getopt::Long::Parser->new;
     671
     672    local @ARGV = @_;
     673    $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
     674    $getopt->getoptions("temporary" => \$is_temporary);
     675
     676    my $conn = shift @ARGV;
     677    my $chan = shift @ARGV or die("Usage: $cmd channel\n");
     678
    498679    $conn->conn->send_msg(part => $chan);
     680
     681    # regardless of whether or not this is temporary, we want to persist it
     682    # across reconnects
     683    my %existing_channels = map { $_ => 1 } @{$conn->autoconnect_channels};
     684    delete $existing_channels{$chan};
     685    $conn->autoconnect_channels([keys %existing_channels]);
     686
     687    if (!$is_temporary) {
     688        # remove the line from the subs file
     689        remove_autoconnect_channel($conn, $chan);
     690    }
     691
    499692    return;
    500693}
     
    596789        my $alias;
    597790        my $channel;
     791        my $is_temporary;
    598792        my $getopt = Getopt::Long::Parser->new;
    599793        my $m = BarnOwl::getcurmsg();
     
    601795        local @ARGV = @_;
    602796        $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
    603         $getopt->getoptions("alias=s" => \$alias);
     797        $getopt->getoptions("alias=s" => \$alias,
     798                            "temporary" => \$is_temporary);
    604799
    605800        if(defined($alias)) {
     
    640835            die("You must specify an IRC network using -a.\n");
    641836        }
     837        push @ARGV, "-t" if $is_temporary;
    642838        if($flags & CHANNEL_ARG) {
    643839            $sub->($cmd, $conn, $channel, @ARGV);
  • perl/modules/IRC/lib/BarnOwl/Module/IRC/Completion.pm

    rdace02a r76e80de  
    5757}
    5858
     59sub complete_irc_join_part {
     60    my $ctx = shift;
     61    return complete_flags($ctx,
     62        [qw(-t)],
     63        {
     64            "-a" => \&complete_networks,
     65        },
     66        \&complete_channels
     67       );
     68}
     69
    5970sub complete_irc_channel {
    6071    my $ctx = shift;
     
    95106BarnOwl::Completion::register_completer('irc-msg'        => \&complete_irc_dest);
    96107BarnOwl::Completion::register_completer('irc-mode'       => \&complete_irc_dest);
    97 BarnOwl::Completion::register_completer('irc-join'       => \&complete_irc_channel);
    98 BarnOwl::Completion::register_completer('irc-part'       => \&complete_irc_channel);
     108BarnOwl::Completion::register_completer('irc-join'       => \&complete_irc_join_part);
     109BarnOwl::Completion::register_completer('irc-part'       => \&complete_irc_join_part);
    99110BarnOwl::Completion::register_completer('irc-names'      => \&complete_irc_channel);
    100111BarnOwl::Completion::register_completer('irc-whois'      => \&complete_irc_nick);
  • perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm

    r13ee8f2 rbe43554  
    3939    my $self = bless({}, $class);
    4040    $self->conn($conn);
    41     $self->autoconnect_channels([]);
     41    # TODO(jgross): use // when we move to requiring perl 5.10
     42    $self->autoconnect_channels(defined $args->{autoconnect_channels} ? $args->{autoconnect_channels} : []);
    4243    $self->alias($alias);
    4344    $self->server($host);
     
    412413        $self->{reconnect_timer}->stop;
    413414    }
    414     $self->{reconnect_timer} = 
     415    $self->{reconnect_timer} =
    415416        BarnOwl::Timer->new( {
    416417            name  => 'IRC (' . $self->alias . ') reconnect_timer',
     
    445446            $self->conn->send_msg(join => $c);
    446447        }
    447         $self->autoconnect_channels([]);
    448448    }
    449449    $self->conn->enable_ping(60, sub {
     
    458458    my $backoff = $self->backoff;
    459459
    460     $self->autoconnect_channels([keys(%{$self->{channel_list}})]);
    461460    $self->conn->connect(@{$self->connect_args});
    462461}
  • perl/modules/Twitter/lib/BarnOwl/Module/Twitter.pm

    rb8a3e00 r140429f  
    137137        my $twitter_args = { username   => $cfg->{user},
    138138                             password   => $cfg->{password},
    139                              source     => 'barnowl',
     139                             source     => 'barnowl',
     140                             ssl        => 1,
     141                             legacy_lists_api => 0,
    140142                         };
    141143        if (defined $cfg->{service}) {
     
    274276);
    275277
     278BarnOwl::new_command( 'twitter-favorite' => sub { cmd_twitter_favorite(@_) },
     279    {
     280    summary     => 'Favorite the current Twitter message',
     281    usage       => 'twitter-favorite [ACCOUNT]',
     282    description => <<END_DESCRIPTION
     283Favorite the current Twitter message using ACCOUNT (defaults to the
     284account that received the tweet).
     285END_DESCRIPTION
     286    }
     287);
     288
    276289BarnOwl::new_command( 'twitter-follow' => sub { cmd_twitter_follow(@_); },
    277290    {
     
    355368    $account = $m->account unless defined($account);
    356369    find_account($account)->twitter_retweet($m);
     370    return;
     371}
     372
     373sub cmd_twitter_favorite {
     374    my $cmd = shift;
     375    my $account = shift;
     376    my $m = BarnOwl::getcurmsg();
     377    if(!$m || $m->type ne 'Twitter') {
     378        die("$cmd must be used with a Twitter message selected.\n");
     379    }
     380
     381    $account = $m->account unless defined($account);
     382    find_account($account)->twitter_favorite($m);
    357383    return;
    358384}
  • perl/modules/Twitter/lib/BarnOwl/Module/Twitter/Handle.pm

    r4ebbfbc r140429f  
    371371        $self->twitter_direct($1, $2);
    372372    } elsif(defined $self->{twitter}) {
    373         if(length($msg) > 140) {
    374             die("Twitter: Message over 140 characters long.\n");
    375         }
    376373        $self->twitter_command('update', {
    377374            status => $msg,
     
    432429}
    433430
     431sub twitter_favorite {
     432    my $self = shift;
     433    my $msg = shift;
     434
     435    if($msg->service ne $self->{cfg}->{service}) {
     436        die("Cannot favorite a message from a different service.\n");
     437    }
     438    $self->twitter_command(create_favorite => $msg->{status_id});
     439}
     440
     441
    434442sub twitter_follow {
    435443    my $self = shift;
Note: See TracChangeset for help on using the changeset viewer.