videosite-irssi.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 use strict;
  11 use Irssi 20020324 qw (command_bind command_runsub signal_add_first signal_add_last);
  12 use vars qw($VERSION %IRSSI);
  13 use Data::Dumper;
  14 use File::Spec;
  15 use File::Temp qw(tempfile);
  16
  17 my @grabbers;
  18 my @getters;
  19 my $getter;
  20 my $conf;
  21 my $xmlconffile = File::Spec->catfile(Irssi::get_irssi_dir(), 'videosite.xml');
  22 my $conffile = File::Spec->catfile(Irssi::get_irssi_dir(), 'videosite.json');
  23 my $scriptdir = File::Spec->catfile(Irssi::get_irssi_dir(), 'scripts');
  24 my $plugindir = File::Spec->catfile($scriptdir, 'videosite');
  25 my @outputstack = (undef);
  26
  27 # "message public", SERVER_REC, char *msg, char *nick, char *address, char *target
  28 signal_add_last(_bcs("message public" => sub {check_for_link(@_)}));
  29 # "message own_public", SERVER_REC, char *msg, char *target
  30 signal_add_last(_bcs("message own_public" => sub {check_for_link(@_)}));
  31
  32 # "message private", SERVER_REC, char *msg, char *nick, char *address
  33 signal_add_last(_bcs("message private" => sub {check_for_link(@_)}));
  34 # "message own_private", SERVER_REC, char *msg, char *target, char *orig_target
  35 signal_add_last(_bcs("message own_private" => sub {check_for_link(@_)}));
  36
  37 # "message irc action", SERVER_REC, char *msg, char *nick, char *address, char *target
  38 signal_add_last(_bcs("message irc action" => sub {check_for_link(@_)}));
  39 # "message irc own_action", SERVER_REC, char *msg, char *target
  40 signal_add_last(_bcs("message irc own_action" => sub {check_for_link(@_)}));
  41
  42 # For tab completion
  43 # This does not use BettIrssi (yet)
  44 signal_add_first('complete word', \&sig_complete);
  45
  46 sub push_output {
  47     unshift(@outputstack, shift);
  48 }
  49
  50 sub pop_output {
  51     shift(@outputstack);
  52
  53     @outputstack = (undef) unless (@outputstack);
  54 }
  55
  56 my $videosite_commands = {
  57     'save' => sub {
  58         cmd_save();
  59     },
  60
  61     'set' => sub {
  62         cmd_set(@_);
  63     },
  64
  65     'show' => sub {
  66         cmd_show(@_);
  67     },
  68
  69     'help' => sub {
  70         cmd_help(@_);
  71     },
  72
  73     'getter' => sub {
  74         cmd_getter(@_);
  75     },
  76
  77     'enable' => sub {
  78         cmd_enable(@_);
  79     },
  80
  81     'disable' => sub {
  82         cmd_disable(@_);
  83     },
  84
  85     'reload' => sub {
  86         init_videosite(0);
  87     },
  88
  89     'mode' => sub {
  90         cmd_mode(@_);
  91     },
  92
  93     'connector' => sub {
  94         cmd_connector(@_);
  95     },
  96
  97     'debug' => sub {
  98         $debug = 1;
  99         foreach (@grabbers, @getters) {
 100             $_->setdebug(1);
 101         }
 102         write_irssi('Enabled debugging');
 103     },
 104
 105     'nodebug' => sub {
 106         $debug = 0;
 107         foreach (@grabbers, @getters) {
 108             $_->setdebug(0);
 109         }
 110         write_irssi('Disabled debugging');
 111     },
 112 };
 113
 114 sub write_irssi {
 115     my @text = @_;
 116     my $output = $outputstack[0];
 117
 118     my $format = "%%mvideosite: %%n" . shift(@text);
 119
 120     # escape % in parameters from irssi
 121     s/%/%%/g foreach @text;
 122
 123     if (defined $output) {
 124         $output->(sprintf($format, @text), MSGLEVEL_CLIENTCRAP);
 125     } else {
 126         Irssi::print(sprintf($format, @text));
 127     }
 128
 129 }
 130
 131 sub write_debug {
 132     if ($debug) {
 133         write_irssi(@_);
 134     }
 135 }
 136
 137 sub expand_url_shortener {
 138     my $s = shift;
 139     my $os = '';
 140     my @urlshortener = (
 141         'is\.gd/[[:alnum:]]+',
 142         'otf\.me/[[:alnum:]]+',
 143         'hel\.me/[[:alnum:]]+',
 144         '7ax\.de/[[:alnum:]]+',
 145         'ow\.ly/[[:alnum:]]+',
 146         'j\.mp/[[:alnum:]]+',
 147         'bit\.ly/[[:alnum:]]+',
 148         'tinyurl\.com/[[:alnum:]]+',
 149         'pop\.is/[[:alnum:]]+',
 150         'post\.ly/[[:alnum:]]+',
 151         '1\.ly/[[:alnum:]]+',
 152         '2\.ly/[[:alnum:]]+',
 153         't\.co/[[:alnum:]]+',
 154         'shar\.es/[[:alnum:]]+',
 155         'goo\.gl/[[:alnum:]]+',
 156         );
 157     my $ua = LWP::UserAgent->new(agent => 'Mozilla', max_redirect => 0, timeout => 5);
 158     my $i = 10;
 159
 160     OUTER: while (($os ne $s) and ($i > 0)) {
 161         study($s);
 162         $os = $s;
 163         $i--;
 164
 165         foreach my $pattern (@urlshortener) {
 166             my $p = "https?:\/\/" . $pattern;
 167
 168             write_debug("Matching %s against %s", $p, $s);
 169             if ($s =~ m|($p)|) {
 170                 my $matched = $1;
 171                 my $res;
 172
 173                 write_debug("Found %s", $matched);
 174                 $res = $ua->head($matched);
 175                 if ($res->is_redirect()) {
 176                     my $new = $res->headers()->header("Location");
 177
 178                     write_debug("Replacing %s with %s", $matched, $new);
 179                     $s =~ s/$matched/$new/;
 180                     next OUTER;
 181                 } else {
 182                     write_debug("Error resolving %s", $matched);
 183                 }
 184             }
 185         }
 186     }
 187
 188     if ($i == 0) {
 189         write_debug("Loop terminated by counter");
 190     }
 191
 192     write_debug("Final string: %s", $s);
 193
 194     return $s;
 195 }
 196
 197 sub connectorlist {
 198     my @c;
 199
 200     foreach (@{$conf->{'videosite'}->{'connectorlist'}}) {
 201         push(@c, $conf->{'videosite'}->{'connectors'}->{$_});
 202     }
 203
 204     return @c;
 205 }
 206
 207
 208 sub check_for_link {
 209     my $event = shift;
 210     my $message = $event->message();
 211     my $witem = $event->channel();
 212     my $g;
 213     my $m;
 214     my $p;
 215
 216
 217     # Look if we should ignore this line
 218     if ($message =~ m,(?:\s|^)/nosave(?:\s|$),) {
 219         return;
 220     }
 221
 222     push_output($event->ewpf);
 223     $message = expand_url_shortener($message);
 224
 225     study($message);
 226
 227     # Offer the message to all Grabbers in turn
 228     GRABBER: foreach $g (@grabbers) {
 229         ($m, $p) = $g->get($message);
 230         while (defined($m)) {
 231             write_debug('Metadata: %s', Dumper($m));
 232             if ('download' eq ($conf->{'videosite'}->{'mode'})) {
 233                 write_irssi('%%R>>> %%NSaving %%Y%s%%N %%G%s', $m->{'SOURCE'}, $m->{'TITLE'});
 234                 unless($getter->get($m)) {
 235                     write_irssi('%%R>>> FAILED');
 236                 }
 237             } elsif ('display' eq ($conf->{'videosite'}->{'mode'})) {
 238                 write_irssi('%%M>>> %%NSaw %%Y%s%%N %%G%s', $m->{'SOURCE'}, $m->{'TITLE'});
 239             } else {
 240                 write_irssi('%%R>>> Invalid operation mode');
 241             }
 242
 243             # Remove the matched part from the message and try again (there may be
 244             # more!)
 245             $message =~ s/$p//;
 246             study($message);
 247             last GRABBER if ($message =~ /^\s*$/);
 248
 249             ($m, $p) = $g->get($message);
 250         }
 251     }
 252
 253     pop_output();
 254 }
 255
 256 sub cmd_save {
 257
 258     eval {
 259         my ($tempfile, $tempfn) = tempfile("videosite.json.XXXXXX", dir => Irssi::get_irssi_dir());
 260         print $tempfile JSON->new->pretty->utf8->encode($conf);
 261         close($tempfile);
 262         rename($tempfn, $conffile);
 263     };
 264     if ($@) {
 265         write_irssi('Could not save config to %s: %s', ($conffile, $@));
 266     } else {
 267         write_irssi('configuration saved to %s', $conffile);
 268     }
 269 }
 270
 271 sub cmd_set {
 272     my $target = shift;
 273     my $key = shift;
 274     my $val = shift;
 275     my $p;
 276
 277     foreach $p (@getters, @grabbers) {
 278         if ($p->{'NAME'} eq $target) {
 279             $p->setval($key, $val);
 280             return;
 281         }
 282     }
 283     write_irssi('No such module');
 284 }
 285
 286
 287 sub cmd_enable {
 288     my $target = shift;
 289     my $p;
 290
 291     foreach $p (@grabbers) {
 292         if ($p->{'NAME'} eq $target) {
 293             $p->enable();
 294             return;
 295         }
 296     }
 297     write_irssi('No such module');
 298 }
 299
 300
 301 sub cmd_disable {
 302     my $target = shift;
 303     my $p;
 304
 305     foreach $p (@grabbers) {
 306         if ($p->{'NAME'} eq $target) {
 307             $p->disable();
 308             return;
 309         }
 310     }
 311     write_irssi('No such module');
 312 }
 313
 314
 315 sub cmd_show {
 316     my $target = shift;
 317     my $p;
 318     my $e;
 319
 320     if (defined($target)) {
 321         foreach $p (@getters, @grabbers) {
 322             if ($p->{'NAME'} eq $target) {
 323                 write_irssi($p->getconfstr());
 324                 return;
 325             }
 326         }
 327         write_irssi('No such module');
 328     } else {
 329         write_irssi('Loaded grabbers (* denotes enabled modules):');
 330         foreach $p (@grabbers) {
 331             $e = $p->_getval('enabled');
 332             write_irssi(' %s%s', $p->{'NAME'}, $e?'*':'');
 333         };
 334
 335         write_irssi('Loaded getters:');
 336         foreach $p (@getters) {
 337             write_irssi(' %s', $p->{'NAME'});
 338         };
 339     }
 340 }
 341
 342 sub cmd_help {
 343     my $target = shift;
 344     my $p;
 345
 346     if (defined($target)) {
 347         foreach $p (@getters, @grabbers) {
 348             if ($p->{'NAME'} eq $target) {
 349                 write_irssi($p->gethelpstr());
 350                 return;
 351             }
 352         }
 353         write_irssi('No such module');
 354     } else {
 355         write_irssi(<<'EOT');
 356 Supported commands:
 357  save: save the current configuration
 358  help [modulename]: display this help, or module specific help
 359  show [modulename]: show loaded modules, or the current parameters of a module
 360  set modulename parameter value: set a module parameter to a new value
 361  getter [modulename]: display or set the getter to use
 362  enable [modulename]: enable the usage of this module (grabbers only)
 363  disable [modulename]: disable the usage of this module (grabbers only)
 364  reload: reload all modules (this is somewhat experimental)
 365  mode [modename]: display or set the operation mode (download/display)
 366  connector [subcommand]: manage connectors (proxies)
 367  debug: enable debugging messages
 368  nodebug: disable debugging messages
 369 EOT
 370     }
 371 }
 372
 373 sub cmd_getter {
 374     my $target = shift;
 375     my $p;
 376
 377     if (defined($target)) {
 378         foreach $p (@getters) {
 379             if ($p->{'NAME'} eq $target) {
 380                 $getter = $p;
 381                 $conf->{'videosite'}->{'getter'} = $target;
 382                 write_irssi("Getter changed to %s", $target);
 383                 return;
 384             }
 385         }
 386         write_irssi('No such getter');
 387     } else {
 388         write_irssi('Current getter: %s', $conf->{'videosite'}->{'getter'});
 389     }
 390 }
 391
 392 sub cmd_mode {
 393     my $mode = shift;
 394
 395     if (defined($mode)) {
 396         $mode = lc($mode);
 397         if (('download' eq $mode) or ('display' eq $mode)) {
 398             $conf->{'videosite'}->{'mode'} = $mode;
 399             write_irssi('Now using %s mode', $mode);
 400         } else {
 401             write_irssi('Invalid mode: %s', $mode);
 402         }
 403     } else {
 404         write_irssi('Current mode: %s', $conf->{'videosite'}->{'mode'});
 405     }
 406 }
 407
 408 sub cmd_connector {
 409     my $subcmd = shift;
 410     my $connconf = $conf->{'videosite'}->{'connectors'};
 411
 412     unless(defined($subcmd)) {
 413         $subcmd = "help";
 414     }
 415
 416     $subcmd = lc($subcmd);
 417
 418     if ($subcmd eq 'list') {
 419         write_irssi("Defined connectors");
 420         foreach (keys(%{$connconf})) {
 421             write_irssi($_);
 422             my $schemas = $connconf->{$_}->{'schemas'};
 423             if (scalar(keys(%{$schemas})) == 0) {
 424                 write_irssi(" No schemas defined");
 425             } else {
 426                 foreach (keys(%{$schemas})) {
 427                     write_irssi(' %s: %s', $_, $schemas->{$_});
 428                 }
 429             }
 430         }
 431
 432         write_irssi();
 433         write_irssi("Selected connectors: %s", join(", ", @{$conf->{'videosite'}->{'connectorlist'}}));
 434     } elsif ($subcmd eq 'add') {
 435         my ($name) = @_;
 436
 437         unless(defined($name)) {
 438             write_irssi("No name given");
 439             return;
 440         }
 441
 442         $name = lc($name);
 443
 444         if (exists($connconf->{$_})) {
 445             write_irssi("Connector already exists");
 446             return;
 447         }
 448
 449         $connconf->{$name} = {'name' => $name, 'schemas' => {}};
 450     } elsif ($subcmd eq 'del') {
 451         my ($name) = @_;
 452
 453         unless(defined($name)) {
 454             write_irssi("No name given");
 455             return;
 456         }
 457
 458         $name = lc($name);
 459
 460         unless (exists($connconf->{$name})) {
 461             write_irssi("Connector does not exist");
 462             return;
 463         }
 464
 465         if (exists($connconf->{$name}->{'_immutable'})) {
 466             write_irssi("Connector cannot be removed");
 467             return;
 468         }
 469
 470         delete($connconf->{$name});
 471
 472         # Remove from list of active connectors
 473         $conf->{'videosite'}->{'connectorlist'} =
 474             [ grep { $_ ne $name } @{$conf->{'videosite'}->{'connectorlist'}} ];
 475
 476         if (scalar(@{$conf->{'videosite'}->{'connectorlist'}}) == 0) {
 477             write_irssi("List of selected connectors is empty, resetting to direct");
 478             $conf->{'videosite'}->{'connectorlist'} = [ 'direct' ];
 479         }
 480     } elsif ($subcmd eq 'addschema') {
 481         my ($conn, $schema, $proxy) = @_;
 482
 483         unless(defined($conn)) {
 484             write_irssi("No connector name given");
 485             return;
 486         }
 487
 488         $conn = lc($conn);
 489
 490         if (exists($connconf->{$conn}->{'_immutable'})) {
 491             write_irssi("Connector cannot be modified");
 492             return;
 493         }
 494
 495         unless(defined($schema)) {
 496             write_irssi("No schema given");
 497             return;
 498         }
 499
 500         $schema = lc($schema);
 501
 502         unless(defined($proxy)) {
 503             write_irssi("No proxy given");
 504             return;
 505         }
 506
 507         unless(exists($connconf->{$conn})) {
 508             write_irssi("Connector does not exist");
 509             return;
 510         }
 511
 512         $connconf->{$conn}->{'schemas'}->{$schema} = $proxy;
 513     } elsif ($subcmd eq 'delschema') {
 514         my ($conn, $schema) = @_;
 515
 516         unless(defined($conn)) {
 517             write_irssi("No connector name given");
 518             return;
 519         }
 520
 521         $conn = lc($conn);
 522
 523         if (exists($connconf->{$conn}->{'_immutable'})) {
 524             write_irssi("Connector cannot be modified");
 525             return;
 526         }
 527
 528         unless(defined($schema)) {
 529             write_irssi("No schema given");
 530             return;
 531         }
 532
 533         $schema = lc($schema);
 534
 535         unless(exists($connconf->{$conn})) {
 536             write_irssi("Connector does not exist");
 537             return;
 538         }
 539
 540         delete($connconf->{$conn}->{'schemas'}->{$schema});
 541     } elsif ($subcmd eq 'select') {
 542         my @connlist = map { lc } @_;
 543
 544         if (scalar(@connlist) == 0) {
 545             write_irssi("No connectors given");
 546             return;
 547         }
 548
 549         foreach (@connlist) {
 550             unless(exists($connconf->{$_})) {
 551                 write_irssi("Connector %s does not exist", $_);
 552                 return;
 553             }
 554         }
 555
 556         $conf->{'videosite'}->{'connectorlist'} = [ @connlist ];
 557     } else {
 558         write_irssi("connector [list|add|del|addschema|delschema|help] <options>");
 559         write_irssi(" help: Show this help");
 560         write_irssi(" list: List the defined connectors");
 561         write_irssi(" add <name>: Add a connector with name <name>");
 562         write_irssi(" del <name>: Delete the connector with name <name>");
 563         write_irssi(" addschema <name> <schema> <proxy>: Add proxy to connector for the given schema");
 564         write_irssi(" delschema <name> <schema>: Remove the schema from the connector");
 565         write_irssi(" select <name> [<name>...]: Select the connectors to use");
 566     }
 567 }
 568
 569
 570
 571
 572 # save on unload
 573 sub sig_command_script_unload {
 574     my $script = shift;
 575     if ($script =~ /(.*\/)?videosite(\.pl)?$/) {
 576         cmd_save();
 577     }
 578 }
 579
 580 sub ploader {
 581
 582     my $dir = shift;
 583     my $pattern = shift;
 584     my $type = shift;
 585     my @list;
 586     my $p;
 587     my $g;
 588     my @g = ();
 589
 590     opendir(D, $dir) || return ();
 591     @list = grep {/$pattern/ && -f File::Spec->catfile($dir, $_) } readdir(D);
 592     closedir(D);
 593
 594     foreach $p (@list) {
 595         write_debug("Trying to load $p:");
 596         $p =~ s/\.pm$//;
 597         eval qq{ require videosite::$p; };
 598         if ($@) {
 599             write_irssi("Failed to load plugin: $@");
 600             next;
 601         }
 602
 603         $g = eval qq{ videosite::$p->new(); };
 604         if ($@) {
 605             write_irssi("Failed to instanciate: $@");
 606             delete($INC{$p});
 607             next;
 608         }
 609
 610         write_debug("found $g->{'TYPE'} $g->{'NAME'}");
 611         if ($type eq $g->{'TYPE'}) {
 612             push(@g, $g);
 613             $g->setio(\&write_irssi);
 614             $g->setconn(\&connectorlist);
 615         } else {
 616             write_irssi('%s has wrong type (got %s, expected %s)', $p, $g->{'TYPE'}, $type);
 617             delete($INC{$p});
 618         }
 619     }
 620
 621     write_debug("Loaded %d plugins", $#g+1);
 622
 623     return @g;
 624 }
 625
 626 sub _load_modules($) {
 627
 628     my $path = shift;
 629
 630     foreach (keys(%INC)) {
 631         if ($INC{$_} =~ m|^$path|) {
 632             write_debug("Removing %s from \$INC", $_);
 633             delete($INC{$_});
 634         }
 635     }
 636     @grabbers = ploader($path, '.*Grabber\.pm$', 'grabber');
 637     @getters = ploader($path, '.*Getter\.pm$', 'getter');
 638 }
 639
 640
 641 sub init_videosite {
 642
 643     my $bindings = shift;
 644     my $p;
 645
 646     if (-r $conffile) {
 647         write_debug("Attempting JSON config load from %s", $conffile);
 648         eval {
 649             local $/;
 650             open(CONF, '<', $conffile);
 651             $conf = JSON->new->utf8->decode(<CONF>);
 652             close(CONF);
 653         };
 654     } elsif (-r $xmlconffile) {
 655         write_debug("Attempting XML config load from %s", $xmlconffile);
 656         $conf = XML::Simple::XMLin($xmlconffile, ForceArray => ['config', 'option', 'connectorlist'], KeepRoot => 1, KeyAttr => {'connector' => '+name', 'config' => 'module', 'option' => 'key'});
 657     }
 658
 659     unless(defined($conf)) {
 660         # No config, start with an empty one
 661         write_debug('No config found, using defaults');
 662         $conf = { 'videosite' => { }};
 663     }
 664
 665     foreach (keys(%{$PARAMS})) {
 666         unless (exists($conf->{'videosite'}->{$_})) {
 667             $conf->{'videosite'}->{$_} = $PARAMS->{$_};
 668         }
 669     }
 670
 671     # Make sure there is a connector called 'direct', which defines no
 672     # proxies
 673     unless (exists($conf->{'videosite'}->{'connectors'}->{'direct'})) {
 674         $conf->{'videosite'}->{'connectors'}->{'direct'} = {
 675                 'name' => 'direct',
 676                 '_immutable' => '1',
 677                 'schemas' => {},
 678         };
 679     }
 680
 681     _load_modules($plugindir);
 682
 683     unless (defined(@grabbers) && defined(@getters)) {
 684         write_irssi('No grabbers or no getters found, can not proceed.');
 685         return;
 686     }
 687
 688     $getter = $getters[0];
 689     foreach $p (@getters) {
 690         if ($conf->{'videosite'}->{'getter'} eq $p->{'NAME'}) {
 691             $getter = $p;
 692         }
 693     }
 694     write_debug('Selected %s as getter', $getter->{'NAME'});
 695     $conf->{'videosite'}->{'getter'} = $getter->{'NAME'};
 696
 697     # Loop through all plugins and load the config
 698     foreach $p (@grabbers, @getters) {
 699         $conf->{'videosite'}->{'config'}->{$p->{'NAME'}} = $p->mergeconfig($conf->{'videosite'}->{'config'}->{$p->{'NAME'}});
 700     }
 701
 702     if ($bindings) {
 703
 704         Irssi::signal_add_first('command script load', 'sig_command_script_unload');
 705         Irssi::signal_add_first('command script unload', 'sig_command_script_unload');
 706         Irssi::signal_add('setup saved', 'cmd_save');
 707
 708
 709         Irssi::command_bind(_bcb('videosite' => \&cmdhandler));
 710     }
 711
 712     write_irssi('initialized successfully');
 713 }
 714
 715 sub sig_complete {
 716     my ($complist, $window, $word, $linestart, $want_space) = @_;
 717     my @matches;
 718
 719     if ($linestart !~ m|^/videosite\b|) {
 720         return;
 721     }
 722
 723     if ('/videosite' eq $linestart) {
 724         # No command enterd so far. Produce a list of possible follow-ups
 725         @matches = grep {/^$word/} keys (%{$videosite_commands});
 726     } elsif ('/videosite set' eq $linestart) {
 727         # 'set' command entered. Produce a list of modules
 728         foreach (@grabbers, @getters) {
 729             push(@matches, $_->{'NAME'}) if $_->{'NAME'} =~ m|^$word|;
 730         };
 731     } elsif ($linestart =~ m|^/videosite set (\w+)$|) {
 732         my $module = $1;
 733
 734         foreach my $p (@getters, @grabbers) {
 735             if ($p->{'NAME'} eq $module) {
 736                 @matches = $p->getparamlist($word);
 737                 last;
 738             }
 739         }
 740     } elsif ($linestart =~ m|/videosite set (\w+) (\w+)$|) {
 741         my $module = $1;
 742         my $param = $2;
 743
 744         foreach my $p (@getters, @grabbers) {
 745             if ($p->{'NAME'} eq $module) {
 746                 @matches = $p->getparamvalues($param, $word);
 747                 last;
 748             }
 749         }
 750     }
 751
 752
 753     push(@{$complist}, sort @matches);
 754     ${$want_space} = 0;
 755
 756     Irssi::signal_stop();
 757 }
 758
 759 # =================================
 760 # Reworked code below this line
 761 # =================================
 762
 763 #
 764 # Initialize the config subsystem. Called by the core.
 765 #
 766 # Due to historic reasons this has to deal with a number of possible config sources:
 767 # * irssi internal config
 768 # * JSON config, old format
 769 # * XML config, old format
 770 #
 771 # JSON and XML configs are parsed, converted and moved to the irssi internal
 772 # format. This happens only once, as the config search stops with the first
 773 # format found
 774 #
 775 sub config_init {
 776     my $xmlconffile = File::Spec->catfile(Irssi::get_irssi_dir(), 'videosite.xml');
 777     my $conffile = File::Spec->catfile(Irssi::get_irssi_dir(), 'videosite.json');
 778     my $conf;
 779
 780     # Check for irssi internal config. If not found...
 781     if (config_has(['config-version'])) {
 782         # Configuration in irssi config file. We're done.
 783         return;
 784     }
 785
 786     # Try to find old config files and load them.
 787     if (-r $conffile) {
 788         eval {
 789             local $/;
 790             open(CONF, '<', $conffile);
 791             $conf = JSON->new->utf8->decode(<CONF>);
 792             close(CONF);
 793         };
 794     } elsif (-r $xmlconffile) {
 795         $conf = XML::Simple::XMLin($xmlconffile, ForceArray => ['config', 'option', 'connectorlist'], KeepRoot => 1, KeyAttr => {'connector' => '+name', 'config' => 'module', 'option' => 'key'});
 796     }
 797
 798     #
 799     # Configuration conversion:
 800     # Replace this structure:
 801     #
 802     # key => {
 803     #   content => value
 804     # }
 805     #
 806     # by this structure
 807     #
 808     # key => value
 809     #
 810     Irssi::print("Converting configuration, stage 1");
 811
 812     # Only the getter/grabbers have this, so just check that part of the config
 813     foreach my $g (keys(%{$conf->{videosite}->{config}})) {
 814         foreach (keys(%{$conf->{videosite}->{config}->{$g}->{option}})) {
 815             if (exists($conf->{videosite}->{config}->{$g}->{option}->{$_}->{content})) {
 816                 $conf->{videosite}->{config}->{$g}->{option}->{$_} = $conf->{videosite}->{config}->{$g}->{option}->{$_}->{content};
 817             }
 818         }
 819     }
 820
 821     #
 822     # Walk the configuration hash, creating irssi config entries for
 823     # each leaf node.
 824     #
 825     # Some config values changed, so not the entire config is copied over.
 826     # There is a helper function for this in libvideosite that we're using.
 827     #
 828     Irssi::print("Converting configuration, stage 2");
 829
 830     # Copy the "basic" settings.
 831     foreach (qw(getter mode)) {
 832         config_set(['getter'], $conf->{videosite}->{$_});
 833     }
 834
 835     # Copy the per-getter/setter settings
 836     foreach my $g (keys(%{$conf->{videosite}->{config}})) {
 837         foreach (keys(%{$conf->{videosite}->{config}->{$g}->{option}})) {
 838             config_set(['plugin', $g, $_], $conf->{videosite}->{config}->{$g}->{option}->{$_});
 839         }
 840     }
 841
 842     # Copy the connectors. The connectors themselves are copied as-is,
 843     # the list of active connectors is copied under a different name,
 844     # and a list of all existing connectors is created
 845     my @connectors;
 846
 847     foreach my $c (keys(%{$conf->{videosite}->{connectors}})) {
 848         push(@connectors, $c);
 849         config_set(['connectors', $c, 'name'], $conf->{videosite}->{connectors}->{$c}->{name});
 850         if (exists($conf->{videosite}->{connectors}->{$c}->{_immutable})) {
 851             config_set(['connectors', $c, '_immutable'], $conf->{videosite}->{connectors}->{$c}->{_immutable});
 852         }
 853         foreach (qw(http https)) {
 854             if (exists($conf->{videosite}->{connectors}->{$c}->{schemas}->{http})) {
 855                 config_set(['connectors', $c, 'schemas', $_], $conf->{videosite}->{connectors}->{$c}->{schemas_}->{$_});
 856             }
 857         }
 858     }
 859     config_set(['active-connectors'], join(",", @{$conf->{connectorlist}}));
 860     config_set(['defined-connectors'], join(",", @connectors));
 861     config_set(['config-version'], '2');
 862 }
 863
 864 #
 865 # Reading a configuration value. Called by the core
 866 #
 867 sub config_get {
 868     my $path = shift;
 869     my $item = join('.', 'videosite', @{$path});
 870     my $val;
 871
 872
 873     Irssi::settings_add_str('videosite', $item, "\0");
 874     $val = Irssi::settigs_get_str($item);
 875
 876     return ($val ne "\0")?$val:undef;
 877 }
 878
 879 #
 880 # Returns a true value if the config item exists
 881 #
 882 sub config_has {
 883     my $path = shift;
 884     my $item = join('.', 'videosite', @{$path});
 885
 886     Irssi::settings_add_str('videosite', $item, "\0");
 887     return Irssi::settings_get_str ne "\0";
 888 }
 889
 890 #
 891 # Setting a configuration value. Called by the core
 892 #
 893 sub config_set {
 894     my $path = shift;
 895     my $value = shift;
 896     my $item = join('.', 'videosite', @{$path});
 897
 898     Irssi::settings_add_str('videosite', $item, "\0");
 899     Irssi::settings_set_str($item, $value);
 900 }
 901
 902 #
 903 # Delete a configuration value. Called by the core.
 904 #
 905 sub config_del {
 906     my $path = shift;
 907     my $item = join('.', 'videosite', @{$path});
 908
 909     Irssi::settings_remove($item);
 910 }
 911
 912 #
 913 # Return a color code. Called by the core
 914 #
 915 sub colorpair {
 916     my ($fg, $bg) = @_;
 917
 918     Irssi::print(sprintf("Asked to convert (%s,%s) into irssi color codes", $fg, $bg));o
 919
 920     return '';
 921 }
 922
 923 #
 924 # Handle commands (/videosite ...)
 925 #
 926 sub videosite_hook {
 927     my ($cmdline, $server, $witem) = @_;
 928     my %event = (
 929         message => $cmdline,
 930         ewpf => sub { defined($evitem)?$evitem->print(@_):Irssi::print(@_) },
 931     );
 932
 933     libvideosite::handle_command(\%event);
 934 }
 935
 936 #
 937 # Handle a received message
 938 # Create an event structure and hand it off to libvideosite
 939 #
 940 sub message_hook {
 941     my ($server, $msg, $nick, $userhost, $channel) = @_;
 942     my $evitem = $server->window_item_find($channel);
 943     my %event = (
 944         message => $msg,
 945         ewpf => sub { defined($evitem)?$evitem->print(@_):Irssi::print(@_) },
 946     );
 947
 948     libvideosite::check_for_link(\%event);
 949 }
 950
 951 sub videosite_reset {
 952     unless(libvideosite::register_api({
 953         io => sub { Irssi::print(@_) },
 954         config_init => \&config_init,
 955         config_get =>  \&config_get,
 956         config_set => \&config_set,
 957         config_has => \&config_has,
 958         config_save => \&config_save,
 959         config_del => \&config_del,
 960         color => \&colorpair,
 961         module_path => sub { return File::Spec->catfile(Irssi::get_irssi_dir(), 'scripts') },
 962         quote => sub { s/%/%%/g; return $_ },
 963         _debug => sub { 1 },
 964     })) {
 965         Irssi::print(sprintf("videosite API register failed: %s", $libvideosite::error));
 966         return 0;
 967     }
 968
 969     unless(libvideosite::init()) {
 970         Irssi::print(sprintf("videosite init failed: %s", $libvideosite::error));
 971         return 0;
 972     }
 973
 974     return 1;
 975 }
 976
 977 sub videosite_init {
 978     # Find out the script directory, and add it to @INC.
 979     # This is necessary to find libvideosite.pm
 980
 981     push(@INC, File::Spec->catfile(Irssi::get_irssi_dir(), 'scripts'));
 982     load 'libvideosite';
 983
 984     unless (videosite_reset()) {
 985         signal_add_last("message public", sub { message_hook(@_) });
 986         signal_add_last("message own_public", sub { message_hook($_[0], $_[1], undef, undef, $_[2]) });
 987         signal_add_last("message private", sub { message_hooK($_[0], $_[1], $_[2], $_[3], $_[2]) });
 988         signal_add_last("message own_private", sub { message_hook($_[0], $_[1], undef, undef, $_[2]) });
 989         signal_add_last("message irc action", sub { message_hook(@_) });
 990         signal_add_last("message irc own_action", sub { message_hook($_[0], $_[1], undef, undef, $_[2]) });
 991
 992         Irssi::command_bind('videosite', sub { videosite_hook(@_) });
 993     }
 994 }
 995
 996 videosite_init();