X-Git-Url: https://git.camperquake.de/gitweb.cgi?p=videosite.git;a=blobdiff_plain;f=libvideosite.pm;h=f9959bfc5602ac7072f7c49398ca4ef8cef928d7;hp=49208019abfb2e6326e673d34824984d6e3bf1ec;hb=HEAD;hpb=fc449da24ace2ba9ec5304afaae579d9fe55e967

diff --git a/libvideosite.pm b/libvideosite.pm
index 4920801..f9959bf 100644
--- a/libvideosite.pm
+++ b/libvideosite.pm
@@ -1,3 +1,12 @@
+# library to autodownload flash videos
+#
+# (c) 2007-2008 by Ralf Ertzinger <ralf@camperquake.de>
+# licensed under GNU GPL v2
+#
+# Based on youtube.pl by Christian Garbs <mitch@cgarbs.de>
+# which in turn is
+# based on trigger.pl by Wouter Coekaerts <wouter@coekaerts.be>
+
 package libvideosite;
 require Exporter;
 
@@ -8,6 +17,8 @@ use LWP::UserAgent;
 use Data::Dumper;
 use File::Basename;
 use Cwd qw(realpath);
+use JSON -support_by_pp;
+use File::Temp qw(tempfile);
 use strict;
 
 @ISA = qw(Exporter);
@@ -16,10 +27,15 @@ use strict;
 my @outputstack;
 my $outputprefix;
 my $debug = 0;
+my %debugwindows = ();
 my @grabbers;
 my @getters;
 my $getter;
 my %builtin_config = ();
+my $builtin_config_path;
+my $builtin_config_default;
+my $config_cache = 1;
+my %config_cache = ();
 our $error;
 
 #
@@ -36,8 +52,33 @@ my $defaultconfig = {
             'name' => 'direct',
             '_immutable' => '1',
             'schemas' => {},
-        }
-    }
+        },
+        'environment' => {
+            'name' => 'environment',
+            '_immutable' => '1',
+            'schemas' => {},
+        },
+    },
+    'config-version' => '2',
+};
+
+#
+# This is a list of default values for the remote API. These
+# are used if the values are not registered by the library user.
+#
+my $remote_api = {
+    io => sub { print @_, "\n" },
+    config_init => \&_builtin_config_init,
+    config_get => \&_builtin_config_get,
+    config_set => \&_builtin_config_set,
+    config_has => \&_builtin_config_has,
+    config_save => \&_builtin_config_save,
+    config_del => \&_builtin_config_del,
+    color => sub { return '' },
+    module_path => sub { return dirname(realpath($0)) },
+    quote => sub { return $_ },
+    reload => sub {},
+    wait_for_child => sub {},
 };
 
 #
