+# 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;
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);
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;
#
'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 {},
};
#
'set' => sub {
_cmd_set(@_);
},
-
+
'show' => sub {
_cmd_show(@_);
},
},
'reload' => sub {
- init();
+ $remote_api->{reload}->();
},
'mode' => sub {
},
'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(@_);
+ },
};
#
# 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}->()) unless(defined($outputprefix));
+ _colorpair('magenta'),
+ _colorpair()) unless(defined($outputprefix));
$format = $outputprefix . shift(@text);
#
#
@text = map { defined($_)?$remote_api->{quote}->($_):'(undef)' } @text;
- $outputstack[0]->(sprintf($format, @text));
+ $outputstack[0]->{io}->(sprintf($format, @text));
}
#
sub _colorpair {
my ($fg, $bg) = @_;
+ $fg = defined($fg)?$fg:'default';
+ $bg = defined($bg)?$bg:'default';
+
return $remote_api->{color}->($fg, $bg);
}
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);
}
}
# 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);
+ }
}
}
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});
}
_debug("Loaded %d plugins", $#g+1);
-
+
return @g;
}
#
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
@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);
};
_config_set($path, join(',', @c));
}
-#
+#
# Remove an item from the list
#
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));
}
#
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));
}
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(',', @_));
}
# 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;
# Enable a given module
#
sub _cmd_enable {
+ my $event = shift;
my $target = shift;
my $p;
# Disable given module
#
sub _cmd_disable {
+ my $event = shift;
my $target = shift;
my $p;
# Show settings for modules
#
sub _cmd_show {
+ my $event = shift;
my $target = shift;
my $p;
my $e;
# Show help for the commands
#
sub _cmd_help {
+ my $event = shift;
my $target = shift;
my $p;
# Set the getter to use
#
sub _cmd_getter {
+ my $event = shift;
my $target = shift;
my $p;
# Show/set the working mode
#
sub _cmd_mode {
+ my $event = shift;
my $mode = shift;
if (defined($mode)) {
# Manage the connectors
#
sub _cmd_connector {
+ my $event = shift;
my $subcmd = shift;
my $c;
$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;
return;
}
- unless (_config_list_has(['defined-connectors'])) {
+ unless (_config_list_has(['defined-connectors'], $name)) {
_io("Connector does not exist");
return;
}
}
#
+# 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.
# ==============================================
#
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 {
}
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 {
$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;
}
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);
($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
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();