libvideosite.pm

   1 package libvideosite;
   2 require Exporter;
   3
   4 use vars qw(@ISA @EXPORT_OK);
   5 use File::Spec;
   6 use Module::Load;
   7 use LWP::UserAgent;
   8 use Data::Dumper;
   9 use File::Basename;
  10 use Cwd qw(realpath);
  11 use strict;
  12
  13 @ISA = qw(Exporter);
  14 @EXPORT_OK = qw(init register_api check_for_link);
  15
  16 my @outputstack;
  17 my $outputprefix;
  18 my $debug = 0;
  19 my @grabbers;
  20 my @getters;
  21 my $getter;
  22 my %builtin_config = ();
  23 our $error;
  24
  25 #
  26 # The default config. These values will be set in the config
  27 # if they do not exist already.
  28 #
  29 my $defaultconfig = {
  30     'getter' => 'filegetter',
  31     'mode' => 'download',
  32     'active-connectors' => 'direct',
  33     'defined-connectors' => 'direct',
  34     'connectors' => {
  35         'direct' => {
  36             'name' => 'direct',
  37             '_immutable' => '1',
  38             'schemas' => {},
  39         }
  40     }
  41 };
  42
  43 #
  44 # List of known commands and handlers
  45 #
  46 my $videosite_commands = {
  47     'save' => sub {
  48         _cmd_save();
  49     },
  50
  51     'set' => sub {
  52         _cmd_set(@_);
  53     },
  54
  55     'show' => sub {
  56         _cmd_show(@_);
  57     },
  58
  59     'help' => sub {
  60         _cmd_help(@_);
  61     },
  62
  63     'getter' => sub {
  64         _cmd_getter(@_);
  65     },
  66
  67     'enable' => sub {
  68         _cmd_enable(@_);
  69     },
  70
  71     'disable' => sub {
  72         _cmd_disable(@_);
  73     },
  74
  75     'reload' => sub {
  76         init();
  77     },
  78
  79     'mode' => sub {
  80         _cmd_mode(@_);
  81     },
  82
  83     'connector' => sub {
  84         _cmd_connector(@_);
  85     },
  86
  87     'debug' => sub {
  88         $debug = 1;
  89         foreach (@grabbers, @getters) {
  90             $_->setdebug(1);
  91         }
  92         _io('Enabled debugging');
  93     },
  94
  95     'nodebug' => sub {
  96         $debug = 0;
  97         foreach (@grabbers, @getters) {
  98             $_->setdebug(0);
  99         }
 100         _io('Disabled debugging');
 101     },
 102 };
 103
 104 #
 105 # This is a list of default values for the remote API. These
 106 # are used if the values are not registered by the library user.
 107 #
 108 my $remote_api = {
 109     io => sub { print @_, "\n" },
 110     config_init => \&_builtin_config_init,
 111     config_get => \&_builtin_config_get,
 112     config_set => \&_builtin_config_set,
 113     config_has => \&_builtin_config_has,
 114     config_save => \&_builtin_config_save,
 115     config_del => \&_builtin_config_del,
 116     color => sub { return '' },
 117     module_path => sub { return dirname(realpath($0)) },
 118     quote => sub { return $_ },
 119 };
 120
 121 #
 122 # Output a string on the client.
 123 # Works like (s)printf in that it takes a format string and a list of
 124 # values to be replaced. Undefined values will be printed as '(undef)'
 125 #
 126 # All parameters (except for the format string itself) will be quoted
 127 # using the client specific quote function
 128 #
 129 sub _io {
 130     my @text = @_;
 131     my $format;
 132
 133     @text = ('') unless(@text);
 134
 135     # This will define the outputprefix once, so we don't have
 136     # do do this every time.
 137     $outputprefix = sprintf("%svideosite: %s",
 138         $remote_api->{color}->('magenta'),
 139         $remote_api->{color}->()) unless(defined($outputprefix));
 140     $format = $outputprefix . shift(@text);
 141
 142     #
 143     # The format string is assumed to be appropriately quoted.
 144     # Quote the rest of the text, replacing undefined strings by (undef)
 145     #
 146     @text = map { defined($_)?$remote_api->{quote}->($_):'(undef)' } @text;
 147
 148     $outputstack[0]->(sprintf($format, @text));
 149 }
 150
 151 #
 152 # Recursively walk through a hash-of-hashes, calling the given function
 153 # for each found leaf with the path to the leaf
 154 #
 155 sub _recursive_hash_walk {
 156     my $hash = shift;
 157     my $callback = shift;
 158     my @path = @_;
 159
 160     foreach (keys(%{$hash})) {
 161         if (ref($hash->{$_}) eq 'HASH') {
 162             _recursive_hash_walk($hash->{$_}, $callback, @path, $_);
 163         } else {
 164             $callback->([@path, $_], $hash->{$_});
 165         }
 166     }
 167 }
 168
 169 #
 170 # Return the color code for the given foreground/background color
 171 # pair. Both can be undef, which means "default"
 172 #
 173 sub _colorpair {
 174     my ($fg, $bg) = @_;
 175
 176     return $remote_api->{color}->($fg, $bg);
 177 }
 178
 179 #
 180 # Sets the given config item if it is not set already
 181 #
 182 sub _init_config_item {
 183     my $path = shift;
 184     my $value = shift;
 185
 186     unless($remote_api->{config_has}->($path)) {
 187         $remote_api->{config_set}->($path, $value);
 188     }
 189 }
 190
 191 #
 192 # Print a message if debug is enabled
 193 #
 194 sub _debug {
 195     if ($debug) {
 196         _io(@_);
 197     }
 198 }
 199
 200 #
 201 # Load a list of modules matching a pattern from a given directory.
 202 #
 203 sub _ploader {
 204
 205     my $dir = shift;
 206     my $pattern = shift;
 207     my $type = shift;
 208     my @list;
 209     my $p;
 210     my $g;
 211     my @g = ();
 212
 213     opendir(D, $dir) || return ();
 214     @list = grep {/$pattern/ && -f File::Spec->catfile($dir, $_) } readdir(D);
 215     closedir(D);
 216
 217     foreach $p (@list) {
 218         _debug("Trying to load $p:");
 219         $p =~ s/\.pm$//;
 220         eval {
 221             load "videosite::$p";
 222         };
 223         if ($@) {
 224             _io("Failed to load plugin: $@");
 225             next;
 226         }
 227
 228         eval {
 229             $g = "videosite::$p"->new();
 230         };
 231         if ($@) {
 232             _io("Failed to instanciate: $@");
 233             delete($INC{$p});
 234             next;
 235         }
 236
 237         _debug("found $g->{'TYPE'} $g->{'NAME'}");
 238         if ($type eq $g->{'TYPE'}) {
 239             push(@g, $g);
 240             $g->register_api({
 241                 io => \&_io,
 242                 connectors => sub { return _connectorlist('active-connectors') },
 243                 config_get => \&_config_get,
 244                 config_set => \&_config_set,
 245                 config_has => \&_config_has,
 246             });
 247             $g->setdebug($debug);
 248         } else {
 249             _io('%s has wrong type (got %s, expected %s)', $p, $g->{'TYPE'}, $type);
 250             delete($INC{$p});
 251         }
 252     }
 253
 254     _debug("Loaded %d plugins", $#g+1);
 255
 256     return @g;
 257 }
 258
 259 #
 260 # Populate the @grabbers and @getters lists from the given
 261 # directory
 262 #
 263 sub _load_modules($) {
 264
 265     my $path = shift;
 266
 267     foreach (keys(%INC)) {
 268         if ($INC{$_} =~ m|^$path|) {
 269             _debug("Removing %s from \$INC", $_);
 270             delete($INC{$_});
 271         }
 272     }
 273     @grabbers = _ploader($path, '.*Grabber\.pm$', 'grabber');
 274     @getters = _ploader($path, '.*Getter\.pm$', 'getter');
 275 }
 276
 277 #
 278 # Wrapper functions for config management to put in
 279 # debugging
 280 #
 281 sub _config_get {
 282     my $path = shift;
 283     my $value;
 284
 285     $value = $remote_api->{config_get}->($path);
 286     _debug("config: getting %s=%s", join('.', @{$path}), $value);
 287
 288     return $value;
 289 }
 290
 291 sub _config_set {
 292     my $path = shift;
 293     my $value = shift;
 294
 295     _debug("config: setting %s=%s", join('.', @{$path}), $value);
 296     return $remote_api->{config_set}->($path, $value);
 297 }
 298
 299 sub _config_has {
 300     my $path = shift;
 301     my $b;
 302
 303     $b = $remote_api->{config_has}->($path);
 304     _debug("config: testing %s (%s)", join('.', @{$path}), $b?'true':'false');
 305
 306     return $b;
 307 }
 308
 309 #
 310 # The _config_list_* are helper functions taking a path to a comma separated
 311 # string. The string is interpreted as a list and the action performed
 312 # on it, storing back the modified version
 313 #
 314
 315 #
 316 # Add an item to the list, checking for duplicates
 317 #
 318 sub _config_list_add {
 319     my $path = shift;
 320     my $item = shift;
 321     my @c;
 322
 323     if (_config_has($path)) {
 324         @c = split(/\s*,\s*/, _config_get($path));
 325     } else {
 326         @c = ();
 327     }
 328
 329     _debug("Adding %s to list %s", $item, join(".", $path));
 330     unless(grep { $_ eq $item } @c) {
 331         push(@c, $item);
 332     };
 333
 334     _config_set($path, join(',', @c));
 335 }
 336
 337 #
 338 # Remove an item from the list
 339 #
 340 sub _config_list_del {
 341     my $path = shift;
 342     my $item = shift;
 343     my @c;
 344
 345     unless(_config_has($path)) {
 346         return;
 347     }
 348
 349     _debug("Removing %s from list %s", $item, join('.', $path));
 350     @c = map { $item ne $_ } split(/\s*,\s*/, _config_get($path));
 351
 352     _config_set($path, join('.', @c));
 353 }
 354
 355 #
 356 # Return true if the item contains the given list, false otherwise
 357 #
 358 sub _config_list_has {
 359     my $path = shift;
 360     my $item = shift;
 361
 362     unless(_config_has($path)) {
 363         return 0;
 364     }
 365
 366     _debug("Checking for %s in list %s",  $item, join('.', $path));
 367
 368     return grep { $item eq $_ } split(/\s*,\s*/, _config_get($path));
 369 }
 370
 371 #
 372 # Replace a list with the given items
 373 #
 374 sub _config_list_set {
 375     my $path = shift;
 376
 377     _debug("Replacing %s with (%s)", join('.', $path), join(",", @_));
 378
 379     _config_set($path, join(',', @_));
 380 }
 381
 382 #
 383 # Return the list of currently active connectors, in the configured
 384 # order
 385 #
 386 sub _connectorlist {
 387     my $key = shift;
 388     my @c;
 389
 390     foreach(split(/,/, _config_get([$key]))) {
 391         push(@c, _unserialize_connector_hash($_));
 392     }
 393
 394     return @c;
 395 }
 396
 397 #
 398 # Convert a connector hash from it's config structure back to a perl
 399 # hash
 400 #
 401 sub _unserialize_connector_hash {
 402     my $name = shift;
 403     my $connector = {};
 404
 405     if (_config_has(['connectors', $name, 'name'])) {
 406         $connector->{name} = _config_get(['connectors', $name, 'name']);
 407         $connector->{schemas} = {};
 408         foreach ('http', 'https') {
 409             if (_config_has(['connectors', $name, 'schemas', $_])) {
 410                 $connector->{schemas}->{$_} = _config_get(['connectors', $name, 'schemas', $_]);
 411             }
 412         }
 413     }
 414
 415     _debug("Returning connector %s: %s", $name, Dumper($connector));
 416
 417     return $connector;
 418 }
 419
 420 #
 421 # Push a new output function on the IO stack.
 422 #
 423 sub _push_output {
 424     unshift(@outputstack, shift);
 425 }
 426
 427 #
 428 # Pop the topmost output function from the stack, leaving
 429 # at least one function on it.
 430 #
 431 sub _pop_output {
 432     if (scalar(@outputstack) > 0) {
 433         shift(@outputstack);
 434     }
 435 }
 436
 437 #
 438 # Takes a string and replaces commonly used URL shorteners recursively,
 439 # up to 10 levels deep
 440 #
 441 sub _expand_url_shortener {
 442     my $s = shift;
 443     my $os = '';
 444     my @urlshortener = (
 445         'is\.gd/[[:alnum:]]+',
 446         'otf\.me/[[:alnum:]]+',
 447         'hel\.me/[[:alnum:]]+',
 448         '7ax\.de/[[:alnum:]]+',
 449         'ow\.ly/[[:alnum:]]+',
 450         'j\.mp/[[:alnum:]]+',
 451         'bit\.ly/[[:alnum:]]+',
 452         'tinyurl\.com/[[:alnum:]]+',
 453         'pop\.is/[[:alnum:]]+',
 454         'post\.ly/[[:alnum:]]+',
 455         '1\.ly/[[:alnum:]]+',
 456         '2\.ly/[[:alnum:]]+',
 457         't\.co/[[:alnum:]]+',
 458         'shar\.es/[[:alnum:]]+',
 459         'goo\.gl/[[:alnum:]]+',
 460         );
 461     my $ua = LWP::UserAgent->new(agent => 'Mozilla', max_redirect => 0, timeout => 5);
 462     my $i = 10;
 463
 464     OUTER: while (($os ne $s) and ($i > 0)) {
 465         study($s);
 466         $os = $s;
 467         $i--;
 468
 469         foreach my $pattern (@urlshortener) {
 470             my $p = "https?:\/\/" . $pattern;
 471
 472             _debug("Matching %s against %s", $p, $s);
 473             if ($s =~ m|($p)|) {
 474                 my $matched = $1;
 475                 my $res;
 476
 477                 _debug("Found %s", $matched);
 478                 $res = $ua->head($matched);
 479                 if ($res->is_redirect()) {
 480                     my $new = $res->headers()->header("Location");
 481
 482                     _debug("Replacing %s with %s", $matched, $new);
 483                     $s =~ s/$matched/$new/;
 484                     next OUTER;
 485                 } else {
 486                     _debug("Error resolving %s", $matched);
 487                 }
 488             }
 489         }
 490     }
 491
 492     if ($i == 0) {
 493         _debug("Loop terminated by counter");
 494     }
 495
 496     _debug("Final string: %s", $s);
 497
 498     return $s;
 499 }
 500
 501 #
 502 # Save the config to durable storage
 503 #
 504 sub _cmd_save {
 505     $remote_api->{config_save}->();
 506 }
 507
 508 #
 509 # Set a configuration element
 510 #
 511 sub _cmd_set {
 512     my $target = shift;
 513     my $key = shift;
 514     my $val = shift;
 515     my $p;
 516
 517     foreach $p (@getters, @grabbers) {
 518         if ($p->{'NAME'} eq $target) {
 519             $p->setval($key, $val);
 520             return;
 521         }
 522     }
 523     _io('No such module');
 524 }
 525
 526
 527 #
 528 # Enable a given module
 529 #
 530 sub _cmd_enable {
 531     my $target = shift;
 532     my $p;
 533
 534     foreach $p (@grabbers) {
 535         if ($p->{'NAME'} eq $target) {
 536             $p->enable();
 537             return;
 538         }
 539     }
 540     _io('No such module');
 541 }
 542
 543 #
 544 # Disable given module
 545 #
 546 sub _cmd_disable {
 547     my $target = shift;
 548     my $p;
 549
 550     foreach $p (@grabbers) {
 551         if ($p->{'NAME'} eq $target) {
 552             $p->disable();
 553             return;
 554         }
 555     }
 556     _io('No such module');
 557 }
 558
 559 #
 560 # Show settings for modules
 561 #
 562 sub _cmd_show {
 563     my $target = shift;
 564     my $p;
 565     my $e;
 566
 567     if (defined($target)) {
 568         foreach $p (@getters, @grabbers) {
 569             if ($p->{'NAME'} eq $target) {
 570                 _io($p->getconfstr());
 571                 return;
 572             }
 573         }
 574         _io('No such module');
 575     } else {
 576         _io('Loaded grabbers (* denotes enabled modules):');
 577         foreach $p (@grabbers) {
 578             $e = $p->_getval('enabled');
 579             _io(' %s%s', $p->{'NAME'}, $e?'*':'');
 580         };
 581
 582         _io('Loaded getters:');
 583         foreach $p (@getters) {
 584             _io(' %s', $p->{'NAME'});
 585         };
 586     }
 587 }
 588
 589 #
 590 # Show help for the commands
 591 #
 592 sub _cmd_help {
 593     my $target = shift;
 594     my $p;
 595
 596     if (defined($target)) {
 597         foreach $p (@getters, @grabbers) {
 598             if ($p->{'NAME'} eq $target) {
 599                 _io($p->gethelpstr());
 600                 return;
 601             }
 602         }
 603         _io('No such module');
 604     } else {
 605         _io(<<'EOT');
 606 Supported commands:
 607  save: save the current configuration
 608  help [modulename]: display this help, or module specific help
 609  show [modulename]: show loaded modules, or the current parameters of a module
 610  set modulename parameter value: set a module parameter to a new value
 611  getter [modulename]: display or set the getter to use
 612  enable [modulename]: enable the usage of this module (grabbers only)
 613  disable [modulename]: disable the usage of this module (grabbers only)
 614  reload: reload all modules (this is somewhat experimental)
 615  mode [modename]: display or set the operation mode (download/display)
 616  connector [subcommand]: manage connectors (proxies)
 617  debug: enable debugging messages
 618  nodebug: disable debugging messages
 619 EOT
 620     }
 621 }
 622
 623 #
 624 # Set the getter to use
 625 #
 626 sub _cmd_getter {
 627     my $target = shift;
 628     my $p;
 629
 630     if (defined($target)) {
 631         foreach $p (@getters) {
 632             if ($p->{'NAME'} eq $target) {
 633                 $getter = $p;
 634                 _config_set(['getter'], $target);
 635                 _io("Getter changed to %s", $target);
 636                 return;
 637             }
 638         }
 639         _io('No such getter');
 640     } else {
 641         _io('Current getter: %s', _config_get(['getter']));
 642     }
 643 }
 644
 645 #
 646 # Show/set the working mode
 647 #
 648 sub _cmd_mode {
 649     my $mode = shift;
 650
 651     if (defined($mode)) {
 652         $mode = lc($mode);
 653         if (('download' eq $mode) or ('display' eq $mode)) {
 654             _config_set(['mode'], $mode);
 655             _io('Now using %s mode', $mode);
 656         } else {
 657             _io('Invalid mode: %s', $mode);
 658         }
 659     } else {
 660         _io('Current mode: %s', _config_get(['mode']));
 661     }
 662 }
 663
 664
 665 #
 666 # Manage the connectors
 667 #
 668 sub _cmd_connector {
 669     my $subcmd = shift;
 670     my $c;
 671
 672     unless(defined($subcmd)) {
 673         $subcmd = "help";
 674     }
 675
 676     $subcmd = lc($subcmd);
 677
 678     if ($subcmd eq 'list') {
 679         _io("Defined connectors");
 680         foreach $c (_connectorlist('defined-connectors')) {
 681             _io($c->{name});
 682             my $schemas = $c->{schemas};
 683             if (scalar(keys(%{$schemas})) == 0) {
 684                 _io(" No schemas defined");
 685             } else {
 686                 foreach (keys(%{$schemas})) {
 687                     _io(' %s: %s', $_, $schemas->{$_});
 688                 }
 689             }
 690         }
 691
 692         _io();
 693         _io("Selected connectors: %s", _config_get(['active-connectors']));
 694     } elsif ($subcmd eq 'add') {
 695         my ($name) = @_;
 696
 697         unless(defined($name)) {
 698             _io("No name given");
 699             return;
 700         }
 701
 702         $name = lc($name);
 703
 704         if (_config_list_has(['defined-connectors'], $name)) {
 705             _io("Connector already exists");
 706             return;
 707         }
 708
 709         _config_set(['connectors', $name, 'name'], $name);
 710         _config_list_add(['defined-connectors'], $name);
 711     } elsif ($subcmd eq 'del') {
 712         my ($name) = @_;
 713         my @dcon;
 714
 715         unless(defined($name)) {
 716             _io("No name given");
 717             return;
 718         }
 719
 720         unless (_config_list_has(['defined-connectors'])) {
 721             _io("Connector does not exist");
 722             return;
 723         }
 724
 725         if (_config_has(['connectors', $name, '_immutable'])) {
 726             _io("Connector cannot be removed");
 727             return;
 728         }
 729
 730         # Remove from list of active connectors
 731         _config_list_del(['defined-connectors'], $name);
 732         _config_list_del(['active-connectors'], $name);
 733
 734         _config_del(['connectors', $name, 'name']);
 735         _config_del(['connectors', $name, '_immutable']);
 736         _config_del(['connectors', $name, 'schemas', 'http']);
 737         _config_del(['connectors', $name, 'schemas', 'https']);
 738
 739         @dcon = split(/,/, _config_get(['active-connectors']));
 740
 741         if (scalar(@dcon) == 0) {
 742             _io("List of selected connectors is empty, resetting to direct");
 743             _config_list_add(['active-connectors', 'direct']);
 744         }
 745     } elsif ($subcmd eq 'addschema') {
 746         my ($conn, $schema, $proxy) = @_;
 747
 748         unless(defined($conn)) {
 749             _io("No connector name given");
 750             return;
 751         }
 752
 753         unless(defined($schema)) {
 754             _io("No schema given");
 755             return;
 756         }
 757
 758         unless(defined($proxy)) {
 759             _io("No proxy given");
 760             return;
 761         }
 762
 763         $conn = lc($conn);
 764         unless(_config_list_has(['defined-connectors'], $conn)) {
 765             _io("Connector does not exist");
 766             return;
 767         }
 768
 769         if (_config_has(['connectors', $conn, '_immutable'])) {
 770             _io("Connector cannot be modified");
 771             return;
 772         }
 773
 774         $schema = lc($schema);
 775         _config_set(['connectors', $conn, 'schemas', $schema], $proxy);
 776     } elsif ($subcmd eq 'delschema') {
 777         my ($conn, $schema) = @_;
 778
 779         unless(defined($conn)) {
 780             _io("No connector name given");
 781             return;
 782         }
 783
 784         unless(defined($schema)) {
 785             _io("No schema given");
 786             return;
 787         }
 788
 789         $conn = lc($conn);
 790         unless(_config_list_has(['defined-connectors'], $conn)) {
 791             _io("Connector does not exist");
 792             return;
 793         }
 794
 795         $schema = lc($schema);
 796         _config_del(['connectors', $conn, 'schemas', $schema]);
 797     } elsif ($subcmd eq 'select') {
 798         my @connlist = map { lc } @_;
 799
 800         if (scalar(@connlist) == 0) {
 801             _io("No connectors given");
 802             return;
 803         }
 804
 805         foreach (@connlist) {
 806             unless(_config_list_has(['defined-connectors'], $_)) {
 807                 _io("Connector %s does not exist", $_);
 808                 return;
 809             }
 810         }
 811
 812         _config_list_set(['active-connectors'], @connlist);
 813     } else {
 814         _io("connector [list|add|del|addschema|delschema|help] <options>");
 815         _io(" help: Show this help");
 816         _io(" list: List the defined connectors");
 817         _io(" add <name>: Add a connector with name <name>");
 818         _io(" del <name>: Delete the connector with name <name>");
 819         _io(" addschema <name> <schema> <proxy>: Add proxy to connector for the given schema");
 820         _io(" delschema <name> <schema>: Remove the schema from the connector");
 821         _io(" select <name> [<name>...]: Select the connectors to use");
 822     }
 823 }
 824
 825 #
 826 # Return the list of loaded grabbers.
 827 # This is used by the test programs, and is not meant to be
 828 # used in general.
 829 #
 830 sub _grabbers {
 831     return @grabbers;
 832 }
 833
 834 #
 835 # ==============================================
 836 # Builtin config handling functions
 837 # These are used if the library used does not
 838 # register it's own config_* handlers
 839 # ==============================================
 840 #
 841 sub _builtin_config_init {
 842 }
 843
 844 sub _builtin_config_get {
 845     return $builtin_config{join(".", @{$_[0]})};
 846 }
 847
 848 sub _builtin_config_set {
 849     $builtin_config{join(".", @{$_[0]})} = $_[1];
 850 }
 851
 852 sub _builtin_config_has {
 853     return exists($builtin_config{join(".", @{$_[0]})});
 854 }
 855
 856 sub _builtin_config_save {
 857 }
 858
 859 sub _builtin_config_del {
 860     delete($builtin_config{join(".", @{$_[0]})});
 861 }
 862
 863 #
 864 # ==============================================
 865 # From this point on publicly callable functions
 866 # ==============================================
 867 #
 868
 869
 870 #
 871 # Initialization function for the library
 872 # Actually not the first thing to be called, it expects an API
 873 # has (register_api) to be registered first
 874 #
 875 sub init {
 876     unless($remote_api) {
 877         $error = "No API set";
 878         return 0;
 879     }
 880
 881     # Initialize configuration data
 882     $remote_api->{config_init}->();
 883
 884     # Check/create default values, if they do not exist
 885     _recursive_hash_walk($defaultconfig, \&_init_config_item);
 886
 887     # Load modules
 888     _load_modules(File::Spec->catfile($remote_api->{module_path}->(), 'videosite'));
 889
 890     unless (@grabbers && @getters) {
 891         _io('No grabbers or no getters found, can not proceed.');
 892         return 0;
 893     }
 894
 895     # Set the getter
 896     $getter = $getters[0];
 897     foreach my $p (@getters) {
 898         if (_config_get(['getter']) eq $p->{'NAME'}) {
 899             $getter = $p;
 900         }
 901     }
 902     _debug('Selected %s as getter', $getter->{'NAME'});
 903     _config_set(['getter'], $getter->{'NAME'});
 904
 905     # Done.
 906     _io('initialized successfully');
 907     return 1;
 908 }
 909
 910 #
 911 # Register a remote API. This API contains a basic output function (used
 912 # when no window specific function is available), some config functions
 913 # and a color code function.
 914 #
 915 sub register_api {
 916     my $a = shift;
 917     my @config_functions = qw(config_init config_set config_get config_has config_save config_del);
 918     my $c;
 919     my @missing;
 920
 921     unless(defined($a)) {
 922         die("No API given");
 923     }
 924
 925     #
 926     # The config_* handlers are special in that they either all have
 927     # provided by the user, or none. In the latter case builtin
 928     # handlers will be used, but the config will not persist.
 929     #
 930     $c = 0;
 931     foreach (@config_functions) {
 932         if (exists($a->{$_})) {
 933             $c++;
 934         } else {
 935             push(@missing, $_);
 936         }
 937     }
 938
 939     unless (($c == 0) or ($c == scalar(@config_functions))) {
 940         $error = sprintf("Missing config function: %s", $missing[0]);
 941         return 0;
 942     }
 943
 944     foreach (keys(%{$a})) {
 945         if (ref($a->{$_}) ne 'CODE') {
 946             $error = sprintf("API handler %s is not a subroutine reference", $_);
 947         }
 948         $remote_api->{$_} = $a->{$_};
 949     }
 950
 951     if (exists($a->{_debug})) {
 952         $debug = $a->{_debug}->();
 953     }
 954
 955     @outputstack = ($remote_api->{'io'});
 956
 957     return 1;
 958 }
 959
 960 #
 961 # Check a message for useable links
 962 #
 963 sub check_for_link {
 964     my $event = shift;
 965     my $message = $event->{message};
 966     my $g;
 967     my $m;
 968     my $p;
 969
 970
 971     # Look if we should ignore this line
 972     if ($message =~ m,(?:\s|^)/nosave(?:\s|$),) {
 973         return;
 974     }
 975
 976     _push_output($event->{ewpf});
 977     $message = _expand_url_shortener($message);
 978
 979     study($message);
 980
 981     # Offer the message to all Grabbers in turn
 982     GRABBER: foreach $g (@grabbers) {
 983         ($m, $p) = $g->get($message);
 984         while (defined($m)) {
 985             _debug('Metadata: %s', Dumper($m));
 986             if (exists($remote_api->{link_callback})) {
 987                 $remote_api->{link_callback}->($m);
 988             }
 989             if ('download' eq _config_get(['mode'])) {
 990                 _io(
 991                     sprintf('%s>>> %sSaving %s%%s%s %s%%s',
 992                         $remote_api->{color}->('*red'),
 993                         $remote_api->{color}->(),
 994                         $remote_api->{color}->('*yellow'),
 995                         $remote_api->{color}->(),
 996                         $remote_api->{color}->('*green'),
 997                     ),
 998                     $m->{'SOURCE'},
 999                     $m->{'TITLE'}
1000                 );
1001                 unless($getter->get($m)) {
1002                     _io(sprintf('%s>>> FAILED', $remote_api->{color}->('*red')));
1003                 }
1004             } elsif ('display' eq _config_get(['mode'])) {
1005                 _io(
1006                     sprintf('%s>>> %sSaw %s%%s%s %s%%s',
1007                         $remote_api->{color}->('*magenta'),
1008                         $remote_api->{color}->(),
1009                         $remote_api->{color}->('*yellow'),
1010                         $remote_api->{color}->(),
1011                         $remote_api->{color}->('*green')
1012                     ),
1013                     $m->{'SOURCE'},
1014                     $m->{'TITLE'}
1015                 );
1016             } else {
1017                 _io(sprintf('%s>>> Invalid operation mode', $remote_api->{color}->('*red')));
1018             }
1019
1020             # Remove the matched part from the message and try again (there may be
1021             # more!)
1022             $message =~ s/$p//;
1023             study($message);
1024             last GRABBER if ($message =~ /^\s*$/);
1025
1026             ($m, $p) = $g->get($message);
1027         }
1028     }
1029
1030     _pop_output();
1031 }
1032
1033 #
1034 # Handle a videosite command (/videosite ...) entered in the client
1035 #
1036 sub handle_command {
1037     my $event = shift;
1038     my ($cmd, @params) = split(/\s+/, $event->{message});
1039
1040     _push_output($event->{ewpf});
1041
1042     if (exists($videosite_commands->{$cmd})) {
1043         $videosite_commands->{$cmd}->(@params);
1044     }
1045
1046     _pop_output();
1047 }
1048
1049 1;