@@ -51,7 +92,7 @@ my $videosite_commands = {
     'set' => sub {
         _cmd_set(@_);
     },
-    
+
     'show' => sub {
         _cmd_show(@_);
     },
@@ -73,7 +114,7 @@ my $videosite_commands = {
     },
 
     'reload' => sub {
-        init();
+        $remote_api->{reload}->();
     },
 
     'mode' => sub {
@@ -85,37 +126,16 @@ my $videosite_commands = {
     },
 
     'debug' => sub {
-        $debug = 1;
-        foreach (@grabbers, @getters) {
-            $_->setdebug(1);
-        }
-        _io('Enabled debugging');
+        _cmd_debug(@_);
     },
 
     'nodebug' => sub {
-        $debug = 0;
-        foreach (@grabbers, @getters) {
-            $_->setdebug(0);
-        }
-        _io('Disabled debugging');
+        _cmd_nodebug(@_);
     },
-};
 
-#
-# This is a list of default values for the remote API. These
-# are used if the values are not registered by the library user.
-#
-my $remote_api = {
-    io => sub { print @_, "\n" },
-    config_init => \&_builtin_config_init,
-    config_get => \&_builtin_config_get,
-    config_set => \&_builtin_config_set,
-    config_has => \&_builtin_config_has,
-    config_save => \&_builtin_config_save,
-    config_del => \&_builtin_config_del,
-    color => sub { return '' },
-    module_path => sub { return dirname(realpath($0)) },
-    quote => sub { return $_ },
+    'service' => sub {
+        _cmd_service(@_);
+    },
 };
 
 #
@@ -130,11 +150,13 @@ sub _io {
     my @text = @_;
     my $format;
 
+    @text = ('') unless(@text);
+
     # This will define the outputprefix once, so we don't have
     # do do this every time.
-    $outputprefix //= sprintf("%svideosite: %s",
-        $remote_api->{color}->('magenta'),
-        $remote_api->{color}->());
+    $outputprefix = sprintf("%svideosite: %s",
+        _colorpair('magenta'),
+        _colorpair()) unless(defined($outputprefix));
     $format = $outputprefix . shift(@text);
 
     #
@@ -143,7 +165,7 @@ sub _io {
     #
     @text = map { defined($_)?$remote_api->{quote}->($_):'(undef)' } @text;
 
-    $outputstack[0]->(sprintf($format, @text));
+    $outputstack[0]->{io}->(sprintf($format, @text));
 }
 
 #
@@ -171,6 +193,9 @@ sub _recursive_hash_walk {
 sub _colorpair {
     my ($fg, $bg) = @_;
 
+    $fg = defined($fg)?$fg:'default';
+    $bg = defined($bg)?$bg:'default';
+
     return $remote_api->{color}->($fg, $bg);
 }
 
@@ -181,8 +206,8 @@ sub _init_config_item {
     my $path = shift;
     my $value = shift;
 
-    unless($remote_api->{config_has}->($path)) {
-        $remote_api->{config_set}->($path, $value);
+    unless(_config_has($path)) {
+        _config_set($path, $value);
     }
 }
 
@@ -190,8 +215,18 @@ sub _init_config_item {
 # Print a message if debug is enabled
 #
 sub _debug {
+    my @data = @_;
+
+    $data[0] = "DEBUG: " . $data[0];
+
+    # Check for global debug
     if ($debug) {
-        _io(@_);
+        _io(@data);
+    } else {
+        # Check if current window is in the per-window-debug list
+        if (exists($debugwindows{$outputstack[0]->{window}})) {
+            _io(@data);
+        }
     }
 }
 
@@ -237,12 +272,13 @@ sub _ploader {
             push(@g, $g);
             $g->register_api({
                 io => \&_io,
+                io_debug => \&_debug,
                 connectors => sub { return _connectorlist('active-connectors') },
                 config_get => \&_config_get,
                 config_set => \&_config_set,
                 config_has => \&_config_has,
+		wait_for_child => $remote_api->{wait_for_child},
             });
-            $g->setdebug($debug);
         } else {
             _io('%s has wrong type (got %s, expected %s)', $p, $g->{'TYPE'}, $type);
             delete($INC{$p});
@@ -250,7 +286,7 @@ sub _ploader {
     }
 
     _debug("Loaded %d plugins", $#g+1);
-    
+
     return @g;
 }
 
@@ -278,32 +314,56 @@ sub _load_modules($) {
 #
 sub _config_get {
     my $path = shift;
+    my $dotpath = join('.', @{$path});
     my $value;
 
-    $value = $remote_api->{config_get}->($path);
-    _debug("config: getting %s=%s", join('.', @{$path}), $value);
+    if ($config_cache && exists($config_cache{$dotpath}) && exists($config_cache{$dotpath}->{value})) {
+        $value = $config_cache{$dotpath}->{value};
+    } else {
+        $value = $remote_api->{config_get}->($path);
+        $config_cache{$dotpath} = {value => $value, has => 1};
 
+    }
+
+    _debug("config: getting %s=%s", $dotpath, $value);
     return $value;
 }
 
 sub _config_set {
     my $path = shift;
+    my $dotpath = join('.', @{$path});
     my $value = shift;
 
-    _debug("config: setting %s=%s", join('.', @{$path}), $value);
+    _debug("config: setting %s=%s", $dotpath, $value);
+    $config_cache{$dotpath} = {value => $value, has => 1};
     return $remote_api->{config_set}->($path, $value);
 }
 
 sub _config_has {
     my $path = shift;
+    my $dotpath = join('.', @{$path});
     my $b;
 
-    $b = $remote_api->{config_has}->($path);
-    _debug("config: testing %s (%s)", join('.', @{$path}), $b?'true':'false');
+    if ($config_cache && exists($config_cache{$dotpath}) && exists($config_cache{$dotpath}->{has})) {
+        $b = $config_cache{$dotpath}->{has};
+    } else {
+        $b = $remote_api->{config_has}->($path);
+        $config_cache{$dotpath}->{has} = $b;
+    }
 
+    _debug("config: testing %s (%s)", $dotpath, $b?'true':'false');
     return $b;
 }
 
+sub _config_del {
+    my $path = shift;
+    my $dotpath = join('.', @{$path});
+
+    _debug("config: removing %s", $dotpath);
+    delete($config_cache{$dotpath});
+    $remote_api->{config_del}->($path);
+}
+
 #
 # The _config_list_* are helper functions taking a path to a comma separated
 # string. The string is interpreted as a list and the action performed
@@ -324,7 +384,7 @@ sub _config_list_add {
         @c = ();
     }
 
-    _debug("Adding %s to list %s", $item, join(".", $path));
+    _debug("Adding %s to list %s", $item, join(".", @{$path}));
     unless(grep { $_ eq $item } @c) {
         push(@c, $item);
     };
@@ -332,7 +392,7 @@ sub _config_list_add {
     _config_set($path, join(',', @c));
 }
 
-# 
+#
 # Remove an item from the list
 #
 sub _config_list_del {
@@ -344,10 +404,10 @@ sub _config_list_del {
         return;
     }
 
-    _debug("Removing %s from list %s", $item, join('.', $path));
-    @c = map { $item ne $_ } split(/\s*,\s*/, _config_get($path));
+    _debug("Removing %s from list %s", $item, join('.', @{$path}));
+    @c = grep { $item ne $_ } split(/\s*,\s*/, _config_get($path));
 
-    _config_set($path, join('.', @c));
+    _config_set($path, join(',', @c));
 }
 
 #
@@ -361,7 +421,7 @@ sub _config_list_has {
         return 0;
     }
 
-    _debug("Checking for %s in list %s",  $item, join('.', $path));
+    _debug("Checking for %s in list %s",  $item, join('.', @{$path}));
 
     return grep { $item eq $_ } split(/\s*,\s*/, _config_get($path));
 }
@@ -372,7 +432,7 @@ sub _config_list_has {
 sub _config_list_set {
     my $path = shift;
 
-    _debug("Replacing %s with (%s)", join('.', $path), join(",", @_));
+    _debug("Replacing %s with (%s)", join('.', @{$path}), join(",", @_));
 
     _config_set($path, join(',', @_));
 }
@@ -500,13 +560,20 @@ sub _expand_url_shortener {
 # Save the config to durable storage
 #
 sub _cmd_save {
-    $remote_api->{config_save}->();
+    my $event = shift;
+
+    if ($remote_api->{config_save}->()) {
+        _io("Config saved");
+    } else {
+        _io(sprintf("%sConfig save failed%s", _colorpair("*red"), _colorpair()));
+    }
 }
 
 #
 # Set a configuration element
 #
 sub _cmd_set {
+    my $event = shift;
     my $target = shift;
     my $key = shift;
     my $val = shift;
@@ -526,6 +593,7 @@ sub _cmd_set {
 # Enable a given module
 #
 sub _cmd_enable {
+    my $event = shift;
     my $target = shift;
     my $p;
 
@@ -542,6 +610,7 @@ sub _cmd_enable {
 # Disable given module
 #
 sub _cmd_disable {
+    my $event = shift;
     my $target = shift;
     my $p;
 
@@ -558,6 +627,7 @@ sub _cmd_disable {
 # Show settings for modules
 #
 sub _cmd_show {
+    my $event = shift;
     my $target = shift;
     my $p;
     my $e;
@@ -588,6 +658,7 @@ sub _cmd_show {
 # Show help for the commands
 #
 sub _cmd_help {
+    my $event = shift;
     my $target = shift;
     my $p;
 
@@ -622,6 +693,7 @@ EOT
 # Set the getter to use
 #
 sub _cmd_getter {
+    my $event = shift;
     my $target = shift;
     my $p;
 
@@ -644,6 +716,7 @@ sub _cmd_getter {
 # Show/set the working mode
 #
 sub _cmd_mode {
+    my $event = shift;
     my $mode = shift;
 
     if (defined($mode)) {
@@ -664,6 +737,7 @@ sub _cmd_mode {
 # Manage the connectors
 #
 sub _cmd_connector {
+    my $event = shift;
     my $subcmd = shift;
     my $c;
 
@@ -699,6 +773,11 @@ sub _cmd_connector {
 
         $name = lc($name);
 
+        unless($name =~ m|^[a-z]+$|) {
+            _io("%s is not a valid connector name (only letters are allowed)", $name);
+            return;
+        }
+
         if (_config_list_has(['defined-connectors'], $name)) {
             _io("Connector already exists");
             return;
@@ -715,7 +794,7 @@ sub _cmd_connector {
             return;
         }
 
-        unless (_config_list_has(['defined-connectors'])) {
+        unless (_config_list_has(['defined-connectors'], $name)) {
             _io("Connector does not exist");
             return;
         }
@@ -821,6 +900,85 @@ sub _cmd_connector {
 }
 
 #
+# Enable debug.
+# Global debug if the keyword "all" is given, or just for the
+# current window otherwise
+#
+sub _cmd_debug {
+    my $event = shift;
+    my $scope = shift;
+
+    if (defined($scope) and (lc($scope) eq 'all')) {
+        _io("Global debug enabled");
+        $debug = 1;
+    } else {
+        _io("Debug for this window enabled");
+        $debugwindows{$event->{window}} = 1;
+    }
+}
+
+#
+# Disable debug
+# Disable global debug if the keyword "all" is given (this will
+# also disable all per-window debugs) or just for the current
+# window
+#
+sub _cmd_nodebug {
+    my $event = shift;
+    my $scope = shift;
+
+    if (defined($scope) and (lc($scope) eq 'all')) {
+        $debug = 0;
+        %debugwindows = ();
+        _io("Global debug disabled");
+    } else {
+        delete($debugwindows{$event->{window}});
+        _io("Debug for this window disabled");
+    }
+}
+
+#
+# Handle generic service commands
+#
+sub _cmd_service {
+    my $event = shift;
+    my $subcmd = shift || '';
+
+    $subcmd = lc($subcmd);
+
+    if ($subcmd eq 'cache') {
+        _cmd_service_cache($event, @_);
+    }
+}
+
+
+#
+# Display or clear the content of the config cache
+#
+sub _cmd_service_cache {
+    my $event = shift;
+    my $subcmd = shift;
+
+    $subcmd = 'list' unless defined($subcmd);
+    $subcmd = lc($subcmd);
+
+    if ($subcmd eq 'list') {
+        _io("Content of config cache:");
+        foreach (sort(keys(%config_cache))) {
+            if (exists($config_cache{$_}->{value})) {
+                _io(" %s => %s", $_, $config_cache{$_}->{value});
+            } else {
+                _io(" %s present", $_);
+            }
+        }
+    } elsif ($subcmd eq 'clear') {
+        %config_cache = ();
+        _io("Cache cleared");
+    }
+}
+
+
+#
 # Return the list of loaded grabbers.
 # This is used by the test programs, and is not meant to be
 # used in general.
@@ -837,6 +995,29 @@ sub _grabbers {
 # ==============================================
 #
 sub _builtin_config_init {
+
+    if (defined($builtin_config_path)) {
+        my $filename = File::Spec->catfile($builtin_config_path, 'videosite.json');
+
+        _debug("Trying to load configuration from %s", $filename);
+
+        if (-r $filename) {
+            eval {
+                local $/;
+                open(CONF, '<', $filename);
+                %builtin_config = %{JSON->new->utf8->decode(<CONF>)};
+                close(CONF);
+            } or do {
+                _io("Error loading configuration: %s", $@);
+            }
+        };
+    } elsif (defined($builtin_config_default)) {
+        _debug("Initializing builtin config from external default");
+        foreach (keys(%{$builtin_config_default})) {
+            _debug("Setting %s=%s", $_, $builtin_config_default->{$_});
+            $builtin_config{$_} = $builtin_config_default->{$_};
+        }
+    }
 }
 
 sub _builtin_config_get {
@@ -852,6 +1033,23 @@ sub _builtin_config_has {
 }
 
 sub _builtin_config_save {
+
+    if (defined($builtin_config_path)) {
+        my $filename = File::Spec->catfile($builtin_config_path, 'videosite.json');
+
+        _debug("Attempting to save config to %s", $filename);
+
+        eval {
+            my ($tempfile, $tempfn) = tempfile("videosite.json.XXXXXX", dir => $builtin_config_path);
+            print $tempfile JSON->new->pretty->utf8->encode(\%builtin_config);
+            close($tempfile);
+            rename($tempfn, $filename);
+        } or do {
+            return 0;
+        }
+    }
+
+    return 1;
 }
 
 sub _builtin_config_del {
@@ -950,7 +1148,19 @@ sub register_api {
         $debug = $a->{_debug}->();
     }
 
-    @outputstack = ($remote_api->{'io'});
+    if (exists($a->{_config_path})) {
+        $builtin_config_path = $a->{_config_path}->();
+    }
+
+    if (exists($a->{_config_default})) {
+        $builtin_config_default = $a->{_config_default}->();
+    }
+
+    if (exists($a->{_config_cache})) {
+        $config_cache = $a->{_config_cache}->();
+    }
+
+    @outputstack = ({io => $remote_api->{'io'}, window => ""});
 
     return 1;
 }
@@ -964,14 +1174,19 @@ sub check_for_link {
     my $g;
     my $m;
     my $p;
+    my $skip;
+    my $mode = _config_get(['mode']);
 
 
-    # Look if we should ignore this line
+    #
+    # If /nosave is present in the message switch to display mode, regardless
+    # of config setting
+    #
     if ($message =~ m,(?:\s|^)/nosave(?:\s|$),) {
-        return;
+        $mode = 'display';
     }
 
-    _push_output($event->{ewpf});
+    _push_output($event);
     $message = _expand_url_shortener($message);
 
     study($message);
@@ -981,38 +1196,41 @@ sub check_for_link {
         ($m, $p) = $g->get($message);
         while (defined($m)) {
             _debug('Metadata: %s', Dumper($m));
+            $skip = 0;
             if (exists($remote_api->{link_callback})) {
-                $remote_api->{link_callback}->($m);
+                $skip = $remote_api->{link_callback}->($m);
             }
-            if ('download' eq _config_get(['mode'])) {
-                _io(
-                    sprintf('%s>>> %sSaving %s%%s%s %s%%s',
-                        $remote_api->{color}->('*red'),
-                        $remote_api->{color}->(),
-                        $remote_api->{color}->('*yellow'),
-                        $remote_api->{color}->(),
-                        $remote_api->{color}->('*green'),
-                    ),
-                    $m->{'SOURCE'},
-                    $m->{'TITLE'}
-                );
-                unless($getter->get($m)) {
-                    _io(sprintf('%s>>> FAILED', $remote_api->{color}->('*red')));
+            unless($skip) {
+                if ('download' eq $mode) {
+                    _io(
+                        sprintf('%s>>> %sSaving %s%%s%s %s%%s',
+                            _colorpair('*red'),
+                            _colorpair(),
+                            _colorpair('*yellow'),
+                            _colorpair(),
+                            _colorpair('*green'),
+                        ),
+                        $m->{'SOURCE'},
+                        $m->{'TITLE'}
+                    );
+                    unless($getter->get($m)) {
+                        _io(sprintf('%s>>> FAILED', _colorpair('*red')));
+                    }
+                } elsif ('display' eq $mode) {
+                    _io(
+                        sprintf('%s>>> %sSaw %s%%s%s %s%%s',
+                            _colorpair('*magenta'),
+                            _colorpair(),
+                            _colorpair('*yellow'),
+                            _colorpair(),
+                            _colorpair('*green')
+                        ),
+                        $m->{'SOURCE'},
+                        $m->{'TITLE'}
+                    );
+                } else {
+                    _io(sprintf('%s>>> Invalid operation mode', _colorpair('*red')));
                 }
-            } elsif ('display' eq _config_get(['mode'])) {
-                _io(
-                    sprintf('%s>>> %sSaw %s%%s%s %s%%s',
-                        $remote_api->{color}->('*magenta'),
-                        $remote_api->{color}->(),
-                        $remote_api->{color}->('*yellow'),
-                        $remote_api->{color}->(),
-                        $remote_api->{color}->('*green')
-                    ),
-                    $m->{'SOURCE'},
-                    $m->{'TITLE'}
-                );
-            } else {
-                _io(sprintf('%s>>> Invalid operation mode', $remote_api->{color}->('*red')));
             }
 
             # Remove the matched part from the message and try again (there may be
@@ -1035,10 +1253,10 @@ sub handle_command {
     my $event = shift;
     my ($cmd, @params) = split(/\s+/, $event->{message});
 
-    _push_output($event->{ewpf});
+    _push_output($event);
 
     if (exists($videosite_commands->{$cmd})) {
-        $videosite_commands->{$cmd}->(@params);
+        $videosite_commands->{$cmd}->($event, @params);
     }
 
     _pop_output();