1 # (c) 2007 by Ralf Ertzinger <ralf@camperquake.de>
2 # licensed under GNU GPL v2
4 package videosite::Base;
13 my $self = {'_DEBUG' => 0,
14 '_CONNECTOR' => undef,
16 io => sub { printf(@_) },
17 connectors => sub { return ({ 'name' => 'direct',
23 # Add the 'enabled' property to all modules
24 $self->{_PARAMS}->{enabled} = [1, 'Whether the module is enabled'];
34 $data[0] = "(" . ref($self) . ") " . $data[0];
36 $self->{_API}->{io}->(@data);
43 $data[0] = "DEBUG: " . $data[0];
44 if ($self->{'_DEBUG'} != 0) {$self->error(@data)};
52 $val = $self->{'_CONFIG'}->{'option'}->{$key}->{'content'};
53 $self->debug('Returning %s=%s', $key, $val);
63 if (exists($self->{'_CONFIG'}->{'option'}->{$key})) {
64 $self->{'_CONFIG'}->{'option'}->{$key}->{'content'} = $val;
66 $self->error('Module %s does not have a parameter named %s', $self->{'NAME'}, $key);
72 my $s = 'Options for ' . $self->{'NAME'} . ":\n";
76 foreach $k (keys(%{$self->{'_CONFIG'}->{'option'}})) {
77 $p = $self->{'_CONFIG'}->{'option'}->{$k}->{'content'};
79 $s .= sprintf(" %s: %s", $k, $p);
80 if ($self->{'_CONFIG'}->{'option'}->{$k}->{'content'} eq $self->{'_PARAMS'}->{$k}->[0]) {
90 # Return a list of the parameters supported by the module
91 # Does not return the 'enabled' parameter
96 return grep {$_ ne 'enabled' && /^$word/} keys %{$self->{'_PARAMS'}};
99 # Return a list of valid parameter values, if the parameter has
106 unless(exists($self->{'_PARAMS'}->{$param}->[2])) {
109 return grep {/^$word/} keys %{$self->{'_PARAMS'}->{$param}->[2]};
116 my $s = 'Help for ' . $self->{'NAME'} . ":\n";
120 if (exists($self->{'DESC'})) {
121 $s .= "Description:\n " . $self->{'DESC'};
125 foreach $k (keys(%{$self->{'_CONFIG'}->{'option'}})) {
126 $p = $self->{'_PARAMS'}->{$k}->[0];
128 if (exists($self->{'_PARAMS'}->{$k}->[2])) {
129 # The parameter has a list of allowed values. Add the keys and their help
130 $s .= sprintf(" %s: %s (default: %s)\n", $k, $self->{'_PARAMS'}->{$k}->[1], $p);
131 foreach (sort keys(%{$self->{'_PARAMS'}->{$k}->[2]})) {
132 $s .= sprintf(" %s: %s\n", $_, $self->{'_PARAMS'}->{$k}->[2]->{$_});
135 # The parameter just has a default value and a help text
136 $s .= sprintf(" %s: %s (default: %s)\n", $k, $self->{'_PARAMS'}->{$k}->[1], $p);
146 $self->{'_DEBUG'} = shift;
153 $ua = LWP::UserAgent->new(
154 'agent' => 'Mozilla/5.0',
155 'cookie_jar' => HTTP::Cookies->new,
159 # Remove a currently defined HTTPS proxy. See below for a longer explanation.
160 delete($ENV{'HTTPS_PROXY'});
162 if (defined($self->{'_CONNECTOR'})) {
163 my $schemas = $self->{'_CONNECTOR'}->{'schemas'};
164 foreach (keys(%{$schemas})) {
165 $self->debug("Adding schema %s with proxy %s", $_, $schemas->{$_});
167 # OK, so here's the gist.
169 # The usual way of reqesting an HTTPS URL through a proxy is
170 # to connect to the proxy server, issue a CONNECT request to
171 # create a channel to the web server and start an SSL session over
172 # this channel, so there is an end-to-end connection between
173 # the client and the server.
175 # Setting a proxy for the https schema in LWP WILL NOT ACCOMPLISH
178 # LWP will connect to the proxy server, and issue a standard GET
179 # request for the target URL, which most proxy servers will refuse
182 # The way to use a proxy server is to set some environment variables
183 # and let the underlying Crypt::SSLeay module do the rest.
185 # This is positively appaling.
186 $ENV{'HTTPS_PROXY'} = $schemas->{$_};
188 $ua->proxy($_, $schemas->{$_});
193 $self->{_CACHED_UA} = $ua;
201 return $self->{_CACHED_UA};
207 my $ua = shift || $self->ua();
211 return $r->decoded_content() if $r->is_success();
219 $d =~ s/%([[:xdigit:]]{2})/chr(hex($1))/ge;
224 sub decode_querystring {
227 return { map { split /=/, $_, 2; } split /&/, shift };
233 return $self->{_API}->{connectors}->();
239 $self->{'_CONNECTOR'} = shift;
243 # Register a callbacks into the core API to the plugin.
244 # Example of those are config getter/setters and IO functions
245 # The API is a hash reference containing subroutine references.
247 # After the API is registered an attempt is made to load the config
248 # (or set defaults if config values are not found)
254 $self->{_API} = $api;