| 1 | use warnings; |
|---|
| 2 | use strict; |
|---|
| 3 | |
|---|
| 4 | =head1 NAME |
|---|
| 5 | |
|---|
| 6 | BarnOwl::Module::Twitter |
|---|
| 7 | |
|---|
| 8 | =head1 DESCRIPTION |
|---|
| 9 | |
|---|
| 10 | Post outgoing zephyrs from -c $USER -i status -O TWITTER to Twitter |
|---|
| 11 | |
|---|
| 12 | =cut |
|---|
| 13 | |
|---|
| 14 | package BarnOwl::Module::Twitter; |
|---|
| 15 | |
|---|
| 16 | our $VERSION = 0.2; |
|---|
| 17 | |
|---|
| 18 | use Net::Twitter; |
|---|
| 19 | use JSON; |
|---|
| 20 | use List::Util qw(first); |
|---|
| 21 | |
|---|
| 22 | use BarnOwl; |
|---|
| 23 | use BarnOwl::Hooks; |
|---|
| 24 | use BarnOwl::Module::Twitter::Handle; |
|---|
| 25 | |
|---|
| 26 | our @twitter_handles = (); |
|---|
| 27 | our $default_handle = undef; |
|---|
| 28 | my $user = BarnOwl::zephyr_getsender(); |
|---|
| 29 | my ($class) = ($user =~ /(^[^@]+)/); |
|---|
| 30 | my $instance = "status"; |
|---|
| 31 | my $opcode = "twitter"; |
|---|
| 32 | my $use_reply_to = 0; |
|---|
| 33 | my $next_service_to_poll = 0; |
|---|
| 34 | |
|---|
| 35 | my $desc = <<'END_DESC'; |
|---|
| 36 | BarnOwl::Module::Twitter will watch for authentic zephyrs to |
|---|
| 37 | -c $twitter:class -i $twitter:instance -O $twitter:opcode |
|---|
| 38 | from your sender and mirror them to Twitter. |
|---|
| 39 | |
|---|
| 40 | A value of '*' in any of these fields acts a wildcard, accepting |
|---|
| 41 | messages with any value of that field. |
|---|
| 42 | END_DESC |
|---|
| 43 | BarnOwl::new_variable_string( |
|---|
| 44 | 'twitter:class', |
|---|
| 45 | { |
|---|
| 46 | default => $class, |
|---|
| 47 | summary => 'Class to watch for Twitter messages', |
|---|
| 48 | description => $desc |
|---|
| 49 | } |
|---|
| 50 | ); |
|---|
| 51 | BarnOwl::new_variable_string( |
|---|
| 52 | 'twitter:instance', |
|---|
| 53 | { |
|---|
| 54 | default => $instance, |
|---|
| 55 | summary => 'Instance on twitter:class to watch for Twitter messages.', |
|---|
| 56 | description => $desc |
|---|
| 57 | } |
|---|
| 58 | ); |
|---|
| 59 | BarnOwl::new_variable_string( |
|---|
| 60 | 'twitter:opcode', |
|---|
| 61 | { |
|---|
| 62 | default => $opcode, |
|---|
| 63 | summary => 'Opcode for zephyrs that will be sent as twitter updates', |
|---|
| 64 | description => $desc |
|---|
| 65 | } |
|---|
| 66 | ); |
|---|
| 67 | |
|---|
| 68 | BarnOwl::new_variable_bool( |
|---|
| 69 | 'twitter:poll', |
|---|
| 70 | { |
|---|
| 71 | default => 1, |
|---|
| 72 | summary => 'Poll Twitter for incoming messages', |
|---|
| 73 | description => "If set, will poll Twitter every minute for normal updates,\n" |
|---|
| 74 | . 'and every two minutes for direct message' |
|---|
| 75 | } |
|---|
| 76 | ); |
|---|
| 77 | |
|---|
| 78 | sub fail { |
|---|
| 79 | my $msg = shift; |
|---|
| 80 | undef @twitter_handles; |
|---|
| 81 | BarnOwl::admin_message('Twitter Error', $msg); |
|---|
| 82 | die("Twitter Error: $msg\n"); |
|---|
| 83 | } |
|---|
| 84 | |
|---|
| 85 | my $conffile = BarnOwl::get_config_dir() . "/twitter"; |
|---|
| 86 | open(my $fh, "<", "$conffile") || fail("Unable to read $conffile"); |
|---|
| 87 | my $raw_cfg = do {local $/; <$fh>}; |
|---|
| 88 | close($fh); |
|---|
| 89 | eval { |
|---|
| 90 | $raw_cfg = from_json($raw_cfg); |
|---|
| 91 | }; |
|---|
| 92 | if($@) { |
|---|
| 93 | fail("Unable to parse $conffile: $@"); |
|---|
| 94 | } |
|---|
| 95 | |
|---|
| 96 | $raw_cfg = [$raw_cfg] unless UNIVERSAL::isa $raw_cfg, "ARRAY"; |
|---|
| 97 | |
|---|
| 98 | for my $cfg (@$raw_cfg) { |
|---|
| 99 | my $twitter_args = { username => $cfg->{user} || $user, |
|---|
| 100 | password => $cfg->{password}, |
|---|
| 101 | source => 'barnowl', |
|---|
| 102 | }; |
|---|
| 103 | if (defined $cfg->{service}) { |
|---|
| 104 | my $service = $cfg->{service}; |
|---|
| 105 | $twitter_args->{apiurl} = $service; |
|---|
| 106 | my $apihost = $service; |
|---|
| 107 | $apihost =~ s/^\s*http:\/\///; |
|---|
| 108 | $apihost =~ s/\/.*$//; |
|---|
| 109 | $apihost .= ':80' unless $apihost =~ /:\d+$/; |
|---|
| 110 | $twitter_args->{apihost} = $cfg->{apihost} || $apihost; |
|---|
| 111 | my $apirealm = "Laconica API"; |
|---|
| 112 | $twitter_args->{apirealm} = $cfg->{apirealm} || $apirealm; |
|---|
| 113 | } else { |
|---|
| 114 | $cfg->{service} = 'http://twitter.com'; |
|---|
| 115 | } |
|---|
| 116 | |
|---|
| 117 | my $twitter_handle; |
|---|
| 118 | eval { |
|---|
| 119 | $twitter_handle = BarnOwl::Module::Twitter::Handle->new($cfg, %$twitter_args); |
|---|
| 120 | }; |
|---|
| 121 | if ($@) { |
|---|
| 122 | BarnOwl::error($@); |
|---|
| 123 | next; |
|---|
| 124 | } |
|---|
| 125 | push @twitter_handles, $twitter_handle; |
|---|
| 126 | } |
|---|
| 127 | |
|---|
| 128 | $default_handle = first {$_->{cfg}->{default_sender}} @twitter_handles; |
|---|
| 129 | if (!$default_handle && @twitter_handles) { |
|---|
| 130 | $default_handle = $twitter_handles[0]; |
|---|
| 131 | } |
|---|
| 132 | |
|---|
| 133 | sub match { |
|---|
| 134 | my $val = shift; |
|---|
| 135 | my $pat = shift; |
|---|
| 136 | return $pat eq "*" || ($val eq $pat); |
|---|
| 137 | } |
|---|
| 138 | |
|---|
| 139 | sub handle_message { |
|---|
| 140 | my $m = shift; |
|---|
| 141 | ($class, $instance, $opcode) = map{BarnOwl::getvar("twitter:$_")} qw(class instance opcode); |
|---|
| 142 | if($m->sender eq $user |
|---|
| 143 | && match($m->class, $class) |
|---|
| 144 | && match($m->instance, $instance) |
|---|
| 145 | && match($m->opcode, $opcode) |
|---|
| 146 | && $m->auth eq 'YES') { |
|---|
| 147 | for my $handle (@twitter_handles) { |
|---|
| 148 | $handle->twitter($m->body) if $handle->{cfg}->{publish_tweets}; |
|---|
| 149 | } |
|---|
| 150 | } |
|---|
| 151 | } |
|---|
| 152 | |
|---|
| 153 | sub poll_messages { |
|---|
| 154 | return unless @twitter_handles; |
|---|
| 155 | |
|---|
| 156 | my $handle = $twitter_handles[$next_service_to_poll]; |
|---|
| 157 | $next_service_to_poll = ($next_service_to_poll + 1) % scalar(@twitter_handles); |
|---|
| 158 | |
|---|
| 159 | $handle->poll_twitter() if $handle->{cfg}->{poll_for_tweets}; |
|---|
| 160 | $handle->poll_direct() if $handle->{cfg}->{poll_for_dms}; |
|---|
| 161 | } |
|---|
| 162 | |
|---|
| 163 | sub find_account { |
|---|
| 164 | my $name = shift; |
|---|
| 165 | my $handle = first {$_->{cfg}->{account_nickname} eq $name} @twitter_handles; |
|---|
| 166 | if ($handle) { |
|---|
| 167 | return $handle; |
|---|
| 168 | } else { |
|---|
| 169 | die("No such Twitter account: $name\n"); |
|---|
| 170 | } |
|---|
| 171 | } |
|---|
| 172 | |
|---|
| 173 | sub find_account_default { |
|---|
| 174 | my $name = shift; |
|---|
| 175 | if(defined($name)) { |
|---|
| 176 | return find_account($name); |
|---|
| 177 | } else { |
|---|
| 178 | return $default_handle; |
|---|
| 179 | } |
|---|
| 180 | } |
|---|
| 181 | |
|---|
| 182 | sub twitter { |
|---|
| 183 | my $account = shift; |
|---|
| 184 | |
|---|
| 185 | my $sent = 0; |
|---|
| 186 | if (defined $account) { |
|---|
| 187 | my $handle = find_account($account); |
|---|
| 188 | $handle->twitter(@_); |
|---|
| 189 | } |
|---|
| 190 | else { |
|---|
| 191 | # broadcast |
|---|
| 192 | for my $handle (@twitter_handles) { |
|---|
| 193 | $handle->twitter(@_) if $handle->{cfg}->{publish_tweets}; |
|---|
| 194 | } |
|---|
| 195 | } |
|---|
| 196 | } |
|---|
| 197 | |
|---|
| 198 | BarnOwl::new_command(twitter => \&cmd_twitter, { |
|---|
| 199 | summary => 'Update Twitter from BarnOwl', |
|---|
| 200 | usage => 'twitter [ACCOUNT] [MESSAGE]', |
|---|
| 201 | description => 'Update Twitter on ACCOUNT. If MESSAGE is provided, use it as your status.' |
|---|
| 202 | . "\nIf no ACCOUNT is provided, update all services which have publishing enabled." |
|---|
| 203 | . "\nOtherwise, prompt for a status message to use." |
|---|
| 204 | }); |
|---|
| 205 | |
|---|
| 206 | BarnOwl::new_command('twitter-direct' => \&cmd_twitter_direct, { |
|---|
| 207 | summary => 'Send a Twitter direct message', |
|---|
| 208 | usage => 'twitter-direct USER [ACCOUNT]', |
|---|
| 209 | description => 'Send a Twitter Direct Message to USER on ACCOUNT (defaults to default_sender,' |
|---|
| 210 | . "\nor first service if no default is provided)" |
|---|
| 211 | }); |
|---|
| 212 | |
|---|
| 213 | BarnOwl::new_command( 'twitter-atreply' => sub { cmd_twitter_atreply(@_); }, |
|---|
| 214 | { |
|---|
| 215 | summary => 'Send a Twitter @ message', |
|---|
| 216 | usage => 'twitter-atreply USER [ACCOUNT]', |
|---|
| 217 | description => 'Send a Twitter @reply Message to USER on ACCOUNT (defaults to default_sender,' |
|---|
| 218 | . "\nor first service if no default is provided)" |
|---|
| 219 | } |
|---|
| 220 | ); |
|---|
| 221 | |
|---|
| 222 | BarnOwl::new_command( 'twitter-follow' => sub { cmd_twitter_follow(@_); }, |
|---|
| 223 | { |
|---|
| 224 | summary => 'Follow a user on Twitter', |
|---|
| 225 | usage => 'twitter-follow USER [ACCOUNT]', |
|---|
| 226 | description => 'Follow USER on Twitter ACCOUNT (defaults to default_sender, or first service' |
|---|
| 227 | . "\nif no default is provided)" |
|---|
| 228 | } |
|---|
| 229 | ); |
|---|
| 230 | |
|---|
| 231 | BarnOwl::new_command( 'twitter-unfollow' => sub { cmd_twitter_unfollow(@_); }, |
|---|
| 232 | { |
|---|
| 233 | summary => 'Stop following a user on Twitter', |
|---|
| 234 | usage => 'twitter-unfollow USER [ACCOUNT]', |
|---|
| 235 | description => 'Stop following USER on Twitter ACCOUNT (defaults to default_sender, or first' |
|---|
| 236 | . "\nservice if no default is provided)" |
|---|
| 237 | } |
|---|
| 238 | ); |
|---|
| 239 | |
|---|
| 240 | sub cmd_twitter { |
|---|
| 241 | my $cmd = shift; |
|---|
| 242 | my $account = shift; |
|---|
| 243 | if (defined $account) { |
|---|
| 244 | if(@_) { |
|---|
| 245 | my $status = join(" ", @_); |
|---|
| 246 | twitter($account, $status); |
|---|
| 247 | return; |
|---|
| 248 | } |
|---|
| 249 | } |
|---|
| 250 | BarnOwl::start_edit_win('What are you doing?' . (defined $account ? " ($account)" : ""), sub{twitter($account, shift)}); |
|---|
| 251 | } |
|---|
| 252 | |
|---|
| 253 | sub cmd_twitter_direct { |
|---|
| 254 | my $cmd = shift; |
|---|
| 255 | my $user = shift; |
|---|
| 256 | die("Usage: $cmd USER\n") unless $user; |
|---|
| 257 | my $account = find_account_default(shift); |
|---|
| 258 | BarnOwl::start_edit_win("$cmd $user " . ($account->nickname||""), |
|---|
| 259 | sub { $account->twitter_direct($user, shift) }); |
|---|
| 260 | } |
|---|
| 261 | |
|---|
| 262 | sub cmd_twitter_atreply { |
|---|
| 263 | my $cmd = shift; |
|---|
| 264 | my $user = shift || die("Usage: $cmd USER [In-Reply-To ID]\n"); |
|---|
| 265 | my $id = shift; |
|---|
| 266 | my $account = find_account_default(shift); |
|---|
| 267 | |
|---|
| 268 | BarnOwl::start_edit_win("Reply to \@" . $user . ($account->nickname ? (" on " . $account->nickname) : ""), |
|---|
| 269 | sub { $account->twitter_atreply($user, $id, shift) }); |
|---|
| 270 | } |
|---|
| 271 | |
|---|
| 272 | sub cmd_twitter_follow { |
|---|
| 273 | my $cmd = shift; |
|---|
| 274 | my $user = shift; |
|---|
| 275 | die("Usage: $cmd USER\n") unless $user; |
|---|
| 276 | my $account = shift; |
|---|
| 277 | find_account_default($account)->twitter_follow($user); |
|---|
| 278 | } |
|---|
| 279 | |
|---|
| 280 | sub cmd_twitter_unfollow { |
|---|
| 281 | my $cmd = shift; |
|---|
| 282 | my $user = shift; |
|---|
| 283 | die("Usage: $cmd USER\n") unless $user; |
|---|
| 284 | my $account = shift; |
|---|
| 285 | find_account_default($account)->twitter_unfollow($user); |
|---|
| 286 | } |
|---|
| 287 | |
|---|
| 288 | eval { |
|---|
| 289 | $BarnOwl::Hooks::receiveMessage->add("BarnOwl::Module::Twitter::handle_message"); |
|---|
| 290 | $BarnOwl::Hooks::mainLoop->add("BarnOwl::Module::Twitter::poll_messages"); |
|---|
| 291 | }; |
|---|
| 292 | if($@) { |
|---|
| 293 | $BarnOwl::Hooks::receiveMessage->add(\&handle_message); |
|---|
| 294 | $BarnOwl::Hooks::mainLoop->add(\&poll_messages); |
|---|
| 295 | } |
|---|
| 296 | |
|---|
| 297 | BarnOwl::filter(qw{twitter type ^twitter$}); |
|---|
| 298 | |
|---|
| 299 | 1; |
|---|