1 # autodownload flash videos
3 # (c) 2007-2008 by Ralf Ertzinger <ralf@camperquake.de>
4 # licensed under GNU GPL v2
6 # Based on youtube.pl by Christian Garbs <mitch@cgarbs.de>
8 # based on trigger.pl by Wouter Coekaerts <wouter@coekaerts.be>
11 use Irssi 20020324 qw (command_bind command_runsub signal_add_first signal_add_last);
12 use vars qw($VERSION %IRSSI);
15 use File::Temp qw(tempfile);
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);
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(@_)}));
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(@_)}));
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(@_)}));
43 # This does not use BettIrssi (yet)
44 signal_add_first('complete word', \&sig_complete);
47 unshift(@outputstack, shift);
53 @outputstack = (undef) unless (@outputstack);
56 my $videosite_commands = {
99 foreach (@grabbers, @getters) {
102 write_irssi('Enabled debugging');
107 foreach (@grabbers, @getters) {
110 write_irssi('Disabled debugging');
116 my $output = $outputstack[0];
118 my $format = "%%mvideosite: %%n" . shift(@text);
120 # escape % in parameters from irssi
121 s/%/%%/g foreach @text;
123 if (defined $output) {
124 $output->(sprintf($format, @text), MSGLEVEL_CLIENTCRAP);
126 Irssi::print(sprintf($format, @text));
137 sub expand_url_shortener {
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:]]+',
157 my $ua = LWP::UserAgent->new(agent => 'Mozilla', max_redirect => 0, timeout => 5);
160 OUTER: while (($os ne $s) and ($i > 0)) {
165 foreach my $pattern (@urlshortener) {
166 my $p = "https?:\/\/" . $pattern;
168 write_debug("Matching %s against %s", $p, $s);
173 write_debug("Found %s", $matched);
174 $res = $ua->head($matched);
175 if ($res->is_redirect()) {
176 my $new = $res->headers()->header("Location");
178 write_debug("Replacing %s with %s", $matched, $new);
179 $s =~ s/$matched/$new/;
182 write_debug("Error resolving %s", $matched);
189 write_debug("Loop terminated by counter");
192 write_debug("Final string: %s", $s);
200 foreach (@{$conf->{'videosite'}->{'connectorlist'}}) {
201 push(@c, $conf->{'videosite'}->{'connectors'}->{$_});
210 my $message = $event->message();
211 my $witem = $event->channel();
217 # Look if we should ignore this line
218 if ($message =~ m,(?:\s|^)/nosave(?:\s|$),) {
222 push_output($event->ewpf);
223 $message = expand_url_shortener($message);
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');
237 } elsif ('display' eq ($conf->{'videosite'}->{'mode'})) {
238 write_irssi('%%M>>> %%NSaw %%Y%s%%N %%G%s', $m->{'SOURCE'}, $m->{'TITLE'});
240 write_irssi('%%R>>> Invalid operation mode');
243 # Remove the matched part from the message and try again (there may be
247 last GRABBER if ($message =~ /^\s*$/);
249 ($m, $p) = $g->get($message);
259 my ($tempfile, $tempfn) = tempfile("videosite.json.XXXXXX", dir => Irssi::get_irssi_dir());
260 print $tempfile JSON->new->pretty->utf8->encode($conf);
262 rename($tempfn, $conffile);
265 write_irssi('Could not save config to %s: %s', ($conffile, $@));
267 write_irssi('configuration saved to %s', $conffile);
277 foreach $p (@getters, @grabbers) {
278 if ($p->{'NAME'} eq $target) {
279 $p->setval($key, $val);
283 write_irssi('No such module');
291 foreach $p (@grabbers) {
292 if ($p->{'NAME'} eq $target) {
297 write_irssi('No such module');
305 foreach $p (@grabbers) {
306 if ($p->{'NAME'} eq $target) {
311 write_irssi('No such module');
320 if (defined($target)) {
321 foreach $p (@getters, @grabbers) {
322 if ($p->{'NAME'} eq $target) {
323 write_irssi($p->getconfstr());
327 write_irssi('No such module');
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?'*':'');
335 write_irssi('Loaded getters:');
336 foreach $p (@getters) {
337 write_irssi(' %s', $p->{'NAME'});
346 if (defined($target)) {
347 foreach $p (@getters, @grabbers) {
348 if ($p->{'NAME'} eq $target) {
349 write_irssi($p->gethelpstr());
353 write_irssi('No such module');
355 write_irssi(<<'EOT');
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
377 if (defined($target)) {
378 foreach $p (@getters) {
379 if ($p->{'NAME'} eq $target) {
381 $conf->{'videosite'}->{'getter'} = $target;
382 write_irssi("Getter changed to %s", $target);
386 write_irssi('No such getter');
388 write_irssi('Current getter: %s', $conf->{'videosite'}->{'getter'});
395 if (defined($mode)) {
397 if (('download' eq $mode) or ('display' eq $mode)) {
398 $conf->{'videosite'}->{'mode'} = $mode;
399 write_irssi('Now using %s mode', $mode);
401 write_irssi('Invalid mode: %s', $mode);
404 write_irssi('Current mode: %s', $conf->{'videosite'}->{'mode'});
410 my $connconf = $conf->{'videosite'}->{'connectors'};
412 unless(defined($subcmd)) {
416 $subcmd = lc($subcmd);
418 if ($subcmd eq 'list') {
419 write_irssi("Defined connectors");
420 foreach (keys(%{$connconf})) {
422 my $schemas = $connconf->{$_}->{'schemas'};
423 if (scalar(keys(%{$schemas})) == 0) {
424 write_irssi(" No schemas defined");
426 foreach (keys(%{$schemas})) {
427 write_irssi(' %s: %s', $_, $schemas->{$_});
433 write_irssi("Selected connectors: %s", join(", ", @{$conf->{'videosite'}->{'connectorlist'}}));
434 } elsif ($subcmd eq 'add') {
437 unless(defined($name)) {
438 write_irssi("No name given");
444 if (exists($connconf->{$_})) {
445 write_irssi("Connector already exists");
449 $connconf->{$name} = {'name' => $name, 'schemas' => {}};
450 } elsif ($subcmd eq 'del') {
453 unless(defined($name)) {
454 write_irssi("No name given");
460 unless (exists($connconf->{$name})) {
461 write_irssi("Connector does not exist");
465 if (exists($connconf->{$name}->{'_immutable'})) {
466 write_irssi("Connector cannot be removed");
470 delete($connconf->{$name});
472 # Remove from list of active connectors
473 $conf->{'videosite'}->{'connectorlist'} =
474 [ grep { $_ ne $name } @{$conf->{'videosite'}->{'connectorlist'}} ];
476 if (scalar(@{$conf->{'videosite'}->{'connectorlist'}}) == 0) {
477 write_irssi("List of selected connectors is empty, resetting to direct");
478 $conf->{'videosite'}->{'connectorlist'} = [ 'direct' ];
480 } elsif ($subcmd eq 'addschema') {
481 my ($conn, $schema, $proxy) = @_;
483 unless(defined($conn)) {
484 write_irssi("No connector name given");
490 if (exists($connconf->{$conn}->{'_immutable'})) {
491 write_irssi("Connector cannot be modified");
495 unless(defined($schema)) {
496 write_irssi("No schema given");
500 $schema = lc($schema);
502 unless(defined($proxy)) {
503 write_irssi("No proxy given");
507 unless(exists($connconf->{$conn})) {
508 write_irssi("Connector does not exist");
512 $connconf->{$conn}->{'schemas'}->{$schema} = $proxy;
513 } elsif ($subcmd eq 'delschema') {
514 my ($conn, $schema) = @_;
516 unless(defined($conn)) {
517 write_irssi("No connector name given");
523 if (exists($connconf->{$conn}->{'_immutable'})) {
524 write_irssi("Connector cannot be modified");
528 unless(defined($schema)) {
529 write_irssi("No schema given");
533 $schema = lc($schema);
535 unless(exists($connconf->{$conn})) {
536 write_irssi("Connector does not exist");
540 delete($connconf->{$conn}->{'schemas'}->{$schema});
541 } elsif ($subcmd eq 'select') {
542 my @connlist = map { lc } @_;
544 if (scalar(@connlist) == 0) {
545 write_irssi("No connectors given");
549 foreach (@connlist) {
550 unless(exists($connconf->{$_})) {
551 write_irssi("Connector %s does not exist", $_);
556 $conf->{'videosite'}->{'connectorlist'} = [ @connlist ];
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");
573 sub sig_command_script_unload {
575 if ($script =~ /(.*\/)?videosite(\.pl)?$/) {
590 opendir(D, $dir) || return ();
591 @list = grep {/$pattern/ && -f File::Spec->catfile($dir, $_) } readdir(D);
595 write_debug("Trying to load $p:");
597 eval qq{ require videosite::$p; };
599 write_irssi("Failed to load plugin: $@");
603 $g = eval qq{ videosite::$p->new(); };
605 write_irssi("Failed to instanciate: $@");
610 write_debug("found $g->{'TYPE'} $g->{'NAME'}");
611 if ($type eq $g->{'TYPE'}) {
613 $g->setio(\&write_irssi);
614 $g->setconn(\&connectorlist);
616 write_irssi('%s has wrong type (got %s, expected %s)', $p, $g->{'TYPE'}, $type);
621 write_debug("Loaded %d plugins", $#g+1);
626 sub _load_modules($) {
630 foreach (keys(%INC)) {
631 if ($INC{$_} =~ m|^$path|) {
632 write_debug("Removing %s from \$INC", $_);
636 @grabbers = ploader($path, '.*Grabber\.pm$', 'grabber');
637 @getters = ploader($path, '.*Getter\.pm$', 'getter');
643 my $bindings = shift;
647 write_debug("Attempting JSON config load from %s", $conffile);
650 open(CONF, '<', $conffile);
651 $conf = JSON->new->utf8->decode(<CONF>);
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'});
659 unless(defined($conf)) {
660 # No config, start with an empty one
661 write_debug('No config found, using defaults');
662 $conf = { 'videosite' => { }};
665 foreach (keys(%{$PARAMS})) {
666 unless (exists($conf->{'videosite'}->{$_})) {
667 $conf->{'videosite'}->{$_} = $PARAMS->{$_};
671 # Make sure there is a connector called 'direct', which defines no
673 unless (exists($conf->{'videosite'}->{'connectors'}->{'direct'})) {
674 $conf->{'videosite'}->{'connectors'}->{'direct'} = {
681 _load_modules($plugindir);
683 unless (defined(@grabbers) && defined(@getters)) {
684 write_irssi('No grabbers or no getters found, can not proceed.');
688 $getter = $getters[0];
689 foreach $p (@getters) {
690 if ($conf->{'videosite'}->{'getter'} eq $p->{'NAME'}) {
694 write_debug('Selected %s as getter', $getter->{'NAME'});
695 $conf->{'videosite'}->{'getter'} = $getter->{'NAME'};
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'}});
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');
709 Irssi::command_bind(_bcb('videosite' => \&cmdhandler));
712 write_irssi('initialized successfully');
716 my ($complist, $window, $word, $linestart, $want_space) = @_;
719 if ($linestart !~ m|^/videosite\b|) {
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|;
731 } elsif ($linestart =~ m|^/videosite set (\w+)$|) {
734 foreach my $p (@getters, @grabbers) {
735 if ($p->{'NAME'} eq $module) {
736 @matches = $p->getparamlist($word);
740 } elsif ($linestart =~ m|/videosite set (\w+) (\w+)$|) {
744 foreach my $p (@getters, @grabbers) {
745 if ($p->{'NAME'} eq $module) {
746 @matches = $p->getparamvalues($param, $word);
753 push(@{$complist}, sort @matches);
756 Irssi::signal_stop();
759 # =================================
760 # Reworked code below this line
761 # =================================
764 # Initialize the config subsystem. Called by the core.
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
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
776 my $xmlconffile = File::Spec->catfile(Irssi::get_irssi_dir(), 'videosite.xml');
777 my $conffile = File::Spec->catfile(Irssi::get_irssi_dir(), 'videosite.json');
780 # Check for irssi internal config. If not found...
781 if (config_has(['config-version'])) {
782 # Configuration in irssi config file. We're done.
786 # Try to find old config files and load them.
788 write_debug("Attempting JSON config load from %s", $conffile);
791 open(CONF, '<', $conffile);
792 $conf = JSON->new->utf8->decode(<CONF>);
795 } elsif (-r $xmlconffile) {
796 write_debug("Attempting XML config load from %s", $xmlconffile);
797 $conf = XML::Simple::XMLin($xmlconffile, ForceArray => ['config', 'option', 'connectorlist'], KeepRoot => 1, KeyAttr => {'connector' => '+name', 'config' => 'module', 'option' => 'key'});
801 # Configuration conversion:
802 # Replace this structure:
812 Irssi::print("Converting configuration, stage 1");
814 # Only the getter/grabbers have this, so just check that part of the config
815 foreach my $g (keys(%{$conf->{videosite}->{config}})) {
816 foreach (keys(%{$conf->{videosite}->{config}->{$g}->{option}})) {
817 if (exists($conf->{videosite}->{config}->{$g}->{option}->{$_}->{content})) {
818 $conf->{videosite}->{config}->{$g}->{option}->{$_} = $conf->{videosite}->{config}->{$g}->{option}->{$_}->{content};
824 # Walk the configuration hash, creating irssi config entries for
827 # Some config values changed, so not the entire config is copied over.
828 # There is a helper function for this in libvideosite that we're using.
830 Irssi::print("Converting configuration, stage 2");
832 # Copy the "basic" settings.
833 foreach (qw(getter mode)) {
834 config_set(['getter'], $conf->{videosite}->{$_});
837 # Copy the per-getter/setter settings
838 foreach my $g (keys(%{$conf->{videosite}->{config}})) {
839 foreach (keys(%{$conf->{videosite}->{config}->{$g}->{option}})) {
840 config_set(['plugin', $g, $_], $conf->{videosite}->{config}->{$g}->{option}->{$_});
844 # Copy the connectors. The connectors themselves are copied as-is,
845 # the list of active connectors is copied under a different name,
846 # and a list of all existing connectors is created
849 foreach my $c (keys(%{$conf->{videosite}->{connectors}})) {
850 push(@connectors, $c);
851 config_set(['connectors', $c, 'name'], $conf->{videosite}->{connectors}->{$c}->{name});
852 if (exists($conf->{videosite}->{connectors}->{$c}->{_immutable})) {
853 config_set(['connectors', $c, '_immutable'], $conf->{videosite}->{connectors}->{$c}->{_immutable});
855 foreach (qw(http https)) {
856 if (exists($conf->{videosite}->{connectors}->{$c}->{schemas}->{http})) {
857 config_set(['connectors', $c, 'schemas', $_], $conf->{videosite}->{connectors}->{$c}->{schemas_}->{$_});
861 config_set(['active-connectors'], join(",", @{$conf->{connectorlist}}));
862 config_set(['defined-connectors'], join(",", @connectors));
863 config_set(['config-version'], '2');
867 # Reading a configuration value. Called by the core
871 my $item = join('.', @{$path});
875 Irssi::settings_add_str('videosite', $item, "\0");
876 $val = Irssi::settigs_get_str($item);
878 return ($val ne "\0")?$val:undef;
882 # Returns a true value if the config item exists
886 my $item = join('.', @{$path});
888 Irssi::settings_add_str('videosite', $item, "\0");
889 return Irssi::settings_get_str ne "\0";
893 # Setting a configuration value. Called by the core
898 my $item = join('.', @{$path});
900 Irssi::settings_add_str('videosite', $item, "\0");
901 Irssi::settings_set_str($item, $value);
905 # Delete a configuration value. Called by the core.
909 my $item = join('.', @{$path});
911 Irssi::settings_remove($item);
915 # Return a color code. Called by the core
920 Irssi::print(sprintf("Asked to convert (%s,%s) into irssi color codes", $fg, $bg));o
926 # Handle commands (/videosite ...)
929 my ($cmdline, $server, $witem) = @_;
932 ewpf => sub { defined($evitem)?$evitem->print(@_):Irssi::print(@_) },
935 libvideosite::handle_command(\%event);
939 # Handle a received message
940 # Create an event structure and hand it off to libvideosite
943 my ($server, $msg, $nick, $userhost, $channel) = @_;
944 my $evitem = $server->window_item_find($channel);
947 ewpf => sub { defined($evitem)?$evitem->print(@_):Irssi::print(@_) },
950 libvideosite::check_for_link(\%event);
953 sub videosite_reset {
954 unless(libvideosite::register_api({
955 io => sub { Irssi::print(@_) },
956 config_init => \&config_init,
957 config_get => \&config_get,
958 config_set => \&config_set,
959 config_has => \&config_has,
960 config_save => \&config_save,
961 config_del => \&config_del,
962 color => \&colorpair,
963 module_path => sub { return File::Spec->catfile(Irssi::get_irssi_dir(), 'scripts') },
964 quote => sub { s/%/%%/g; return $_ },
967 Irssi::print(sprintf("videosite API register failed: %s", $libvideosite::error));
971 unless(libvideosite::init()) {
972 Irssi::print(sprintf("videosite init failed: %s", $libvideosite::error));
980 # Find out the script directory, and add it to @INC.
981 # This is necessary to find libvideosite.pm
983 push(@INC, File::Spec->catfile(Irssi::get_irssi_dir(), 'scripts'));
986 unless (videosite_reset()) {
987 signal_add_last("message public", sub { message_hook(@_) });
988 signal_add_last("message own_public", sub { message_hook($_[0], $_[1], undef, undef, $_[2]) });
989 signal_add_last("message private", sub { message_hooK($_[0], $_[1], $_[2], $_[3], $_[2]) });
990 signal_add_last("message own_private", sub { message_hook($_[0], $_[1], undef, undef, $_[2]) });
991 signal_add_last("message irc action", sub { message_hook(@_) });
992 signal_add_last("message irc own_action", sub { message_hook($_[0], $_[1], undef, undef, $_[2]) });
994 Irssi::command_bind('videosite', sub { videosite_hook(@_) });