X-Git-Url: https://git.camperquake.de/gitweb.cgi?a=blobdiff_plain;f=videosite.pl;h=d7a549fc7c4035cf181e26e70068515cc86a663e;hb=424740b4bc310d7266236c12505787159d26613d;hp=3ae1e83fdfe0fd03a82e0475f37226af3a10a5ce;hpb=1d562536b9c6135697a468ae572cb4afce36db34;p=videosite.git diff --git a/videosite.pl b/videosite.pl index 3ae1e83..d7a549f 100644 --- a/videosite.pl +++ b/videosite.pl @@ -7,23 +7,39 @@ # which in turn is # based on trigger.pl by Wouter Coekaerts + +BEGIN { + # Get rid of a (possibly old) version of BettIrssi + # This is a hack to prevent having to reload irssi just + # because BettIrssi.pm changed + + delete($INC{'BettIrssi.pm'}); +} + use strict; use Irssi 20020324 qw (command_bind command_runsub signal_add_first signal_add_last); use vars qw($VERSION %IRSSI); use XML::Simple; use Data::Dumper; use File::Spec; +use File::Temp qw(tempfile); +use BettIrssi 101 qw(_bcb _bcs); +use LWP::UserAgent; my @grabbers; my @getters; my $getter; my $conf; my $conffile = File::Spec->catfile(Irssi::get_irssi_dir(), 'videosite.xml'); -my $plugindir = File::Spec->catfile(Irssi::get_irssi_dir(), 'scripts', 'videosite'); +my $scriptdir = File::Spec->catfile(Irssi::get_irssi_dir(), 'scripts'); +my $plugindir = File::Spec->catfile($scriptdir, 'videosite'); +my @outputstack = (undef); my $PARAMS = { 'getter' => '', - 'mode' => 'download' + 'mode' => 'download', + 'connectorlist' => ['direct'], + 'connectors' => {}, }; @@ -31,98 +47,247 @@ my $PARAMS = { my $debug = 0; # "message public", SERVER_REC, char *msg, char *nick, char *address, char *target -signal_add_last("message public" => sub {check_for_link(\@_,1,4,2,0);}); +signal_add_last(_bcs("message public" => sub {check_for_link(@_)})); # "message own_public", SERVER_REC, char *msg, char *target -signal_add_last("message own_public" => sub {check_for_link(\@_,1,2,-1,0);}); +signal_add_last(_bcs("message own_public" => sub {check_for_link(@_)})); # "message private", SERVER_REC, char *msg, char *nick, char *address -signal_add_last("message private" => sub {check_for_link(\@_,1,-1,2,0);}); +signal_add_last(_bcs("message private" => sub {check_for_link(@_)})); # "message own_private", SERVER_REC, char *msg, char *target, char *orig_target -signal_add_last("message own_private" => sub {check_for_link(\@_,1,2,-1,0);}); +signal_add_last(_bcs("message own_private" => sub {check_for_link(@_)})); # "message irc action", SERVER_REC, char *msg, char *nick, char *address, char *target -signal_add_last("message irc action" => sub {check_for_link(\@_,1,4,2,0);}); +signal_add_last(_bcs("message irc action" => sub {check_for_link(@_)})); # "message irc own_action", SERVER_REC, char *msg, char *target -signal_add_last("message irc own_action" => sub {check_for_link(\@_,1,2,-1,0);}); +signal_add_last(_bcs("message irc own_action" => sub {check_for_link(@_)})); + +# For tab completion +# This does not use BettIrssi (yet) +signal_add_first('complete word', \&sig_complete); + +sub push_output { + unshift(@outputstack, shift); +} + +sub pop_output { + shift(@outputstack); + + @outputstack = (undef) unless (@outputstack); +} + +my $videosite_commands = { + 'save' => sub { + cmd_save(); + }, + + 'set' => sub { + cmd_set(@_); + }, + + 'show' => sub { + cmd_show(@_); + }, + + 'help' => sub { + cmd_help(@_); + }, + + 'getter' => sub { + cmd_getter(@_); + }, + + 'enable' => sub { + cmd_enable(@_); + }, + + 'disable' => sub { + cmd_disable(@_); + }, + + 'reload' => sub { + init_videosite(0); + }, + + 'mode' => sub { + cmd_mode(@_); + }, + + 'connector' => sub { + cmd_connector(@_); + }, + + 'debug' => sub { + $debug = 1; + foreach (@grabbers, @getters) { + $_->setdebug(1); + } + write_irssi('Enabled debugging'); + }, + + 'nodebug' => sub { + $debug = 0; + foreach (@grabbers, @getters) { + $_->setdebug(0); + } + write_irssi('Disabled debugging'); + }, +}; sub write_irssi { - my $witem = shift; my @text = @_; + my $output = $outputstack[0]; + + my $format = "%%mvideosite: %%n" . shift(@text); - $text[0] = 'videosite: ' . $text[0]; + # escape % in parameters from irssi + s/%/%%/g foreach @text; - if (defined $witem) { - $witem->print(sprintf(shift(@text), @text), MSGLEVEL_CLIENTCRAP); + if (defined $output) { + $output->(sprintf($format, @text), MSGLEVEL_CLIENTCRAP); } else { - Irssi::print(sprintf(shift(@text), @text)); + Irssi::print(sprintf($format, @text)); } } sub write_debug { if ($debug) { - write_irssi(shift, @_); + write_irssi(@_); } } +sub expand_url_shortener { + my $s = shift; + my $os = ''; + my @urlshortener = ( + 'is\.gd/[[:alnum:]]+', + 'otf\.me/[[:alnum:]]+', + 'hel\.me/[[:alnum:]]+', + '7ax\.de/[[:alnum:]]+', + 'ow\.ly/[[:alnum:]]+', + 'j\.mp/[[:alnum:]]+', + 'bit\.ly/[[:alnum:]]+', + 'tinyurl\.com/[[:alnum:]]+', + 'pop\.is/[[:alnum:]]+', + 'post\.ly/[[:alnum:]]+', + '1\.ly/[[:alnum:]]+', + '2\.ly/[[:alnum:]]+', + 't\.co/[[:alnum:]]+', + 'shar\.es/[[:alnum:]]+', + 'goo\.gl/[[:alnum:]]+', + ); + my $ua = LWP::UserAgent->new(agent => 'Mozilla', max_redirect => 0); + my $i = 10; + + OUTER: while (($os ne $s) and ($i > 0)) { + study($s); + $os = $s; + $i--; + + foreach my $pattern (@urlshortener) { + my $p = "https?:\/\/" . $pattern; + + write_debug("Matching %s against %s", $p, $s); + if ($s =~ m|($p)|) { + my $matched = $1; + my $res; + + write_debug("Found %s", $matched); + $res = $ua->head($matched); + if ($res->is_redirect()) { + my $new = $res->headers()->header("Location"); + + write_debug("Replacing %s with %s", $matched, $new); + $s =~ s/$matched/$new/; + next OUTER; + } else { + write_debug("Error resolving %s", $matched); + } + } + } + } + + if ($i == 0) { + write_debug("Loop terminated by counter"); + } + + write_debug("Final string: %s", $s); + + return $s; +} + +sub connectorlist { + my @c; + + foreach (@{$conf->{'videosite'}->{'connectorlist'}}) { + push(@c, $conf->{'videosite'}->{'connectors'}->{$_}); + } + + return @c; +} + + sub check_for_link { - my ($signal,$parammessage,$paramchannel,$paramnick,$paramserver) = @_; - my $server = $signal->[$paramserver]; - my $target = $signal->[$paramchannel]; - my $message = ($parammessage == -1) ? '' : $signal->[$parammessage]; + my $event = shift; + my $message = $event->message(); + my $witem = $event->channel(); my $g; my $m; my $p; - my $witem; - if (defined $server) { - $witem = $server->window_item_find($target); - } else { - $witem = Irssi::window_item_find($target); - } - # Look if we should ignore this line if ($message =~ m,(?:\s|^)/nosave(?:\s|$),) { return; } + push_output($event->ewpf); + $message = expand_url_shortener($message); + + study($message); + # Offer the message to all Grabbers in turn - foreach $g (@grabbers) { + GRABBER: foreach $g (@grabbers) { ($m, $p) = $g->get($message); while (defined($m)) { - write_debug($witem, 'Metadata: %s', Dumper($m)); + write_debug('Metadata: %s', Dumper($m)); if ('download' eq ($conf->{'videosite'}->{'mode'})) { - write_irssi($witem, '%%R>>> %%NSaving %%Y%s%%N %%G%s', $m->{'SOURCE'}, $m->{'TITLE'}); + write_irssi('%%R>>> %%NSaving %%Y%s%%N %%G%s', $m->{'SOURCE'}, $m->{'TITLE'}); unless($getter->get($m)) { - write_irssi($witem, '%%R>>> FAILED'); + write_irssi('%%R>>> FAILED'); } } elsif ('display' eq ($conf->{'videosite'}->{'mode'})) { - write_irssi($witem, '%%M>>> %%NSaw %%Y%s%%N %%G%s', $m->{'SOURCE'}, $m->{'TITLE'}); + write_irssi('%%M>>> %%NSaw %%Y%s%%N %%G%s', $m->{'SOURCE'}, $m->{'TITLE'}); } else { - write_irssi($witem, '%%R>>> Invalid operation mode'); + write_irssi('%%R>>> Invalid operation mode'); } # Remove the matched part from the message and try again (there may be # more!) $message =~ s/$p//; + study($message); + last GRABBER if ($message =~ /^\s*$/); ($m, $p) = $g->get($message); } } + + pop_output(); } sub cmd_save { + eval { - open(CONF, '>'.$conffile) or die 'Could not open config file'; - print CONF XML::Simple::XMLout($conf, KeepRoot => 1, KeyAttr => {'config' => 'module', 'option' => 'key'}); - close(CONF); + my ($tempfile, $tempfn) = tempfile("videosite.xml.XXXXXX", dir => Irssi::get_irssi_dir()); + print $tempfile XML::Simple::XMLout($conf, KeepRoot => 1, KeyAttr => {'connector' => '+name', 'config' => 'module', 'option' => 'key'}); + close($tempfile); + rename($tempfn, $conffile); }; if ($@) { - write_irssi(undef, 'Could not save config to %s: %s', ($conffile, $@)); + write_irssi('Could not save config to %s: %s', ($conffile, $@)); } else { - write_irssi(undef, 'configuration saved to %s', $conffile); + write_irssi('configuration saved to %s', $conffile); } } @@ -138,7 +303,7 @@ sub cmd_set { return; } } - write_irssi(undef, 'No such module'); + write_irssi('No such module'); } @@ -152,7 +317,7 @@ sub cmd_enable { return; } } - write_irssi(undef, 'No such module'); + write_irssi('No such module'); } @@ -166,7 +331,7 @@ sub cmd_disable { return; } } - write_irssi(undef, 'No such module'); + write_irssi('No such module'); } @@ -178,21 +343,21 @@ sub cmd_show { if (defined($target)) { foreach $p (@getters, @grabbers) { if ($p->{'NAME'} eq $target) { - write_irssi(undef, $p->getconfstr()); + write_irssi($p->getconfstr()); return; } } - write_irssi(undef, 'No such module'); + write_irssi('No such module'); } else { - write_irssi(undef, 'Loaded grabbers (* denotes enabled modules):'); + write_irssi('Loaded grabbers (* denotes enabled modules):'); foreach $p (@grabbers) { $e = $p->_getval('enabled'); - write_irssi(undef, ' %s%s', $p->{'NAME'}, $e?'*':''); + write_irssi(' %s%s', $p->{'NAME'}, $e?'*':''); }; - write_irssi(undef, 'Loaded getters:'); + write_irssi('Loaded getters:'); foreach $p (@getters) { - write_irssi(undef, ' %s', $p->{'NAME'}); + write_irssi(' %s', $p->{'NAME'}); }; } } @@ -204,23 +369,24 @@ sub cmd_help { if (defined($target)) { foreach $p (@getters, @grabbers) { if ($p->{'NAME'} eq $target) { - write_irssi(undef, $p->gethelpstr()); + write_irssi($p->gethelpstr()); return; } } - write_irssi(undef, 'No such module'); + write_irssi('No such module'); } else { - write_irssi(undef, <<'EOT'); + write_irssi(<<'EOT'); Supported commands: - save: Save the current configuration - help [modulename]: Display this help, or module specific help - show [modulename]: Show loaded modules, or the current parameters of a module + save: save the current configuration + help [modulename]: display this help, or module specific help + show [modulename]: show loaded modules, or the current parameters of a module set modulename parameter value: set a module parameter to a new value getter [modulename]: display or set the getter to use enable [modulename]: enable the usage of this module (grabbers only) disable [modulename]: disable the usage of this module (grabbers only) reload: reload all modules (this is somewhat experimental) mode [modename]: display or set the operation mode (download/display) + connector [subcommand]: manage connectors (proxies) debug: enable debugging messages nodebug: disable debugging messages EOT @@ -232,16 +398,17 @@ sub cmd_getter { my $p; if (defined($target)) { - foreach $p (@getters, @grabbers) { - if (($p->{'NAME'} eq $target) && ($p->{'TYPE'} eq 'getter')) { + foreach $p (@getters) { + if ($p->{'NAME'} eq $target) { $getter = $p; $conf->{'videosite'}->{'getter'} = $target; + write_irssi("Getter changed to %s", $target); return; } } - write_irssi(undef, 'No such getter'); + write_irssi('No such getter'); } else { - write_irssi(undef, 'Current getter: %s', $conf->{'videosite'}->{'getter'}); + write_irssi('Current getter: %s', $conf->{'videosite'}->{'getter'}); } } @@ -252,15 +419,179 @@ sub cmd_mode { $mode = lc($mode); if (('download' eq $mode) or ('display' eq $mode)) { $conf->{'videosite'}->{'mode'} = $mode; + write_irssi('Now using %s mode', $mode); } else { - write_irssi(undef, 'Invalid mode: %s', $mode); + write_irssi('Invalid mode: %s', $mode); + } + } else { + write_irssi('Current mode: %s', $conf->{'videosite'}->{'mode'}); + } +} + +sub cmd_connector { + my $subcmd = shift; + my $connconf = $conf->{'videosite'}->{'connectors'}; + + unless(defined($subcmd)) { + $subcmd = "help"; + } + + $subcmd = lc($subcmd); + + if ($subcmd eq 'list') { + write_irssi("Defined connectors"); + foreach (keys(%{$connconf})) { + write_irssi($_); + my $schemas = $connconf->{$_}->{'schemas'}; + if (scalar(keys(%{$schemas})) == 0) { + write_irssi(" No schemas defined"); + } else { + foreach (keys(%{$schemas})) { + write_irssi(' %s: %s', $_, $schemas->{$_}); + } + } + } + + write_irssi(); + write_irssi("Selected connectors: %s", join(", ", @{$conf->{'videosite'}->{'connectorlist'}})); + } elsif ($subcmd eq 'add') { + my ($name) = @_; + + unless(defined($name)) { + write_irssi("No name given"); + return; + } + + $name = lc($name); + + if (exists($connconf->{$_})) { + write_irssi("Connector already exists"); + return; + } + + $connconf->{$name} = {'name' => $name, 'schemas' => {}}; + } elsif ($subcmd eq 'del') { + my ($name) = @_; + + unless(defined($name)) { + write_irssi("No name given"); + return; + } + + $name = lc($name); + + unless (exists($connconf->{$name})) { + write_irssi("Connector does not exist"); + return; + } + + if (exists($connconf->{$name}->{'_immutable'})) { + write_irssi("Connector cannot be removed"); + return; + } + + delete($connconf->{$name}); + + # Remove from list of active connectors + $conf->{'videosite'}->{'connectorlist'} = + [ grep { $_ ne $name } @{$conf->{'videosite'}->{'connectorlist'}} ]; + + if (scalar(@{$conf->{'videosite'}->{'connectorlist'}}) == 0) { + write_irssi("List of selected connectors is empty, resetting to direct"); + $conf->{'videosite'}->{'connectorlist'} = [ 'direct' ]; + } + } elsif ($subcmd eq 'addschema') { + my ($conn, $schema, $proxy) = @_; + + unless(defined($conn)) { + write_irssi("No connector name given"); + return; + } + + $conn = lc($conn); + + if (exists($connconf->{$conn}->{'_immutable'})) { + write_irssi("Connector cannot be modified"); + return; + } + + unless(defined($schema)) { + write_irssi("No schema given"); + return; + } + + $schema = lc($schema); + + unless(defined($proxy)) { + write_irssi("No proxy given"); + return; } + + unless(exists($connconf->{$conn})) { + write_irssi("Connector does not exist"); + return; + } + + $connconf->{$conn}->{'schemas'}->{$schema} = $proxy; + } elsif ($subcmd eq 'delschema') { + my ($conn, $schema) = @_; + + unless(defined($conn)) { + write_irssi("No connector name given"); + return; + } + + $conn = lc($conn); + + if (exists($connconf->{$conn}->{'_immutable'})) { + write_irssi("Connector cannot be modified"); + return; + } + + unless(defined($schema)) { + write_irssi("No schema given"); + return; + } + + $schema = lc($schema); + + unless(exists($connconf->{$conn})) { + write_irssi("Connector does not exist"); + return; + } + + delete($connconf->{$conn}->{'schemas'}->{$schema}); + } elsif ($subcmd eq 'select') { + my @connlist = map { lc } @_; + + if (scalar(@connlist) == 0) { + write_irssi("No connectors given"); + return; + } + + foreach (@connlist) { + unless(exists($connconf->{$_})) { + write_irssi("Connector %s does not exist", $_); + return; + } + } + + $conf->{'videosite'}->{'connectorlist'} = [ @connlist ]; } else { - write_irssi(undef, 'Current mode: %s', $conf->{'videosite'}->{'mode'}); + write_irssi("connector [list|add|del|addschema|delschema|help] "); + write_irssi(" help: Show this help"); + write_irssi(" list: List the defined connectors"); + write_irssi(" add : Add a connector with name "); + write_irssi(" del : Delete the connector with name "); + write_irssi(" addschema : Add proxy to connector for the given schema"); + write_irssi(" delschema : Remove the schema from the connector"); + write_irssi(" select [...]: Select the connectors to use"); } } + + # save on unload sub sig_command_script_unload { my $script = shift; @@ -284,32 +615,33 @@ sub ploader { closedir(D); foreach $p (@list) { - write_debug(undef, "Trying to load $p:"); + write_debug("Trying to load $p:"); $p =~ s/\.pm$//; - eval qq{ require $p; }; + eval qq{ require videosite::$p; }; if ($@) { - write_debug(undef, "Failed to load plugin: $@"); + write_irssi("Failed to load plugin: $@"); next; } - $g = eval $p.q{->new();}; + $g = eval qq{ videosite::$p->new(); }; if ($@) { - write_debug(undef, "Failed to instanciate: $@"); + write_irssi("Failed to instanciate: $@"); delete($INC{$p}); next; } - write_debug(undef, "found $g->{'TYPE'} $g->{'NAME'}"); + write_debug("found $g->{'TYPE'} $g->{'NAME'}"); if ($type eq $g->{'TYPE'}) { push(@g, $g); - $g->setio(sub {Irssi::print(shift)}); + $g->setio(\&write_irssi); + $g->setconn(\&connectorlist); } else { - write_irssi(undef, '%s has wrong type (got %s, expected %s)', $p, $g->{'TYPE'}, $type); + write_irssi('%s has wrong type (got %s, expected %s)', $p, $g->{'TYPE'}, $type); delete($INC{$p}); } } - write_debug(undef, "Loaded %d plugins", $#g+1); + write_debug("Loaded %d plugins", $#g+1); return @g; } @@ -320,7 +652,7 @@ sub _load_modules($) { foreach (keys(%INC)) { if ($INC{$_} =~ m|^$path|) { - write_debug(undef, "Removing %s from \$INC", $_); + write_debug("Removing %s from \$INC", $_); delete($INC{$_}); } } @@ -334,9 +666,9 @@ sub init_videosite { my $bindings = shift; my $p; - unless(-r $conffile && defined($conf = XML::Simple::XMLin($conffile, ForceArray => ['config', 'option'], KeepRoot => 1, KeyAttr => {'config' => 'module', 'option' => 'key'}))) { + unless(-r $conffile && defined($conf = XML::Simple::XMLin($conffile, ForceArray => ['config', 'option', 'connectorlist'], KeepRoot => 1, KeyAttr => {'connector' => '+name', 'config' => 'module', 'option' => 'key'}))) { # No config, start with an empty one - write_debug(undef, 'No config found, using defaults'); + write_debug('No config found, using defaults'); $conf = { 'videosite' => { }}; } foreach (keys(%{$PARAMS})) { @@ -345,10 +677,20 @@ sub init_videosite { } } + # Make sure there is a connector called 'direct', which defines no + # proxies + unless (exists($conf->{'videosite'}->{'connectors'}->{'direct'})) { + $conf->{'videosite'}->{'connectors'}->{'direct'} = { + 'name' => 'direct', + '_immutable' => '1', + 'schemas' => {}, + }; + } + _load_modules($plugindir); unless (defined(@grabbers) && defined(@getters)) { - write_irssi(undef, 'No grabbers or no getters found, can not proceed.'); + write_irssi('No grabbers or no getters found, can not proceed.'); return; } @@ -358,7 +700,7 @@ sub init_videosite { $getter = $p; } } - write_debug(undef, 'Selected %s as getter', $getter->{'NAME'}); + write_debug('Selected %s as getter', $getter->{'NAME'}); $conf->{'videosite'}->{'getter'} = $getter->{'NAME'}; # Loop through all plugins and load the config @@ -373,55 +715,68 @@ sub init_videosite { Irssi::signal_add('setup saved', 'cmd_save'); - Irssi::command_bind('videosite' => \&cmdhandler); + Irssi::command_bind(_bcb('videosite' => \&cmdhandler)); } - write_irssi(undef, 'videosite initialized'); + write_irssi('initialized successfully'); } -sub cmdhandler { - my ($data, $server, $item) = @_; - my @params = split(/\s+/, $data); +sub sig_complete { + my ($complist, $window, $word, $linestart, $want_space) = @_; + my @matches; - if ($params[0] eq 'save') { - cmd_save(); - } elsif ($params[0] eq 'set') { - shift(@params); - cmd_set(@params); - } elsif ($params[0] eq 'show') { - shift(@params); - cmd_show(@params); - } elsif ($params[0] eq 'help') { - shift(@params); - cmd_help(@params); - } elsif ($params[0] eq 'getter') { - shift(@params); - cmd_getter(@params); - } elsif ($params[0] eq 'enable') { - shift(@params); - cmd_enable(@params); - } elsif ($params[0] eq 'disable') { - shift(@params); - cmd_disable(@params); - } elsif ($params[0] eq 'reload') { - init_videosite(0); - } elsif ($params[0] eq 'mode') { - shift(@params); - cmd_mode(@params); - } elsif ($params[0] eq 'debug') { - $debug = 1; + if ($linestart !~ m|^/videosite\b|) { + return; + } + + if ('/videosite' eq $linestart) { + # No command enterd so far. Produce a list of possible follow-ups + @matches = grep {/^$word/} keys (%{$videosite_commands}); + } elsif ('/videosite set' eq $linestart) { + # 'set' command entered. Produce a list of modules foreach (@grabbers, @getters) { - $_->setdebug(1); + push(@matches, $_->{'NAME'}) if $_->{'NAME'} =~ m|^$word|; + }; + } elsif ($linestart =~ m|^/videosite set (\w+)$|) { + my $module = $1; + + foreach my $p (@getters, @grabbers) { + if ($p->{'NAME'} eq $module) { + @matches = $p->getparamlist($word); + last; + } } - write_irssi(undef, 'Enabled debugging'); - } elsif ($params[0] eq 'nodebug') { - $debug = 0; - foreach (@grabbers, @getters) { - $_->setdebug(0); + } elsif ($linestart =~ m|/videosite set (\w+) (\w+)$|) { + my $module = $1; + my $param = $2; + + foreach my $p (@getters, @grabbers) { + if ($p->{'NAME'} eq $module) { + @matches = $p->getparamvalues($param, $word); + last; + } } - write_irssi(undef, 'Disabled debugging'); } + + + push(@{$complist}, sort @matches); + ${$want_space} = 0; + + Irssi::signal_stop(); +} + +sub cmdhandler { + my $event = shift; + my ($cmd, @params) = split(/\s+/, $event->message()); + + push_output($event->ewpf); + + if (exists($videosite_commands->{$cmd})) { + $videosite_commands->{$cmd}->(@params); + } + + pop_output(); } -unshift(@INC, $plugindir); +unshift(@INC, $scriptdir); init_videosite(1);