Changeset b9766ea for perl/modules
- Timestamp:
- Dec 19, 2014, 1:49:13 AM (8 years ago)
- 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. - Location:
- perl/modules
- Files:
-
- 1 added
- 3 deleted
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
perl/modules/Jabber/lib/BarnOwl/Module/Jabber.pm
r41064be rb9766ea 171 171 our $showOffline = 0; 172 172 173 sub 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 173 187 sub blist_listBuddy { 174 188 my $roster = shift; … … 303 317 summary => "Show your Jabber roster.", 304 318 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" 305 326 } 306 327 ); … … 859 880 } 860 881 882 sub 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 861 908 862 909 sub jroster_sub { … … 1491 1538 } 1492 1539 1540 sub 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 1493 1551 BarnOwl::Completion::register_completer(jwrite => sub { BarnOwl::Module::Jabber::complete_jwrite(@_) }); 1494 1552 BarnOwl::Completion::register_completer(jabberlogout => sub { BarnOwl::Module::Jabber::complete_jabberlogout(@_) }); 1553 BarnOwl::Completion::register_completer(jabber_get_buddy_status => sub { BarnOwl::Module::Jabber::complete_jabber_get_buddy_status(@_) }); 1495 1554 1496 1555 1; -
perl/modules/Facebook/README
rf4037cf r441fd42 14 14 15 15 This token will persist across BarnOwls until you change your 16 Facebook password or you revoke permissions for Barn owl at:16 Facebook password or you revoke permissions for BarnOwl at: 17 17 http://www.facebook.com/settings/?tab=applications&app_id=235537266461636 18 18 19 (3) Start receiving wall updates in Barn owl!19 (3) Start receiving wall updates in BarnOwl! 20 20 You can post updates with the ":facebook" command. 21 21 -
perl/modules/IRC/lib/BarnOwl/Module/IRC.pm
r4f7b1f4 r926c721 21 21 22 22 use AnyEvent::IRC; 23 use Encode; 24 use File::Spec; 23 25 use Getopt::Long; 24 use Encode;25 26 use Text::Wrap; 26 27 27 28 our $VERSION = 0.02; 29 30 our $IRC_SUBS_FILENAME = "ircchannels"; 28 31 29 32 our $irc; … … 169 172 summary => 'Connect to an IRC server', 170 173 usage => 171 'irc-connect [-a ALIAS 174 'irc-connect [-a ALIAS] [-s] [-p PASSWORD] [-n NICK] SERVER [port]', 172 175 description => <<END_DESCR 173 176 Connect to an IRC server. Supported options are: … … 230 233 { 231 234 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 238 Join an IRC channel. If the -t option is present the subscription will only be 239 temporary, i.e., it will not be written to the subscription file and will 240 therefore not be present the next time BarnOwl is started, and will disappear 241 if the connection is lost. 236 242 END_DESCR 237 243 } … … 242 248 { 243 249 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 253 Part from an IRC channel. If the -t option is present the unsubscription will 254 only be temporary, i.e., it will not be updated in the subscription file and 255 will therefore not be in effect the next time BarnOwl is started, or if the 256 connection is lost. 248 257 END_DESCR 249 258 } … … 342 351 This can be used to perform some operation not yet supported by 343 352 BarnOwl, or to define new IRC commands. 353 END_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 364 Load persistent channels from a file. The file defaults to 365 \$HOME/.owl/$IRC_SUBS_FILENAME. If the ALIAS is present, only channels 366 on the given alias are loaded. The ALIAS is case-sensitive. 367 368 Each line of the file should describe a single channel, in the format 369 '\$alias \$channel' (without quotes). 344 370 END_DESCR 345 371 } … … 356 382 ######################## Owl command handlers ################################## 357 383 ################################################################################ 384 385 sub 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 397 sub _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 416 sub 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 435 sub 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 464 sub 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 473 sub 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 } 358 502 359 503 sub cmd_connect { … … 393 537 } 394 538 539 my %channel_hash = get_autoconnect_channels; 540 395 541 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} 402 549 }); 403 550 $ircnets{$alias} = $conn; … … 486 633 sub cmd_join { 487 634 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 491 663 return; 492 664 } … … 494 666 sub cmd_part { 495 667 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 498 679 $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 499 692 return; 500 693 } … … 596 789 my $alias; 597 790 my $channel; 791 my $is_temporary; 598 792 my $getopt = Getopt::Long::Parser->new; 599 793 my $m = BarnOwl::getcurmsg(); … … 601 795 local @ARGV = @_; 602 796 $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); 604 799 605 800 if(defined($alias)) { … … 640 835 die("You must specify an IRC network using -a.\n"); 641 836 } 837 push @ARGV, "-t" if $is_temporary; 642 838 if($flags & CHANNEL_ARG) { 643 839 $sub->($cmd, $conn, $channel, @ARGV); -
perl/modules/IRC/lib/BarnOwl/Module/IRC/Completion.pm
rdace02a r76e80de 57 57 } 58 58 59 sub 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 59 70 sub complete_irc_channel { 60 71 my $ctx = shift; … … 95 106 BarnOwl::Completion::register_completer('irc-msg' => \&complete_irc_dest); 96 107 BarnOwl::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);108 BarnOwl::Completion::register_completer('irc-join' => \&complete_irc_join_part); 109 BarnOwl::Completion::register_completer('irc-part' => \&complete_irc_join_part); 99 110 BarnOwl::Completion::register_completer('irc-names' => \&complete_irc_channel); 100 111 BarnOwl::Completion::register_completer('irc-whois' => \&complete_irc_nick); -
perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm
r13ee8f2 rbe43554 39 39 my $self = bless({}, $class); 40 40 $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} : []); 42 43 $self->alias($alias); 43 44 $self->server($host); … … 412 413 $self->{reconnect_timer}->stop; 413 414 } 414 $self->{reconnect_timer} = 415 $self->{reconnect_timer} = 415 416 BarnOwl::Timer->new( { 416 417 name => 'IRC (' . $self->alias . ') reconnect_timer', … … 445 446 $self->conn->send_msg(join => $c); 446 447 } 447 $self->autoconnect_channels([]);448 448 } 449 449 $self->conn->enable_ping(60, sub { … … 458 458 my $backoff = $self->backoff; 459 459 460 $self->autoconnect_channels([keys(%{$self->{channel_list}})]);461 460 $self->conn->connect(@{$self->connect_args}); 462 461 } -
perl/modules/Twitter/lib/BarnOwl/Module/Twitter.pm
rb8a3e00 r140429f 137 137 my $twitter_args = { username => $cfg->{user}, 138 138 password => $cfg->{password}, 139 source => 'barnowl', 139 source => 'barnowl', 140 ssl => 1, 141 legacy_lists_api => 0, 140 142 }; 141 143 if (defined $cfg->{service}) { … … 274 276 ); 275 277 278 BarnOwl::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 283 Favorite the current Twitter message using ACCOUNT (defaults to the 284 account that received the tweet). 285 END_DESCRIPTION 286 } 287 ); 288 276 289 BarnOwl::new_command( 'twitter-follow' => sub { cmd_twitter_follow(@_); }, 277 290 { … … 355 368 $account = $m->account unless defined($account); 356 369 find_account($account)->twitter_retweet($m); 370 return; 371 } 372 373 sub 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); 357 383 return; 358 384 } -
perl/modules/Twitter/lib/BarnOwl/Module/Twitter/Handle.pm
r4ebbfbc r140429f 371 371 $self->twitter_direct($1, $2); 372 372 } elsif(defined $self->{twitter}) { 373 if(length($msg) > 140) {374 die("Twitter: Message over 140 characters long.\n");375 }376 373 $self->twitter_command('update', { 377 374 status => $msg, … … 432 429 } 433 430 431 sub 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 434 442 sub twitter_follow { 435 443 my $self = shift;
Note: See TracChangeset
for help on using the changeset viewer.