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 debug: enable debugging messages
390 nodebug: disable debugging messages
399 if (defined($target)) {
400 foreach $p (@getters) {
401 if ($p->{'NAME'} eq $target) {
403 $conf->{'videosite'}->{'getter'} = $target;
404 write_irssi("Getter changed to %s", $target);
408 write_irssi('No such getter');
410 write_irssi('Current getter: %s', $conf->{'videosite'}->{'getter'});
417 if (defined($mode)) {
419 if (('download' eq $mode) or ('display' eq $mode)) {
420 $conf->{'videosite'}->{'mode'} = $mode;
421 write_irssi('Now using %s mode', $mode);
423 write_irssi('Invalid mode: %s', $mode);
426 write_irssi('Current mode: %s', $conf->{'videosite'}->{'mode'});
432 my $connconf = $conf->{'videosite'}->{'connectors'};
434 unless(defined($subcmd)) {
438 $subcmd = lc($subcmd);
440 if ($subcmd eq 'list') {
441 write_irssi("Defined connectors");
442 foreach (keys(%{$connconf})) {
444 my $schemas = $connconf->{$_}->{'schemas'};
445 if (scalar(keys(%{$schemas})) == 0) {
446 write_irssi(" No schemas defined");
448 foreach (keys(%{$schemas})) {
449 write_irssi(' %s: %s', $_, $schemas->{$_});
455 write_irssi("Selected connectors: %s", join(", ", @{$conf->{'videosite'}->{'connectorlist'}}));
456 } elsif ($subcmd eq 'add') {
459 unless(defined($name)) {
460 write_irssi("No name given");
466 if (exists($connconf->{$_})) {
467 write_irssi("Connector already exists");
471 $connconf->{$name} = {'name' => $name, 'schemas' => {}};
472 } elsif ($subcmd eq 'del') {
475 unless(defined($name)) {
476 write_irssi("No name given");
482 if ($name eq 'direct') {
483 write_irssi("Cannot remove direct connector");
487 unless (exists($connconf->{$_})) {
488 write_irssi("Connector does not exist");
492 delete($connconf->{$name});
494 # Remove from list of active connectors
495 $conf->{'videosite'}->{'connectorlist'} =
496 [ grep { $_ ne $name } @{$conf->{'videosite'}->{'connectorlist'}} ];
498 if (scalar(@{$conf->{'videosite'}->{'connectorlist'}}) == 0) {
499 write_irssi("List of selected connectors is empty, resetting to direct");
500 $conf->{'videosite'}->{'connectorlist'} = [ 'direct' ];
502 } elsif ($subcmd eq 'addschema') {
503 my ($conn, $schema, $proxy) = @_;
505 unless(defined($conn)) {
506 write_irssi("No connector name given");
512 if ($conn eq 'direct') {
513 write_irssi("Connector is not modifiable");
517 unless(defined($schema)) {
518 write_irssi("No schema given");
522 $schema = lc($schema);
524 unless(defined($proxy)) {
525 write_irssi("No proxy given");
529 unless(exists($connconf->{$conn})) {
530 write_irssi("Connector does not exist");
534 $connconf->{$conn}->{'schemas'}->{$schema} = $proxy;
535 } elsif ($subcmd eq 'delschema') {
536 my ($conn, $schema) = @_;
538 unless(defined($conn)) {
539 write_irssi("No connector name given");
545 if ($conn eq 'direct') {
546 write_irssi("Connector is not modifiable");
550 unless(defined($schema)) {
551 write_irssi("No schema given");
555 $schema = lc($schema);
557 unless(exists($connconf->{$conn})) {
558 write_irssi("Connector does not exist");
562 delete($connconf->{$conn}->{'schemas'}->{$schema});
563 } elsif ($subcmd eq 'select') {
564 my @connlist = map { lc } @_;
566 if (scalar(@connlist) == 0) {
567 write_irssi("No connectors given");
571 foreach (@connlist) {
572 unless(exists($connconf->{$_})) {
573 write_irssi("Connector %s does not exist", $_);
578 $conf->{'videosite'}->{'connectorlist'} = [ @connlist ];
580 write_irssi("connector [list|add|del|addschema|delschema|help] <options>");
581 write_irssi(" help: Show this help");
582 write_irssi(" list: List the defined connectors");
583 write_irssi(" add <name>: Add a connector with name <name>");
584 write_irssi(" del <name>: Delete the connector with name <name>");
585 write_irssi(" addschema <name> <schema> <proxy>: Add proxy to connector for the given schema");
586 write_irssi(" delschema <name> <schema>: Remove the schema from the connector");
587 write_irssi(" select <name> [<name>...]: Select the connectors to use");
595 sub sig_command_script_unload {
597 if ($script =~ /(.*\/)?videosite(\.pl)?$/) {
612 opendir(D, $dir) || return ();
613 @list = grep {/$pattern/ && -f File::Spec->catfile($dir, $_) } readdir(D);
617 write_debug("Trying to load $p:");
619 eval qq{ require videosite::$p; };
621 write_irssi("Failed to load plugin: $@");
625 $g = eval qq{ videosite::$p->new(); };
627 write_irssi("Failed to instanciate: $@");
632 write_debug("found $g->{'TYPE'} $g->{'NAME'}");
633 if ($type eq $g->{'TYPE'}) {
635 $g->setio(\&write_irssi);
636 $g->setconn(\&connectorlist);
638 write_irssi('%s has wrong type (got %s, expected %s)', $p, $g->{'TYPE'}, $type);
643 write_debug("Loaded %d plugins", $#g+1);
648 sub _load_modules($) {
652 foreach (keys(%INC)) {
653 if ($INC{$_} =~ m|^$path|) {
654 write_debug("Removing %s from \$INC", $_);
658 @grabbers = ploader($path, '.*Grabber\.pm$', 'grabber');
659 @getters = ploader($path, '.*Getter\.pm$', 'getter');
665 my $bindings = shift;
668 unless(-r $conffile && defined($conf = XML::Simple::XMLin($conffile, ForceArray => ['config', 'option', 'connectorlist'], KeepRoot => 1, KeyAttr => {'connector' => '+name', 'config' => 'module', 'option' => 'key'}))) {
669 # No config, start with an empty one
670 write_debug('No config found, using defaults');
671 $conf = { 'videosite' => { }};
673 foreach (keys(%{$PARAMS})) {
674 unless (exists($conf->{'videosite'}->{$_})) {
675 $conf->{'videosite'}->{$_} = $PARAMS->{$_};
679 # Make sure there is a connector called 'direct', which defines no
681 unless (exists($conf->{'videosite'}->{'connectors'}->{'direct'})) {
682 $conf->{'videosite'}->{'connectors'}->{'direct'} = {
688 _load_modules($plugindir);
690 unless (defined(@grabbers) && defined(@getters)) {
691 write_irssi('No grabbers or no getters found, can not proceed.');
695 $getter = $getters[0];
696 foreach $p (@getters) {
697 if ($conf->{'videosite'}->{'getter'} eq $p->{'NAME'}) {
701 write_debug('Selected %s as getter', $getter->{'NAME'});
702 $conf->{'videosite'}->{'getter'} = $getter->{'NAME'};
704 # Loop through all plugins and load the config
705 foreach $p (@grabbers, @getters) {
706 $conf->{'videosite'}->{'config'}->{$p->{'NAME'}} = $p->mergeconfig($conf->{'videosite'}->{'config'}->{$p->{'NAME'}});
711 Irssi::signal_add_first('command script load', 'sig_command_script_unload');
712 Irssi::signal_add_first('command script unload', 'sig_command_script_unload');
713 Irssi::signal_add('setup saved', 'cmd_save');
716 Irssi::command_bind(_bcb('videosite' => \&cmdhandler));
719 write_irssi('initialized successfully');
723 my ($complist, $window, $word, $linestart, $want_space) = @_;
726 if ($linestart !~ m|^/videosite\b|) {
730 if ('/videosite' eq $linestart) {
731 # No command enterd so far. Produce a list of possible follow-ups
732 @matches = grep {/^$word/} keys (%{$videosite_commands});
733 } elsif ('/videosite set' eq $linestart) {
734 # 'set' command entered. Produce a list of modules
735 foreach (@grabbers, @getters) {
736 push(@matches, $_->{'NAME'}) if $_->{'NAME'} =~ m|^$word|;
738 } elsif ($linestart =~ m|^/videosite set (\w+)$|) {
741 foreach my $p (@getters, @grabbers) {
742 if ($p->{'NAME'} eq $module) {
743 @matches = $p->getparamlist($word);
747 } elsif ($linestart =~ m|/videosite set (\w+) (\w+)$|) {
751 foreach my $p (@getters, @grabbers) {
752 if ($p->{'NAME'} eq $module) {
753 @matches = $p->getparamvalues($param, $word);
760 push(@{$complist}, sort @matches);
763 Irssi::signal_stop();
768 my ($cmd, @params) = split(/\s+/, $event->message());
770 push_output($event->ewpf);
772 if (exists($videosite_commands->{$cmd})) {
773 $videosite_commands->{$cmd}->(@params);
779 unshift(@INC, $scriptdir);