videosite.pl

   1 # autodownload flash videos
   2 #
   3 # (c) 2007-2008 by Ralf Ertzinger <ralf@camperquake.de>
   4 # licensed under GNU GPL v2
   5 #
   6 # Based on youtube.pl by Christian Garbs <mitch@cgarbs.de>
   7 # which in turn is
   8 # based on trigger.pl by Wouter Coekaerts <wouter@coekaerts.be>
   9
  10
  11 BEGIN {
  12     # Get rid of a (possibly old) version of BettIrssi
  13     # This is a hack to prevent having to reload irssi just
  14     # because BettIrssi.pm changed
  15
  16     delete($INC{'BettIrssi.pm'});
  17 }
  18
  19 use strict;
  20 use Irssi 20020324 qw (command_bind command_runsub signal_add_first signal_add_last);
  21 use vars qw($VERSION %IRSSI);
  22 use XML::Simple;
  23 use Data::Dumper;
  24 use File::Spec;
  25 use File::Temp qw(tempfile);
  26 use BettIrssi 101 qw(_bcb _bcs);
  27 use LWP::UserAgent;
  28
  29 my @grabbers;
  30 my @getters;
  31 my $getter;
  32 my $conf;
  33 my $conffile = File::Spec->catfile(Irssi::get_irssi_dir(), 'videosite.xml');
  34 my $scriptdir = File::Spec->catfile(Irssi::get_irssi_dir(), 'scripts');
  35 my $plugindir = File::Spec->catfile($scriptdir, 'videosite');
  36 my @outputstack = (undef);
  37
  38 my $PARAMS = {
  39     'getter' => '',
  40     'mode' => 'download'
  41 };
  42
  43
  44 # activate debug here
  45 my $debug = 0;
  46
  47 # "message public", SERVER_REC, char *msg, char *nick, char *address, char *target
  48 signal_add_last(_bcs("message public" => sub {check_for_link(@_)}));
  49 # "message own_public", SERVER_REC, char *msg, char *target
  50 signal_add_last(_bcs("message own_public" => sub {check_for_link(@_)}));
  51
  52 # "message private", SERVER_REC, char *msg, char *nick, char *address
  53 signal_add_last(_bcs("message private" => sub {check_for_link(@_)}));
  54 # "message own_private", SERVER_REC, char *msg, char *target, char *orig_target
  55 signal_add_last(_bcs("message own_private" => sub {check_for_link(@_)}));
  56
  57 # "message irc action", SERVER_REC, char *msg, char *nick, char *address, char *target
  58 signal_add_last(_bcs("message irc action" => sub {check_for_link(@_)}));
  59 # "message irc own_action", SERVER_REC, char *msg, char *target
  60 signal_add_last(_bcs("message irc own_action" => sub {check_for_link(@_)}));
  61
  62 # For tab completion
  63 # This does not use BettIrssi (yet)
  64 signal_add_first('complete word', \&sig_complete);
  65
  66 sub push_output {
  67     unshift(@outputstack, shift);
  68 }
  69
  70 sub pop_output {
  71     shift(@outputstack);
  72
  73     @outputstack = (undef) unless (@outputstack);
  74 }
  75
  76 my $videosite_commands = {
  77     'save' => sub {
  78         cmd_save();
  79     },
  80
  81     'set' => sub {
  82         cmd_set(@_);
  83     },
  84
  85     'show' => sub {
  86         cmd_show(@_);
  87     },
  88
  89     'help' => sub {
  90         cmd_help(@_);
  91     },
  92
  93     'getter' => sub {
  94         cmd_getter(@_);
  95     },
  96
  97     'enable' => sub {
  98         cmd_enable(@_);
  99     },
 100
 101     'disable' => sub {
 102         cmd_disable(@_);
 103     },
 104
 105     'reload' => sub {
 106         init_videosite(0);
 107     },
 108
 109     'mode' => sub {
 110         cmd_mode(@_);
 111     },
 112
 113     'debug' => sub {
 114         $debug = 1;
 115         foreach (@grabbers, @getters) {
 116             $_->setdebug(1);
 117         }
 118         write_irssi('Enabled debugging');
 119     },
 120
 121     'nodebug' => sub {
 122         $debug = 0;
 123         foreach (@grabbers, @getters) {
 124             $_->setdebug(0);
 125         }
 126         write_irssi('Disabled debugging');
 127     },
 128 };
 129
 130 sub write_irssi {
 131     my @text = @_;
 132     my $output = $outputstack[0];
 133
 134     my $format = "%%mvideosite: %%n" . shift(@text);
 135
 136     # escape % in parameters from irssi
 137     s/%/%%/g foreach @text;
 138
 139     if (defined $output) {
 140         $output->(sprintf($format, @text), MSGLEVEL_CLIENTCRAP);
 141     } else {
 142         Irssi::print(sprintf($format, @text));
 143     }
 144
 145 }
 146
 147 sub write_debug {
 148     if ($debug) {
 149         write_irssi(@_);
 150     }
 151 }
 152
 153 sub expand_url_shortener {
 154     my $s = shift;
 155     my $os = '';
 156     my @urlshortener = (
 157         'is\.gd/[[:alnum:]]+',
 158         'otf\.me/[[:alnum:]]+',
 159         'hel\.me/[[:alnum:]]+',
 160         '7ax\.de/[[:alnum:]]+',
 161         'ow\.ly/[[:alnum:]]+',
 162         'j\.mp/[[:alnum:]]+',
 163         'bit\.ly/[[:alnum:]]+',
 164         'tinyurl\.com/[[:alnum:]]+',
 165         'pop\.is/[[:alnum:]]+',
 166         'post\.ly/[[:alnum:]]+',
 167         '1\.ly/[[:alnum:]]+',
 168         '2\.ly/[[:alnum:]]+',
 169         't\.co/[[:alnum:]]+',
 170         'shar\.es/[[:alnum:]]+',
 171         'goo\.gl/[[:alnum:]]+',
 172         );
 173     my $ua = LWP::UserAgent->new(agent => 'Mozilla', max_redirect => 0);
 174     my $i = 10;
 175
 176     OUTER: while (($os ne $s) and ($i > 0)) {
 177         study($s);
 178         $os = $s;
 179         $i--;
 180
 181         foreach my $pattern (@urlshortener) {
 182             my $p = "https?:\/\/" . $pattern;
 183
 184             write_debug("Matching %s against %s", $p, $s);
 185             if ($s =~ m|($p)|) {
 186                 my $matched = $1;
 187                 my $res;
 188
 189                 write_debug("Found %s", $matched);
 190                 $res = $ua->head($matched);
 191                 if ($res->is_redirect()) {
 192                     my $new = $res->headers()->header("Location");
 193
 194                     write_debug("Replacing %s with %s", $matched, $new);
 195                     $s =~ s/$matched/$new/;
 196                     next OUTER;
 197                 } else {
 198                     write_debug("Error resolving %s", $matched);
 199                 }
 200             }
 201         }
 202     }
 203
 204     if ($i == 0) {
 205         write_debug("Loop terminated by counter");
 206     }
 207
 208     write_debug("Final string: %s", $s);
 209
 210     return $s;
 211 }
 212
 213
 214 sub check_for_link {
 215     my $event = shift;
 216     my $message = $event->message();
 217     my $witem = $event->channel();
 218     my $g;
 219     my $m;
 220     my $p;
 221
 222
 223     # Look if we should ignore this line
 224     if ($message =~ m,(?:\s|^)/nosave(?:\s|$),) {
 225         return;
 226     }
 227
 228     push_output($event->ewpf);
 229     $message = expand_url_shortener($message);
 230
 231     study($message);
 232
 233     # Offer the message to all Grabbers in turn
 234     GRABBER: foreach $g (@grabbers) {
 235         ($m, $p) = $g->get($message);
 236         while (defined($m)) {
 237             write_debug('Metadata: %s', Dumper($m));
 238             if ('download' eq ($conf->{'videosite'}->{'mode'})) {
 239                 write_irssi('%%R>>> %%NSaving %%Y%s%%N %%G%s', $m->{'SOURCE'}, $m->{'TITLE'});
 240                 unless($getter->get($m)) {
 241                     write_irssi('%%R>>> FAILED');
 242                 }
 243             } elsif ('display' eq ($conf->{'videosite'}->{'mode'})) {
 244                 write_irssi('%%M>>> %%NSaw %%Y%s%%N %%G%s', $m->{'SOURCE'}, $m->{'TITLE'});
 245             } else {
 246                 write_irssi('%%R>>> Invalid operation mode');
 247             }
 248
 249             # Remove the matched part from the message and try again (there may be
 250             # more!)
 251             $message =~ s/$p//;
 252             study($message);
 253             last GRABBER if ($message =~ /^\s*$/);
 254
 255             ($m, $p) = $g->get($message);
 256         }
 257     }
 258
 259     pop_output();
 260 }
 261
 262 sub cmd_save {
 263
 264
 265     eval {
 266         my ($tempfile, $tempfn) = tempfile("videosite.xml.XXXXXX", dir => Irssi::get_irssi_dir());
 267         print $tempfile XML::Simple::XMLout($conf, KeepRoot => 1, KeyAttr => {'config' => 'module', 'option' => 'key'});
 268         close($tempfile);
 269         rename($tempfn, $conffile);
 270     };
 271     if ($@) {
 272         write_irssi('Could not save config to %s: %s', ($conffile, $@));
 273     } else {
 274         write_irssi('configuration saved to %s', $conffile);
 275     }
 276 }
 277
 278 sub cmd_set {
 279     my $target = shift;
 280     my $key = shift;
 281     my $val = shift;
 282     my $p;
 283
 284     foreach $p (@getters, @grabbers) {
 285         if ($p->{'NAME'} eq $target) {
 286             $p->setval($key, $val);
 287             return;
 288         }
 289     }
 290     write_irssi('No such module');
 291 }
 292
 293
 294 sub cmd_enable {
 295     my $target = shift;
 296     my $p;
 297
 298     foreach $p (@grabbers) {
 299         if ($p->{'NAME'} eq $target) {
 300             $p->enable();
 301             return;
 302         }
 303     }
 304     write_irssi('No such module');
 305 }
 306
 307
 308 sub cmd_disable {
 309     my $target = shift;
 310     my $p;
 311
 312     foreach $p (@grabbers) {
 313         if ($p->{'NAME'} eq $target) {
 314             $p->disable();
 315             return;
 316         }
 317     }
 318     write_irssi('No such module');
 319 }
 320
 321
 322 sub cmd_show {
 323     my $target = shift;
 324     my $p;
 325     my $e;
 326
 327     if (defined($target)) {
 328         foreach $p (@getters, @grabbers) {
 329             if ($p->{'NAME'} eq $target) {
 330                 write_irssi($p->getconfstr());
 331                 return;
 332             }
 333         }
 334         write_irssi('No such module');
 335     } else {
 336         write_irssi('Loaded grabbers (* denotes enabled modules):');
 337         foreach $p (@grabbers) {
 338             $e = $p->_getval('enabled');
 339             write_irssi(' %s%s', $p->{'NAME'}, $e?'*':'');
 340         };
 341
 342         write_irssi('Loaded getters:');
 343         foreach $p (@getters) {
 344             write_irssi(' %s', $p->{'NAME'});
 345         };
 346     }
 347 }
 348
 349 sub cmd_help {
 350     my $target = shift;
 351     my $p;
 352
 353     if (defined($target)) {
 354         foreach $p (@getters, @grabbers) {
 355             if ($p->{'NAME'} eq $target) {
 356                 write_irssi($p->gethelpstr());
 357                 return;
 358             }
 359         }
 360         write_irssi('No such module');
 361     } else {
 362         write_irssi(<<'EOT');
 363 Supported commands:
 364  save: save the current configuration
 365  help [modulename]: display this help, or module specific help
 366  show [modulename]: show loaded modules, or the current parameters of a module
 367  set modulename parameter value: set a module parameter to a new value
 368  getter [modulename]: display or set the getter to use
 369  enable [modulename]: enable the usage of this module (grabbers only)
 370  disable [modulename]: disable the usage of this module (grabbers only)
 371  reload: reload all modules (this is somewhat experimental)
 372  mode [modename]: display or set the operation mode (download/display)
 373  debug: enable debugging messages
 374  nodebug: disable debugging messages
 375 EOT
 376     }
 377 }
 378
 379 sub cmd_getter {
 380     my $target = shift;
 381     my $p;
 382
 383     if (defined($target)) {
 384         foreach $p (@getters) {
 385             if ($p->{'NAME'} eq $target) {
 386                 $getter = $p;
 387                 $conf->{'videosite'}->{'getter'} = $target;
 388                 write_irssi("Getter changed to %s", $target);
 389                 return;
 390             }
 391         }
 392         write_irssi('No such getter');
 393     } else {
 394         write_irssi('Current getter: %s', $conf->{'videosite'}->{'getter'});
 395     }
 396 }
 397
 398 sub cmd_mode {
 399     my $mode = shift;
 400
 401     if (defined($mode)) {
 402         $mode = lc($mode);
 403         if (('download' eq $mode) or ('display' eq $mode)) {
 404             $conf->{'videosite'}->{'mode'} = $mode;
 405             write_irssi('Now using %s mode', $mode);
 406         } else {
 407             write_irssi('Invalid mode: %s', $mode);
 408         }
 409     } else {
 410         write_irssi('Current mode: %s', $conf->{'videosite'}->{'mode'});
 411     }
 412 }
 413
 414
 415 # save on unload
 416 sub sig_command_script_unload {
 417     my $script = shift;
 418     if ($script =~ /(.*\/)?videosite(\.pl)?$/) {
 419         cmd_save();
 420     }
 421 }
 422
 423 sub ploader {
 424
 425     my $dir = shift;
 426     my $pattern = shift;
 427     my $type = shift;
 428     my @list;
 429     my $p;
 430     my $g;
 431     my @g = ();
 432
 433     opendir(D, $dir) || return ();
 434     @list = grep {/$pattern/ && -f File::Spec->catfile($dir, $_) } readdir(D);
 435     closedir(D);
 436
 437     foreach $p (@list) {
 438         write_debug("Trying to load $p:");
 439         $p =~ s/\.pm$//;
 440         eval qq{ require videosite::$p; };
 441         if ($@) {
 442             write_irssi("Failed to load plugin: $@");
 443             next;
 444         }
 445
 446         $g = eval qq{ videosite::$p->new(); };
 447         if ($@) {
 448             write_irssi("Failed to instanciate: $@");
 449             delete($INC{$p});
 450             next;
 451         }
 452
 453         write_debug("found $g->{'TYPE'} $g->{'NAME'}");
 454         if ($type eq $g->{'TYPE'}) {
 455             push(@g, $g);
 456             $g->setio(\&write_irssi);
 457         } else {
 458             write_irssi('%s has wrong type (got %s, expected %s)', $p, $g->{'TYPE'}, $type);
 459             delete($INC{$p});
 460         }
 461     }
 462
 463     write_debug("Loaded %d plugins", $#g+1);
 464
 465     return @g;
 466 }
 467
 468 sub _load_modules($) {
 469
 470     my $path = shift;
 471
 472     foreach (keys(%INC)) {
 473         if ($INC{$_} =~ m|^$path|) {
 474             write_debug("Removing %s from \$INC", $_);
 475             delete($INC{$_});
 476         }
 477     }
 478     @grabbers = ploader($path, '.*Grabber\.pm$', 'grabber');
 479     @getters = ploader($path, '.*Getter\.pm$', 'getter');
 480 }
 481
 482
 483 sub init_videosite {
 484
 485     my $bindings = shift;
 486     my $p;
 487
 488     unless(-r $conffile && defined($conf = XML::Simple::XMLin($conffile, ForceArray => ['config', 'option'], KeepRoot => 1, KeyAttr => {'config' => 'module', 'option' => 'key'}))) {
 489         # No config, start with an empty one
 490         write_debug('No config found, using defaults');
 491         $conf = { 'videosite' => { }};
 492     }
 493     foreach (keys(%{$PARAMS})) {
 494         unless (exists($conf->{'videosite'}->{$_})) {
 495             $conf->{'videosite'}->{$_} = $PARAMS->{$_};
 496         }
 497     }
 498
 499     _load_modules($plugindir);
 500
 501     unless (defined(@grabbers) && defined(@getters)) {
 502         write_irssi('No grabbers or no getters found, can not proceed.');
 503         return;
 504     }
 505
 506     $getter = $getters[0];
 507     foreach $p (@getters) {
 508         if ($conf->{'videosite'}->{'getter'} eq $p->{'NAME'}) {
 509             $getter = $p;
 510         }
 511     }
 512     write_debug('Selected %s as getter', $getter->{'NAME'});
 513     $conf->{'videosite'}->{'getter'} = $getter->{'NAME'};
 514
 515     # Loop through all plugins and load the config
 516     foreach $p (@grabbers, @getters) {
 517         $conf->{'videosite'}->{'config'}->{$p->{'NAME'}} = $p->mergeconfig($conf->{'videosite'}->{'config'}->{$p->{'NAME'}});
 518     }
 519
 520     if ($bindings) {
 521
 522         Irssi::signal_add_first('command script load', 'sig_command_script_unload');
 523         Irssi::signal_add_first('command script unload', 'sig_command_script_unload');
 524         Irssi::signal_add('setup saved', 'cmd_save');
 525
 526
 527         Irssi::command_bind(_bcb('videosite' => \&cmdhandler));
 528     }
 529
 530     write_irssi('initialized successfully');
 531 }
 532
 533 sub sig_complete {
 534     my ($complist, $window, $word, $linestart, $want_space) = @_;
 535     my @matches;
 536
 537     if ($linestart !~ m|^/videosite\b|) {
 538         return;
 539     }
 540
 541     if ('/videosite' eq $linestart) {
 542         # No command enterd so far. Produce a list of possible follow-ups
 543         @matches = grep {/^$word/} keys (%{$videosite_commands});
 544     } elsif ('/videosite set' eq $linestart) {
 545         # 'set' command entered. Produce a list of modules
 546         foreach (@grabbers, @getters) {
 547             push(@matches, $_->{'NAME'}) if $_->{'NAME'} =~ m|^$word|;
 548         };
 549     } elsif ($linestart =~ m|^/videosite set (\w+)$|) {
 550         my $module = $1;
 551
 552         foreach my $p (@getters, @grabbers) {
 553             if ($p->{'NAME'} eq $module) {
 554                 @matches = $p->getparamlist($word);
 555                 last;
 556             }
 557         }
 558     } elsif ($linestart =~ m|/videosite set (\w+) (\w+)$|) {
 559         my $module = $1;
 560         my $param = $2;
 561
 562         foreach my $p (@getters, @grabbers) {
 563             if ($p->{'NAME'} eq $module) {
 564                 @matches = $p->getparamvalues($param, $word);
 565                 last;
 566             }
 567         }
 568     }
 569
 570
 571     push(@{$complist}, sort @matches);
 572     ${$want_space} = 0;
 573
 574     Irssi::signal_stop();
 575 }
 576
 577 sub cmdhandler {
 578     my $event = shift;
 579     my ($cmd, @params) = split(/\s+/, $event->message());
 580
 581     push_output($event->ewpf);
 582
 583     if (exists($videosite_commands->{$cmd})) {
 584         $videosite_commands->{$cmd}->(@params);
 585     }
 586
 587     pop_output();
 588 }
 589
 590 unshift(@INC, $scriptdir);
 591 init_videosite(1);