[7a1c90d] | 1 | use warnings; |
---|
| 2 | use strict; |
---|
| 3 | |
---|
| 4 | =head1 NAME |
---|
| 5 | |
---|
| 6 | BarnOwl::Module::AIM |
---|
| 7 | |
---|
| 8 | =head1 DESCRIPTION |
---|
| 9 | |
---|
| 10 | BarnOwl module implementing AIM support via Net::OSCAR |
---|
| 11 | |
---|
| 12 | =cut |
---|
| 13 | |
---|
| 14 | package BarnOwl::Module::AIM; |
---|
| 15 | |
---|
| 16 | use Net::OSCAR; |
---|
| 17 | |
---|
[403198c] | 18 | our @oscars; |
---|
| 19 | |
---|
| 20 | sub on_im_in { |
---|
| 21 | my ($oscar, $sender, $message, $is_away) = @_; |
---|
| 22 | my $msg = BarnOwl::Message->new( |
---|
| 23 | type => 'AIM', |
---|
[7d63a6c] | 24 | direction => 'in', |
---|
[403198c] | 25 | sender => $sender, |
---|
[7d63a6c] | 26 | origbody => $message, |
---|
[403198c] | 27 | away => $is_away, |
---|
[7d63a6c] | 28 | body => zformat($message, $is_away), |
---|
| 29 | recipient => get_screenname($oscar), |
---|
| 30 | replycmd => |
---|
| 31 | "aimwrite -a '" . get_screenname($oscar) . "' $sender", |
---|
| 32 | replysendercmd => |
---|
| 33 | "aimwrite -a '" . get_screenname($oscar) . "' $sender", |
---|
[403198c] | 34 | ); |
---|
| 35 | BarnOwl::queue_message($msg); |
---|
| 36 | } |
---|
| 37 | |
---|
[7a1c90d] | 38 | sub cmd_aimlogin { |
---|
[403198c] | 39 | =comment |
---|
[7a1c90d] | 40 | my ($cmd, $user, $pass) = @_; |
---|
[403198c] | 41 | if (!defined $user) { |
---|
[7a1c90d] | 42 | BarnOwl::start_question('Username: ', sub { |
---|
| 43 | cmd_aimlogin($cmd, @_); |
---|
| 44 | }); |
---|
[403198c] | 45 | } elsif (!defined $pass) { |
---|
[7a1c90d] | 46 | BarnOwl::start_password('Password: ', sub { |
---|
| 47 | cmd_aimlogin($cmd, $user, @_); |
---|
| 48 | }); |
---|
| 49 | } else { |
---|
[403198c] | 50 | =cut |
---|
| 51 | { |
---|
[5fcf137] | 52 | my $oscar = Net::OSCAR->new(); |
---|
[403198c] | 53 | my ($user, $pass) = ('...', '...'); |
---|
[7a1c90d] | 54 | $oscar->set_callback_im_in(\&on_im_in); |
---|
[7d63a6c] | 55 | $oscar->set_callback_signon_done(sub ($) { |
---|
| 56 | BarnOwl::admin_message('AIM', |
---|
| 57 | 'Logged in to AIM as ' . shift->screenname); |
---|
| 58 | }); |
---|
[403198c] | 59 | $oscar->signon( |
---|
| 60 | screenname => $user, |
---|
| 61 | password => $pass |
---|
| 62 | ); |
---|
| 63 | push @oscars, $oscar; |
---|
[7a1c90d] | 64 | } |
---|
| 65 | } |
---|
[7d63a6c] | 66 | |
---|
| 67 | sub cmd_aimwrite { |
---|
| 68 | my ($cmd, $recipient) = @_; |
---|
| 69 | BarnOwl::start_edit_win(join(' ', @_), sub { |
---|
| 70 | my ($body) = @_; |
---|
| 71 | my $oscar = get_oscar(); |
---|
| 72 | my $sender = get_screenname($oscar); |
---|
| 73 | $oscar->send_im($recipient, $body); |
---|
| 74 | BarnOwl::queue_message(BarnOwl::Message->new( |
---|
| 75 | type => 'AIM', |
---|
| 76 | direction => 'in', |
---|
| 77 | sender => $sender, |
---|
| 78 | origbody => $body, |
---|
| 79 | away => 0, |
---|
| 80 | body => zformat($body, 0), |
---|
| 81 | recipient => $recipient, |
---|
| 82 | replycmd => |
---|
| 83 | "aimwrite -a '" . get_screenname($oscar) . "' $sender", |
---|
| 84 | replysendercmd => |
---|
| 85 | "aimwrite -a '" . get_screenname($oscar) . "' $sender", |
---|
| 86 | )); |
---|
| 87 | }); |
---|
| 88 | } |
---|
| 89 | |
---|
[403198c] | 90 | BarnOwl::new_command(aimlogin => \&cmd_aimlogin, {}); |
---|
[7d63a6c] | 91 | BarnOwl::new_command(aimwrite => \&cmd_aimwrite, {}); |
---|
[7a1c90d] | 92 | |
---|
[7d63a6c] | 93 | sub main_loop() { |
---|
[403198c] | 94 | for my $oscar (@oscars) { |
---|
| 95 | $oscar->do_one_loop(); |
---|
| 96 | } |
---|
[7a1c90d] | 97 | } |
---|
[403198c] | 98 | $BarnOwl::Hooks::mainLoop->add(\&main_loop); |
---|
[5fcf137] | 99 | |
---|
[7d63a6c] | 100 | ### helpers ### |
---|
| 101 | |
---|
| 102 | sub zformat($$) { |
---|
| 103 | # TODO subclass HTML::Parser |
---|
| 104 | my ($message, $is_away) = @_; |
---|
| 105 | if ($is_away) { |
---|
| 106 | return BarnOwl::boldify('[away]') . " $message"; |
---|
| 107 | } else { |
---|
| 108 | return $message; |
---|
| 109 | } |
---|
| 110 | } |
---|
| 111 | |
---|
| 112 | sub get_oscar() { |
---|
| 113 | if (scalar @oscars == 0) { |
---|
| 114 | die "You are not logged in to AIM." |
---|
| 115 | } elsif (scalar @oscars == 1) { |
---|
| 116 | return $oscars[0]; |
---|
| 117 | } else { |
---|
| 118 | my $m = BarnOwl::getcurmsg(); |
---|
| 119 | if ($m && $m->type eq 'AIM') { |
---|
| 120 | for my $oscar (@oscars) { |
---|
| 121 | return $oscar if ($oscar->screenname eq $m->recipient); |
---|
| 122 | } |
---|
| 123 | } |
---|
| 124 | } |
---|
| 125 | die('You must specify an account with -a'); |
---|
| 126 | } |
---|
| 127 | |
---|
| 128 | sub get_screenname($) { |
---|
| 129 | # TODO qualify realm |
---|
| 130 | return shift->screenname; |
---|
| 131 | } |
---|
| 132 | |
---|
[5fcf137] | 133 | 1; |
---|
[403198c] | 134 | |
---|
| 135 | # vim: set sw=4 et cin: |
---|