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>
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
16 delete($INC{'BettIrssi.pm'});
20 use Irssi 20020324 qw (command_bind command_runsub signal_add_first signal_add_last);
21 use vars qw($VERSION %IRSSI);
25 use File::Temp qw(tempfile);
26 use BettIrssi 101 qw(_bcb _bcs);
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);
41 'connectorlist' => ['direct'],
49 # "message public", SERVER_REC, char *msg, char *nick, char *address, char *target
50 signal_add_last(_bcs("message public" => sub {check_for_link(@_)}));
51 # "message own_public", SERVER_REC, char *msg, char *target
52 signal_add_last(_bcs("message own_public" => sub {check_for_link(@_)}));
54 # "message private", SERVER_REC, char *msg, char *nick, char *address
55 signal_add_last(_bcs("message private" => sub {check_for_link(@_)}));
56 # "message own_private", SERVER_REC, char *msg, char *target, char *orig_target
57 signal_add_last(_bcs("message own_private" => sub {check_for_link(@_)}));
59 # "message irc action", SERVER_REC, char *msg, char *nick, char *address, char *target
60 signal_add_last(_bcs("message irc action" => sub {check_for_link(@_)}));
61 # "message irc own_action", SERVER_REC, char *msg, char *target
62 signal_add_last(_bcs("message irc own_action" => sub {check_for_link(@_)}));
65 # This does not use BettIrssi (yet)
66 signal_add_first('complete word', \&sig_complete);
69 unshift(@outputstack, shift);
75 @outputstack = (undef) unless (@outputstack);
78 my $videosite_commands = {
121 foreach (@grabbers, @getters) {
124 write_irssi('Enabled debugging');
129 foreach (@grabbers, @getters) {
132 write_irssi('Disabled debugging');
138 my $output = $outputstack[0];
140 my $format = "%%mvideosite: %%n" . shift(@text);
142 # escape % in parameters from irssi
143 s/%/%%/g foreach @text;
145 if (defined $output) {
146 $output->(sprintf($format, @text), MSGLEVEL_CLIENTCRAP);
148 Irssi::print(sprintf($format, @text));
159 sub expand_url_shortener {
163 'is\.gd/[[:alnum:]]+',
164 'otf\.me/[[:alnum:]]+',
165 'hel\.me/[[:alnum:]]+',
166 '7ax\.de/[[:alnum:]]+',
167 'ow\.ly/[[:alnum:]]+',
168 'j\.mp/[[:alnum:]]+',
169 'bit\.ly/[[:alnum:]]+',
170 'tinyurl\.com/[[:alnum:]]+',
171 'pop\.is/[[:alnum:]]+',
172 'post\.ly/[[:alnum:]]+',
173 '1\.ly/[[:alnum:]]+',
174 '2\.ly/[[:alnum:]]+',
175 't\.co/[[:alnum:]]+',
176 'shar\.es/[[:alnum:]]+',
177 'goo\.gl/[[:alnum:]]+',
179 my $ua = LWP::UserAgent->new(agent => 'Mozilla', max_redirect => 0);
182 OUTER: while (($os ne $s) and ($i > 0)) {
187 foreach my $pattern (@urlshortener) {
188 my $p = "https?:\/\/" . $pattern;
190 write_debug("Matching %s against %s", $p, $s);
195 write_debug("Found %s", $matched);
196 $res = $ua->head($matched);
197 if ($res->is_redirect()) {
198 my $new = $res->headers()->header("Location");
200 write_debug("Replacing %s with %s", $matched, $new);
201 $s =~ s/$matched/$new/;
204 write_debug("Error resolving %s", $matched);
211 write_debug("Loop terminated by counter");
214 write_debug("Final string: %s", $s);
222 foreach (@{$conf->{'videosite'}->{'connectorlist'}}) {
223 push(@c, $conf->{'videosite'}->{'connectors'}->{$_});
232 my $message = $event->message();
233 my $witem = $event->channel();
239 # Look if we should ignore this line
240 if ($message =~ m,(?:\s|^)/nosave(?:\s|$),) {
244 push_output($event->ewpf);
245 $message = expand_url_shortener($message);
249 # Offer the message to all Grabbers in turn
250 GRABBER: foreach $g (@grabbers) {
251 ($m, $p) = $g->get($message);
252 while (defined($m)) {
253 write_debug('Metadata: %s', Dumper($m));
254 if ('download' eq ($conf->{'videosite'}->{'mode'})) {
255 write_irssi('%%R>>> %%NSaving %%Y%s%%N %%G%s', $m->{'SOURCE'}, $m->{'TITLE'});
256 unless($getter->get($m)) {
257 write_irssi('%%R>>> FAILED');
259 } elsif ('display' eq ($conf->{'videosite'}->{'mode'})) {
260 write_irssi('%%M>>> %%NSaw %%Y%s%%N %%G%s', $m->{'SOURCE'}, $m->{'TITLE'});
262 write_irssi('%%R>>> Invalid operation mode');
265 # Remove the matched part from the message and try again (there may be
269 last GRABBER if ($message =~ /^\s*$/);
271 ($m, $p) = $g->get($message);
282 my ($tempfile, $tempfn) = tempfile("videosite.xml.XXXXXX", dir => Irssi::get_irssi_dir());
283 print $tempfile XML::Simple::XMLout($conf, KeepRoot => 1, KeyAttr => {'connector' => '+name', 'config' => 'module', 'option' => 'key'});
285 rename($tempfn, $conffile);
288 write_irssi('Could not save config to %s: %s', ($conffile, $@));
290 write_irssi('configuration saved to %s', $conffile);
300 foreach $p (@getters, @grabbers) {
301 if ($p->{'NAME'} eq $target) {
302 $p->setval($key, $val);
306 write_irssi('No such module');
314 foreach $p (@grabbers) {
315 if ($p->{'NAME'} eq $target) {
320 write_irssi('No such module');
328 foreach $p (@grabbers) {
329 if ($p->{'NAME'} eq $target) {
334 write_irssi('No such module');
343 if (defined($target)) {
344 foreach $p (@getters, @grabbers) {
345 if ($p->{'NAME'} eq $target) {
346 write_irssi($p->getconfstr());
350 write_irssi('No such module');
352 write_irssi('Loaded grabbers (* denotes enabled modules):');
353 foreach $p (@grabbers) {
354 $e = $p->_getval('enabled');
355 write_irssi(' %s%s', $p->{'NAME'}, $e?'*':'');
358 write_irssi('Loaded getters:');
359 foreach $p (@getters) {
360 write_irssi(' %s', $p->{'NAME'});
369 if (defined($target)) {
370 foreach $p (@getters, @grabbers) {
371 if ($p->{'NAME'} eq $target) {
372 write_irssi($p->gethelpstr());
376 write_irssi('No such module');
378 write_irssi(<<'EOT');
380 save: save the current configuration
381 help [modulename]: display this help, or module specific help
382 show [modulename]: show loaded modules, or the current parameters of a module
383 set modulename parameter value: set a module parameter to a new value
384 getter [modulename]: display or set the getter to use
385 enable [modulename]: enable the usage of this module (grabbers only)
386 disable [modulename]: disable the usage of this module (grabbers only)
387 reload: reload all modules (this is somewhat experimental)
388 mode [modename]: display or set the operation mode (download/display)
389 connector [subcommand]: manage connectors (proxies)
390 debug: enable debugging messages
391 nodebug: disable debugging messages
400 if (defined($target)) {
401 foreach $p (@getters) {
402 if ($p->{'NAME'} eq $target) {
404 $conf->{'videosite'}->{'getter'} = $target;
405 write_irssi("Getter changed to %s", $target);
409 write_irssi('No such getter');
411 write_irssi('Current getter: %s', $conf->{'videosite'}->{'getter'});
418 if (defined($mode)) {
420 if (('download' eq $mode) or ('display' eq $mode)) {
421 $conf->{'videosite'}->{'mode'} = $mode;
422 write_irssi('Now using %s mode', $mode);
424 write_irssi('Invalid mode: %s', $mode);
427 write_irssi('Current mode: %s', $conf->{'videosite'}->{'mode'});
433 my $connconf = $conf->{'videosite'}->{'connectors'};
435 unless(defined($subcmd)) {
439 $subcmd = lc($subcmd);
441 if ($subcmd eq 'list') {
442 write_irssi("Defined connectors");
443 foreach (keys(%{$connconf})) {
445 my $schemas = $connconf->{$_}->{'schemas'};
446 if (scalar(keys(%{$schemas})) == 0) {
447 write_irssi(" No schemas defined");
449 foreach (keys(%{$schemas})) {
450 write_irssi(' %s: %s', $_, $schemas->{$_});
456 write_irssi("Selected connectors: %s", join(", ", @{$conf->{'videosite'}->{'connectorlist'}}));
457 } elsif ($subcmd eq 'add') {
460 unless(defined($name)) {
461 write_irssi("No name given");
467 if (exists($connconf->{$_})) {
468 write_irssi("Connector already exists");
472 $connconf->{$name} = {'name' => $name, 'schemas' => {}};
473 } elsif ($subcmd eq 'del') {
476 unless(defined($name)) {
477 write_irssi("No name given");
483 unless (exists($connconf->{$name})) {
484 write_irssi("Connector does not exist");
488 if (exists($connconf->{$name}->{'_immutable'})) {
489 write_irssi("Connector cannot be removed");
493 delete($connconf->{$name});
495 # Remove from list of active connectors
496 $conf->{'videosite'}->{'connectorlist'} =
497 [ grep { $_ ne $name } @{$conf->{'videosite'}->{'connectorlist'}} ];
499 if (scalar(@{$conf->{'videosite'}->{'connectorlist'}}) == 0) {
500 write_irssi("List of selected connectors is empty, resetting to direct");
501 $conf->{'videosite'}->{'connectorlist'} = [ 'direct' ];
503 } elsif ($subcmd eq 'addschema') {
504 my ($conn, $schema, $proxy) = @_;
506 unless(defined($conn)) {
507 write_irssi("No connector name given");
513 if (exists($connconf->{$conn}->{'_immutable'})) {
514 write_irssi("Connector cannot be modified");
518 unless(defined($schema)) {
519 write_irssi("No schema given");
523 $schema = lc($schema);
525 unless(defined($proxy)) {
526 write_irssi("No proxy given");
530 unless(exists($connconf->{$conn})) {
531 write_irssi("Connector does not exist");
535 $connconf->{$conn}->{'schemas'}->{$schema} = $proxy;
536 } elsif ($subcmd eq 'delschema') {
537 my ($conn, $schema) = @_;
539 unless(defined($conn)) {
540 write_irssi("No connector name given");
546 if (exists($connconf->{$conn}->{'_immutable'})) {
547 write_irssi("Connector cannot be modified");
551 unless(defined($schema)) {
552 write_irssi("No schema given");
556 $schema = lc($schema);
558 unless(exists($connconf->{$conn})) {
559 write_irssi("Connector does not exist");
563 delete($connconf->{$conn}->{'schemas'}->{$schema});
564 } elsif ($subcmd eq 'select') {
565 my @connlist = map { lc } @_;
567 if (scalar(@connlist) == 0) {
568 write_irssi("No connectors given");
572 foreach (@connlist) {
573 unless(exists($connconf->{$_})) {
574 write_irssi("Connector %s does not exist", $_);
579 $conf->{'videosite'}->{'connectorlist'} = [ @connlist ];
581 write_irssi("connector [list|add|del|addschema|delschema|help] <options>");
582 write_irssi(" help: Show this help");
583 write_irssi(" list: List the defined connectors");
584 write_irssi(" add <name>: Add a connector with name <name>");
585 write_irssi(" del <name>: Delete the connector with name <name>");
586 write_irssi(" addschema <name> <schema> <proxy>: Add proxy to connector for the given schema");
587 write_irssi(" delschema <name> <schema>: Remove the schema from the connector");
588 write_irssi(" select <name> [<name>...]: Select the connectors to use");
596 sub sig_command_script_unload {
598 if ($script =~ /(.*\/)?videosite(\.pl)?$/) {
613 opendir(D, $dir) || return ();
614 @list = grep {/$pattern/ && -f File::Spec->catfile($dir, $_) } readdir(D);
618 write_debug("Trying to load $p:");
620 eval qq{ require videosite::$p; };
622 write_irssi("Failed to load plugin: $@");
626 $g = eval qq{ videosite::$p->new(); };
628 write_irssi("Failed to instanciate: $@");
633 write_debug("found $g->{'TYPE'} $g->{'NAME'}");
634 if ($type eq $g->{'TYPE'}) {
636 $g->setio(\&write_irssi);
637 $g->setconn(\&connectorlist);
639 write_irssi('%s has wrong type (got %s, expected %s)', $p, $g->{'TYPE'}, $type);
644 write_debug("Loaded %d plugins", $#g+1);
649 sub _load_modules($) {
653 foreach (keys(%INC)) {
654 if ($INC{$_} =~ m|^$path|) {
655 write_debug("Removing %s from \$INC", $_);
659 @grabbers = ploader($path, '.*Grabber\.pm$', 'grabber');
660 @getters = ploader($path, '.*Getter\.pm$', 'getter');
666 my $bindings = shift;
669 unless(-r $conffile && defined($conf = XML::Simple::XMLin($conffile, ForceArray => ['config', 'option', 'connectorlist'], KeepRoot => 1, KeyAttr => {'connector' => '+name', 'config' => 'module', 'option' => 'key'}))) {
670 # No config, start with an empty one
671 write_debug('No config found, using defaults');
672 $conf = { 'videosite' => { }};
674 foreach (keys(%{$PARAMS})) {
675 unless (exists($conf->{'videosite'}->{$_})) {
676 $conf->{'videosite'}->{$_} = $PARAMS->{$_};
680 # Make sure there is a connector called 'direct', which defines no
682 unless (exists($conf->{'videosite'}->{'connectors'}->{'direct'})) {
683 $conf->{'videosite'}->{'connectors'}->{'direct'} = {
690 _load_modules($plugindir);
692 unless (defined(@grabbers) && defined(@getters)) {
693 write_irssi('No grabbers or no getters found, can not proceed.');
697 $getter = $getters[0];
698 foreach $p (@getters) {
699 if ($conf->{'videosite'}->{'getter'} eq $p->{'NAME'}) {
703 write_debug('Selected %s as getter', $getter->{'NAME'});
704 $conf->{'videosite'}->{'getter'} = $getter->{'NAME'};
706 # Loop through all plugins and load the config
707 foreach $p (@grabbers, @getters) {
708 $conf->{'videosite'}->{'config'}->{$p->{'NAME'}} = $p->mergeconfig($conf->{'videosite'}->{'config'}->{$p->{'NAME'}});
713 Irssi::signal_add_first('command script load', 'sig_command_script_unload');
714 Irssi::signal_add_first('command script unload', 'sig_command_script_unload');
715 Irssi::signal_add('setup saved', 'cmd_save');
718 Irssi::command_bind(_bcb('videosite' => \&cmdhandler));
721 write_irssi('initialized successfully');
725 my ($complist, $window, $word, $linestart, $want_space) = @_;
728 if ($linestart !~ m|^/videosite\b|) {
732 if ('/videosite' eq $linestart) {
733 # No command enterd so far. Produce a list of possible follow-ups
734 @matches = grep {/^$word/} keys (%{$videosite_commands});
735 } elsif ('/videosite set' eq $linestart) {
736 # 'set' command entered. Produce a list of modules
737 foreach (@grabbers, @getters) {
738 push(@matches, $_->{'NAME'}) if $_->{'NAME'} =~ m|^$word|;
740 } elsif ($linestart =~ m|^/videosite set (\w+)$|) {
743 foreach my $p (@getters, @grabbers) {
744 if ($p->{'NAME'} eq $module) {
745 @matches = $p->getparamlist($word);
749 } elsif ($linestart =~ m|/videosite set (\w+) (\w+)$|) {
753 foreach my $p (@getters, @grabbers) {
754 if ($p->{'NAME'} eq $module) {
755 @matches = $p->getparamvalues($param, $word);
762 push(@{$complist}, sort @matches);
765 Irssi::signal_stop();
770 my ($cmd, @params) = split(/\s+/, $event->message());
772 push_output($event->ewpf);
774 if (exists($videosite_commands->{$cmd})) {
775 $videosite_commands->{$cmd}->(@params);
781 unshift(@INC, $scriptdir);