Changeset be43554 for perl/modules/IRC


Ignore:
Timestamp:
Aug 8, 2013, 3:51:55 PM (11 years ago)
Author:
Jason Gross <jgross@mit.edu>
Branches:
master, release-1.10
Children:
76e80de
Parents:
ae2b830
git-author:
Jason Gross <jgross@mit.edu> (01/05/13 14:41:45)
git-committer:
Jason Gross <jgross@mit.edu> (08/08/13 15:51:55)
Message:
Add a ~/.owl/ircchannels file, persist channels

All irc channel subscriptions persist across reconnects.

irc-{part,join} now have a -t flag, which makes the channels not persist
across BarnOwl sessions.

irc-loadchannels loads persistent channels.  It does not unload existing
channels.
Location:
perl/modules/IRC/lib/BarnOwl/Module
Files:
2 edited

Legend:

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

    rc84c365 rbe43554  
    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;
     
    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($channel, " ") == -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/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}
Note: See TracChangeset for help on using the changeset viewer.