Changeset 85fa6e4 for perl


Ignore:
Timestamp:
Dec 30, 2009, 1:59:57 PM (14 years ago)
Author:
Nelson Elhage <nelhage@mit.edu>
Branches:
master, release-1.10, release-1.6, release-1.7, release-1.8, release-1.9
Children:
814aca1
Parents:
416241f (diff), 460fbe8 (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 branch 'release-1.5'
Location:
perl
Files:
6 edited

Legend:

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

    r0cfa6ee rb84feab  
    12291229    $props{xml}        = $j->GetXML();
    12301230
    1231     if ( $jtype eq 'chat' ) {
     1231    if ( $jtype eq 'groupchat' ) {
     1232        my $nick = $props{nick} = $from->GetResource();
     1233        my $room = $props{room} = $from->GetJID('base');
     1234        $completion_jids{$room} = 1;
     1235
     1236        $props{sender} = $nick || $room;
     1237        $props{recipient} = $room;
     1238
     1239        if ( $props{subject} && !$props{body} ) {
     1240            $props{body} =
     1241              '[' . $nick . " has set the topic to: " . $props{subject} . "]";
     1242        }
     1243    }
     1244    elsif ( $jtype eq 'headline' ) {
     1245        ;
     1246    }
     1247    elsif ( $jtype eq 'error' ) {
     1248        $props{body}     = "Error "
     1249          . $props{error_code}
     1250          . " sending to "
     1251          . $props{from} . "\n"
     1252          . $props{error};
     1253    }
     1254    else { # chat, or normal (default)
    12321255        $props{private} = 1;
    12331256
     
    12561279            $completion_jids{ $props{recipient} } = 1;
    12571280        }
    1258     }
    1259     elsif ( $jtype eq 'groupchat' ) {
    1260         my $nick = $props{nick} = $from->GetResource();
    1261         my $room = $props{room} = $from->GetJID('base');
    1262         $completion_jids{$room} = 1;
    1263 
    1264         $props{sender} = $nick || $room;
    1265         $props{recipient} = $room;
    1266 
    1267         if ( $props{subject} && !$props{body} ) {
    1268             $props{body} =
    1269               '[' . $nick . " has set the topic to: " . $props{subject} . "]";
    1270         }
    1271     }
    1272     elsif ( $jtype eq 'normal' ) {
    1273         $props{private} = 1;
    1274     }
    1275     elsif ( $jtype eq 'headline' ) {
    1276     }
    1277     elsif ( $jtype eq 'error' ) {
    1278         $props{body}     = "Error "
    1279           . $props{error_code}
    1280           . " sending to "
    1281           . $props{from} . "\n"
    1282           . $props{error};
    12831281    }
    12841282
  • perl/lib/BarnOwl/Complete/Client.pm

    rdab89e28 rdc8f6e0  
    66package BarnOwl::Complete::Client;
    77
    8 use BarnOwl::Completion::Util qw(complete_flags);
     8use BarnOwl::Completion::Util qw(complete_flags complete_file);
    99use BarnOwl::Complete::Filter qw(complete_filter_name complete_filter_expr);
    1010
     
    167167}
    168168
     169sub complete_bindkey {
     170    my $ctx = shift;
     171    # bindkey KEYMAP KEYSEQ command COMMAND
     172    #   0      1       2      3        4
     173    if ($ctx->word == 1) {
     174        return complete_keymap();
     175    } elsif ($ctx->word == 2) {
     176        return;
     177    } elsif ($ctx->word == 3) {
     178        return ('command');
     179    } else {
     180        my $new_ctx = $ctx->shift_words(4);
     181        return BarnOwl::Completion::get_completions($new_ctx);
     182    }
     183}
     184
     185sub complete_print {
     186    my $ctx = shift;
     187    return unless $ctx->word == 1;
     188    return complete_variable();
     189}
     190
     191sub complete_one_file_arg {
     192    my $ctx = shift;
     193    return unless $ctx->word == 1;
     194    return complete_file($ctx->words->[1]);
     195}
     196
    169197BarnOwl::Completion::register_completer(help    => \&complete_help);
    170198BarnOwl::Completion::register_completer(filter  => \&complete_filter);
     
    178206BarnOwl::Completion::register_completer(unset   => \&complete_set);
    179207BarnOwl::Completion::register_completer(startup => \&complete_startup);
     208BarnOwl::Completion::register_completer(bindkey => \&complete_bindkey);
     209BarnOwl::Completion::register_completer(print   => \&complete_print);
     210
     211BarnOwl::Completion::register_completer(source      => \&complete_one_file_arg);
     212BarnOwl::Completion::register_completer('load-subs' => \&complete_one_file_arg);
     213BarnOwl::Completion::register_completer(loadsubs    => \&complete_one_file_arg);
     214BarnOwl::Completion::register_completer(loadloginsubs    => \&complete_one_file_arg);
     215BarnOwl::Completion::register_completer(dump        => \&complete_one_file_arg);
    180216
    1812171;
  • perl/lib/BarnOwl/Completion.pm

    r48d130b r880311d  
    3131    my @words = get_completions($ctx);
    3232    return unless @words;
    33     my $prefix = common_prefix(@words);
     33    my $prefix = common_prefix(map {completion_value($_)} @words);
    3434
    3535    if($prefix) {
    36         insert_completion($ctx, $prefix, scalar @words == 1);
     36        insert_completion($ctx, $prefix,
     37                          scalar @words == 1 && completion_done($words[0]));
    3738    }
    3839
     
    4445}
    4546
     47=head1 COMPLETIONS
     48
     49A COMPLETION is either a simple string, or a reference to an array
     50containing two or more values.
     51
     52In the former case, the string use used for both the text to display,
     53as well as the result of the completion, and is assumed to be a full
     54completion.
     55
     56An arrayref completion consists of
     57
     58    [$display_text, $replacement_value[, $completion_done] ].
     59
     60$display_text will be printed in the case of ambiguous completions,
     61$replacement_value will be used to substitute the value in. If there
     62is only a single completion for a given word, a space will be appended
     63after the completion iff $completion_done is true (or missing).
     64
     65=cut
     66
     67sub completion_text {
     68    my $c = shift;
     69    return $c unless ref($c) eq 'ARRAY';
     70    return $c->[0];
     71}
     72
     73sub completion_value {
     74    my $c = shift;
     75    return $c unless ref($c) eq 'ARRAY';
     76    return $c->[1];
     77}
     78
     79sub completion_done {
     80    my $c = shift;
     81    return 1 if ref($c) ne 'ARRAY' or @$c < 3;
     82    return $c->[2];
     83}
     84
    4685sub insert_completion {
    4786    my $ctx = shift;
    48     my $completion = BarnOwl::quote(shift);
    49     my $unique = shift;
     87    my $completion = BarnOwl::quote(completion_value(shift));
     88    my $done = shift;
    5089
    51     if($unique) {
     90    if($done) {
    5291        $completion .= " ";
    5392    }
     
    66105sub show_completions {
    67106    my @words = @_;
    68     my $all = BarnOwl::quote(@words);
     107    my $all = BarnOwl::quote(map {completion_text($_)} @words);
    69108    my $width = BarnOwl::getnumcols();
    70109    if (length($all) > $width-1) {
     
    98137        my $word = $ctx->words->[$ctx->word];
    99138        if(exists($completers{$cmd})) {
    100             return grep {$_ =~ m{^\Q$word\E}} $completers{$cmd}->($ctx);
     139            return grep {completion_value($_) =~ m{^\Q$word\E}} $completers{$cmd}->($ctx);
    101140        }
    102141        return;
  • perl/lib/BarnOwl/Completion/Util.pm

    r69c27e6 re6cec01  
    55
    66use base qw(Exporter);
    7 our @EXPORT_OK = qw(complete_flags);
     7our @EXPORT_OK = qw(complete_flags complete_file);
    88
    99use Getopt::Long;
     10use Cwd qw(abs_path);
     11use File::Basename qw(dirname basename);
     12
    1013
    1114sub complete_flags {
     
    6770    }
    6871}
     72
     73sub expand_tilde {
     74    # Taken from The Perl Cookbook, recipe 7.3
     75    my $path = shift;
     76    $path =~ s{ ^ ~ ( [^/]* ) }
     77                { $1
     78                  ? (getpwnam($1))[7]
     79                  : ( $ENV{HOME} || $ENV{LOGDIR}
     80                      || (getpwuid($>))[7]
     81                     )
     82              }ex;
     83    return $path;
     84}
     85
     86sub splitfile {
     87    my $path = shift;
     88    if ($path =~ m{^(.*/)([^/]*)$}) {
     89        return ($1, $2);
     90    } else {
     91        return ('', $path);
     92    }
     93}
     94
     95sub complete_file {
     96    my $string = shift;
     97
     98    return ['~/', '~/', 0] if $string eq '~';
     99
     100    my $path = abs_path(expand_tilde($string));
     101    my $dir;
     102    if ($string =~ m{/$} || $string eq '' || basename($string) eq '.') {
     103        $dir = $path;
     104    } else {
     105        $dir = dirname($path);
     106    }
     107    return unless -d $dir;
     108
     109    my ($pfx, $base) = splitfile($string);
     110   
     111    opendir(my $dh, $dir) or return;
     112    my @dirs = readdir($dh);
     113    close($dh);
     114
     115    my @out;
     116    for my $d (@dirs) {
     117        # Skip dotfiles unless explicitly requested
     118        if($d =~ m{^[.]} && $base !~ m{^[.]}) {
     119            next;
     120        }
     121       
     122        my ($text, $value, $done) = ($d, "${pfx}${d}", 1);
     123
     124        if (-d "$dir/$d") {
     125            $text .= "/";
     126            $value .= "/";
     127            $done = 0;
     128        }
     129        push @out, [$text, $value, $done];
     130    }
     131    return @out;
     132}
  • perl/modules/IRC/lib/BarnOwl/Module/IRC.pm

    r618a980 r416241f  
    137137}
    138138
    139 use constant OPTIONAL_CHANNEL => 1;
    140 use constant REQUIRE_CHANNEL => 2;
     139=head2 mk_irc_command SUB FLAGS
     140
     141Return a subroutine that can be bound as a an IRC command. The
     142subroutine will be called with arguments (COMMAND-NAME,
     143IRC-CONNECTION, [CHANNEL], ARGV...).
     144
     145C<IRC-CONNECTION> and C<CHANNEL> will be inferred from arguments to
     146the command and the current message if appropriate.
     147
     148The bitwise C<or> of zero or more C<FLAGS> can be passed in as a
     149second argument to alter the behavior of the returned commands:
     150
     151=over 4
     152
     153=item C<CHANNEL_ARG>
     154
     155This command accepts the name of a channel. Pass in the C<CHANNEL>
     156argument listed above, and die if no channel argument can be found.
     157
     158=item C<CHANNEL_OPTIONAL>
     159
     160Pass the channel argument, but don't die if not present. Only relevant
     161with C<CHANNEL_ARG>.
     162
     163=item C<ALLOW_DISCONNECTED>
     164
     165C<IRC-CONNECTION> may be a disconnected connection object that is
     166currently pending a reconnect.
     167
     168=back
     169
     170=cut
     171
     172use constant CHANNEL_ARG        => 1;
     173use constant CHANNEL_OPTIONAL   => 2;
     174
     175use constant ALLOW_DISCONNECTED => 4;
    141176
    142177sub register_commands {
     
    167202
    168203    BarnOwl::new_command(
    169         'irc-disconnect' => \&cmd_disconnect,
     204        'irc-disconnect' => mk_irc_command( \&cmd_disconnect, ALLOW_DISCONNECTED ),
    170205        {
    171206            summary => 'Disconnect from an IRC server',
     
    192227
    193228    BarnOwl::new_command(
    194         'irc-mode' => mk_irc_command( \&cmd_mode, OPTIONAL_CHANNEL ),
     229        'irc-mode' => mk_irc_command( \&cmd_mode, CHANNEL_OPTIONAL|CHANNEL_ARG ),
    195230        {
    196231            summary => 'Change an IRC channel or user mode',
     
    216251
    217252    BarnOwl::new_command(
    218         'irc-part' => mk_irc_command( \&cmd_part, REQUIRE_CHANNEL ),
     253        'irc-part' => mk_irc_command( \&cmd_part, CHANNEL_ARG ),
    219254        {
    220255            summary => 'Leave an IRC channel',
     
    241276
    242277    BarnOwl::new_command(
    243         'irc-names' => mk_irc_command( \&cmd_names, REQUIRE_CHANNEL ),
     278        'irc-names' => mk_irc_command( \&cmd_names, CHANNEL_ARG ),
    244279        {
    245280            summary => 'View the list of users in a channel',
     
    294329
    295330    BarnOwl::new_command(
    296         'irc-topic' => mk_irc_command( \&cmd_topic, REQUIRE_CHANNEL ),
     331        'irc-topic' => mk_irc_command( \&cmd_topic, CHANNEL_ARG ),
    297332        {
    298333            summary => 'View or change the topic of an IRC channel',
     
    391426
    392427sub cmd_disconnect {
    393     # Such a hack
    394     local *get_connection_by_alias = sub {
    395         my $key = shift;
    396         return $ircnets{$key} if exists $ircnets{$key};
    397         return $reconnect{$key}{conn} if exists $reconnect{$key};
    398         die("No such ircnet: $key\n");
    399     };
    400 
    401     mk_irc_command(
    402         sub {
    403             my $cmd = shift;
    404             my $conn = shift;
    405             if ($conn->conn->connected) {
    406                 $conn->conn->disconnect;
    407             } elsif ($reconnect{$conn->alias}) {
    408                 BarnOwl::admin_message('IRC',
    409                                        "[" . $conn->alias . "] Reconnect cancelled");
    410                 delete $reconnect{$conn->alias};
    411             }
    412         }
    413     )->(@_);
     428    my $cmd = shift;
     429    my $conn = shift;
     430    if ($conn->conn->connected) {
     431        $conn->conn->disconnect;
     432    } elsif ($reconnect{$conn->alias}) {
     433        BarnOwl::admin_message('IRC',
     434                               "[" . $conn->alias . "] Reconnect cancelled");
     435        $conn->cancel_reconnect;
     436    }
    414437}
    415438
     
    564587sub mk_irc_command {
    565588    my $sub = shift;
    566     my $use_channel = shift || 0;
     589    my $flags = shift || 0;
    567590    return sub {
    568591        my $cmd = shift;
     
    578601
    579602        if(defined($alias)) {
    580             $conn = get_connection_by_alias($alias);
    581         }
    582         if($use_channel) {
     603            $conn = get_connection_by_alias($alias,
     604                                            $flags & ALLOW_DISCONNECTED);
     605        }
     606        if($flags & CHANNEL_ARG) {
    583607            $channel = $ARGV[0];
    584608            if(defined($channel) && $channel =~ /^#/) {
     
    594618        }
    595619
    596         if(!$channel && $use_channel == REQUIRE_CHANNEL) {
     620        if(!$channel &&
     621           ($flags & CHANNEL_ARG) &&
     622           !($flags & CHANNEL_OPTIONAL)) {
    597623            die("Usage: $cmd <channel>\n");
    598624        }
    599625        if(!$conn) {
    600626            if($m && $m->type eq 'IRC') {
    601                 $conn = get_connection_by_alias($m->network);
     627                $conn = get_connection_by_alias($m->network,
     628                                               $flags & ALLOW_DISCONNECTED);
    602629            }
    603630        }
     
    608635            die("You must specify an IRC network using -a.\n");
    609636        }
    610         if($use_channel) {
     637        if($flags & CHANNEL_ARG) {
    611638            $sub->($cmd, $conn, $channel, @ARGV);
    612639        } else {
     
    618645sub get_connection_by_alias {
    619646    my $key = shift;
    620     die("No such ircnet: $key\n") unless exists $ircnets{$key};
    621     return $ircnets{$key};
     647    my $allow_disconnected = shift;
     648
     649    return $ircnets{$key} if exists $ircnets{$key};
     650    return $reconnect{$key} if $allow_disconnected && exists $reconnect{$key};
     651    die("No such ircnet: $key\n")
    622652}
    623653
  • perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm

    r618a980 r416241f  
    2323
    2424use BarnOwl;
     25use Scalar::Util qw(weaken);
    2526
    2627BEGIN {
     
    315316    my $interval = shift || 5;
    316317    delete $BarnOwl::Module::IRC::ircnets{$self->alias};
    317     $BarnOwl::Module::IRC::reconnect{$self->alias} =
     318    $BarnOwl::Module::IRC::reconnect{$self->alias} = $self;
     319    my $weak = $self;
     320    weaken($weak);
     321    $self->{reconnect_timer} =
    318322        BarnOwl::Timer->new( {
    319323            after => $interval,
    320324            cb    => sub {
    321                 $self->reconnect( $interval );
     325                $weak->reconnect( $interval ) if $weak;
    322326            },
    323327        } );
    324     $BarnOwl::Module::IRC::reconnect{$self->alias}{conn} = $self;
     328}
     329
     330sub cancel_reconnect {
     331    my $self = shift;
     332    delete $BarnOwl::Module::IRC::reconnect{$self->alias};
     333    delete $self->{reconnect_timer};
    325334}
    326335
     
    329338    my $msg = shift;
    330339    BarnOwl::admin_message("IRC", $msg);
    331     delete $BarnOwl::Module::IRC::reconnect{$self->alias};
     340    $self->cancel_reconnect;
    332341    $BarnOwl::Module::IRC::ircnets{$self->alias} = $self;
    333342    my $fd = $self->getSocket()->fileno();
Note: See TracChangeset for help on using the changeset viewer.