Start gutting check_for_link()
[videosite.git] / videosite.pl
1 # autodownload flash videos
2 #
3 # (c) 2007-2008 by Ralf Ertzinger <ralf@camperquake.de>
4 # licensed under GNU GPL v2
5 #
6 # Based on youtube.pl by Christian Garbs <mitch@cgarbs.de>
7 # which in turn is
8 # based on trigger.pl by Wouter Coekaerts <wouter@coekaerts.be>
9 # This is helena
10
11 use strict;
12 use Irssi 20020324 qw (command_bind command_runsub signal_add_first signal_add_last);
13 use vars qw($VERSION %IRSSI);
14 use XML::Simple;
15 use Data::Dumper;
16 use File::Spec;
17 delete($INC{'BettIrssi.pm'});
18 use BettIrssi qw(_bcb _bcs);
19
20 my @grabbers;
21 my @getters;
22 my $getter;
23 my $conf;
24 my $conffile = File::Spec->catfile(Irssi::get_irssi_dir(), 'videosite.xml');
25 my $scriptdir = File::Spec->catfile(Irssi::get_irssi_dir(), 'scripts');
26 my $plugindir = File::Spec->catfile($scriptdir, 'videosite');
27
28 my $PARAMS = {
29     'getter' => '',
30     'mode' => 'download'
31 };
32
33
34 # activate debug here
35 my $debug = 0;
36
37 # "message public", SERVER_REC, char *msg, char *nick, char *address, char *target
38 signal_add_last(_bcs("message public" => sub {check_for_link(@_)}));
39 # "message own_public", SERVER_REC, char *msg, char *target
40 signal_add_last(_bcs("message own_public" => sub {check_for_link(@_)}));
41
42 # "message private", SERVER_REC, char *msg, char *nick, char *address
43 signal_add_last(_bcs("message private" => sub {check_for_link(@_)}));
44 # "message own_private", SERVER_REC, char *msg, char *target, char *orig_target
45 signal_add_last(_bcs("message own_private" => sub {check_for_link(@_)}));
46
47 # "message irc action", SERVER_REC, char *msg, char *nick, char *address, char *target
48 signal_add_last(_bcs("message irc action" => sub {check_for_link(@_)}));
49 # "message irc own_action", SERVER_REC, char *msg, char *target
50 signal_add_last(_bcs("message irc own_action" => sub {check_for_link(@_)}));
51
52 # For tab completion
53 signal_add_first('complete word', \&sig_complete);
54
55 my $videosite_commands = {
56     'save' => sub {
57         cmd_save();
58     },
59
60     'set' => sub {
61         cmd_set(@_);
62     },
63     
64     'show' => sub {
65         cmd_show(@_);
66     },
67
68     'help' => sub {
69         cmd_help(@_);
70     },
71
72     'getter' => sub {
73         cmd_getter(@_);
74     },
75
76     'enable' => sub {
77         cmd_enable(@_);
78     },
79
80     'disable' => sub {
81         cmd_disable(@_);
82     },
83
84     'reload' => sub {
85         init_videosite(0);
86     },
87
88     'mode' => sub {
89         cmd_mode(@_);
90     },
91
92     'debug' => sub {
93         $debug = 1;
94         foreach (@grabbers, @getters) {
95             $_->setdebug(1);
96         }
97         write_irssi(undef, 'Enabled debugging');
98     },
99
100     'nodebug' => sub {
101         $debug = 0;
102         foreach (@grabbers, @getters) {
103             $_->setdebug(0);
104         }
105         write_irssi(undef, 'Disabled debugging');
106     },
107 };
108
109 sub write_irssi {
110     my $witem = shift;
111     my @text = @_;
112
113     $text[0] = 'videosite: ' . $text[0];
114
115     if (defined $witem) {
116         $witem->print(sprintf(shift(@text), @text), MSGLEVEL_CLIENTCRAP);
117     } else {
118         Irssi::print(sprintf(shift(@text), @text));
119     }
120
121 }
122
123 sub write_debug {
124     if ($debug) {
125         write_irssi(shift, @_);
126     }
127 }
128
129 sub check_for_link {
130     by $event = shift;
131     my $message = $event->message();
132     my $witem = $event->channel();
133     my $g;
134     my $m;
135     my $p;
136
137
138     # Look if we should ignore this line
139     if ($message =~ m,(?:\s|^)/nosave(?:\s|$),) {
140         return;
141     }
142
143     study($message);
144
145     # Offer the message to all Grabbers in turn
146     foreach $g (@grabbers) {
147         ($m, $p) = $g->get($message);
148         while (defined($m)) {
149             write_debug($witem, 'Metadata: %s', Dumper($m));
150             if ('download' eq ($conf->{'videosite'}->{'mode'})) {
151                 write_irssi($witem, '%%R>>> %%NSaving %%Y%s%%N %%G%s', $m->{'SOURCE'}, $m->{'TITLE'});
152                 unless($getter->get($m)) {
153                     write_irssi($witem, '%%R>>> FAILED');
154                 }
155             } elsif ('display' eq ($conf->{'videosite'}->{'mode'})) {
156                 write_irssi($witem, '%%M>>> %%NSaw %%Y%s%%N %%G%s', $m->{'SOURCE'}, $m->{'TITLE'});
157             } else {
158                 write_irssi($witem, '%%R>>> Invalid operation mode');
159             }
160
161             # Remove the matched part from the message and try again (there may be
162             # more!)
163             $message =~ s/$p//;
164             study($message);
165
166             ($m, $p) = $g->get($message);
167         }
168     }
169 }
170
171 sub cmd_save {
172
173     eval {
174         open(CONF, '>'.$conffile) or die 'Could not open config file';
175         print CONF XML::Simple::XMLout($conf, KeepRoot => 1, KeyAttr => {'config' => 'module', 'option' => 'key'});
176         close(CONF);
177     };
178     if ($@) {
179         write_irssi(undef, 'Could not save config to %s: %s', ($conffile, $@));
180     } else {
181         write_irssi(undef, 'configuration saved to %s', $conffile);
182     }
183 }
184
185 sub cmd_set {
186     my $target = shift;
187     my $key = shift;
188     my $val = shift;
189     my $p;
190
191     foreach $p (@getters, @grabbers) {
192         if ($p->{'NAME'} eq $target) {
193             $p->setval($key, $val);
194             return;
195         }
196     }
197     write_irssi(undef, 'No such module');
198 }
199
200
201 sub cmd_enable {
202     my $target = shift;
203     my $p;
204
205     foreach $p (@grabbers) {
206         if ($p->{'NAME'} eq $target) {
207             $p->enable();
208             return;
209         }
210     }
211     write_irssi(undef, 'No such module');
212 }
213
214
215 sub cmd_disable {
216     my $target = shift;
217     my $p;
218
219     foreach $p (@grabbers) {
220         if ($p->{'NAME'} eq $target) {
221             $p->disable();
222             return;
223         }
224     }
225     write_irssi(undef, 'No such module');
226 }
227
228
229 sub cmd_show {
230     my $target = shift;
231     my $p;
232     my $e;
233
234     if (defined($target)) {
235         foreach $p (@getters, @grabbers) {
236             if ($p->{'NAME'} eq $target) {
237                 write_irssi(undef, $p->getconfstr());
238                 return;
239             }
240         }
241         write_irssi(undef, 'No such module');
242     } else {
243         write_irssi(undef, 'Loaded grabbers (* denotes enabled modules):');
244         foreach $p (@grabbers) {
245             $e = $p->_getval('enabled');
246             write_irssi(undef, ' %s%s', $p->{'NAME'}, $e?'*':'');
247         };
248
249         write_irssi(undef, 'Loaded getters:');
250         foreach $p (@getters) {
251             write_irssi(undef, ' %s', $p->{'NAME'});
252         };
253     }
254 }
255
256 sub cmd_help {
257     my $target = shift;
258     my $p;
259
260     if (defined($target)) {
261         foreach $p (@getters, @grabbers) {
262             if ($p->{'NAME'} eq $target) {
263                 write_irssi(undef, $p->gethelpstr());
264                 return;
265             }
266         }
267         write_irssi(undef, 'No such module');
268     } else {
269         write_irssi(undef, <<'EOT');
270 Supported commands:
271  save: save the current configuration
272  help [modulename]: display this help, or module specific help
273  show [modulename]: show loaded modules, or the current parameters of a module
274  set modulename parameter value: set a module parameter to a new value
275  getter [modulename]: display or set the getter to use
276  enable [modulename]: enable the usage of this module (grabbers only)
277  disable [modulename]: disable the usage of this module (grabbers only)
278  reload: reload all modules (this is somewhat experimental)
279  mode [modename]: display or set the operation mode (download/display)
280  debug: enable debugging messages
281  nodebug: disable debugging messages
282 EOT
283     }
284 }
285
286 sub cmd_getter {
287     my $target = shift;
288     my $p;
289
290     if (defined($target)) {
291         foreach $p (@getters) {
292             if ($p->{'NAME'} eq $target) {
293                 $getter = $p;
294                 $conf->{'videosite'}->{'getter'} = $target;
295                 return;
296             }
297         }
298         write_irssi(undef, 'No such getter');
299     } else {
300         write_irssi(undef, 'Current getter: %s', $conf->{'videosite'}->{'getter'});
301     }
302 }
303
304 sub cmd_mode {
305     my $mode = shift;
306
307     if (defined($mode)) {
308         $mode = lc($mode);
309         if (('download' eq $mode) or ('display' eq $mode)) {
310             $conf->{'videosite'}->{'mode'} = $mode;
311         } else {
312             write_irssi(undef, 'Invalid mode: %s', $mode);
313         }
314     } else {
315         write_irssi(undef, 'Current mode: %s', $conf->{'videosite'}->{'mode'});
316     }
317 }
318
319
320 # save on unload
321 sub sig_command_script_unload {
322     my $script = shift;
323     if ($script =~ /(.*\/)?videosite(\.pl)?$/) {
324         cmd_save();
325     }
326 }
327
328 sub ploader {
329
330     my $dir = shift;
331     my $pattern = shift;
332     my $type = shift;
333     my @list;
334     my $p;
335     my $g;
336     my @g = ();
337
338     opendir(D, $dir) || return ();
339     @list = grep {/$pattern/ && -f File::Spec->catfile($dir, $_) } readdir(D);
340     closedir(D);
341
342     foreach $p (@list) {
343         write_debug(undef, "Trying to load $p:");
344         $p =~ s/\.pm$//;
345         eval qq{ require videosite::$p; };
346         if ($@) {
347             write_irssi(undef, "Failed to load plugin: $@");
348             next;
349         }
350
351         $g = eval qq{ videosite::$p->new(); };
352         if ($@) {
353             write_irssi(undef, "Failed to instanciate: $@");
354             delete($INC{$p});
355             next;
356         }
357
358         write_debug(undef, "found $g->{'TYPE'} $g->{'NAME'}");
359         if ($type eq $g->{'TYPE'}) {
360             push(@g, $g);
361             $g->setio(sub {Irssi::print(shift)});
362         } else {
363             write_irssi(undef, '%s has wrong type (got %s, expected %s)', $p, $g->{'TYPE'}, $type);
364             delete($INC{$p});
365         }
366     }
367
368     write_debug(undef, "Loaded %d plugins", $#g+1);
369     
370     return @g;
371 }
372
373 sub _load_modules($) {
374
375     my $path = shift;
376
377     foreach (keys(%INC)) {
378         if ($INC{$_} =~ m|^$path|) {
379             write_debug(undef, "Removing %s from \$INC", $_);
380             delete($INC{$_});
381         }
382     }
383     @grabbers = ploader($path, '.*Grabber\.pm$', 'grabber');
384     @getters = ploader($path, '.*Getter\.pm$', 'getter');
385 }
386
387
388 sub init_videosite {
389
390     my $bindings = shift;
391     my $p;
392
393     unless(-r $conffile && defined($conf = XML::Simple::XMLin($conffile, ForceArray => ['config', 'option'], KeepRoot => 1, KeyAttr => {'config' => 'module', 'option' => 'key'}))) {
394         # No config, start with an empty one
395         write_debug(undef, 'No config found, using defaults');
396         $conf = { 'videosite' => { }};
397     }
398     foreach (keys(%{$PARAMS})) {
399         unless (exists($conf->{'videosite'}->{$_})) {
400             $conf->{'videosite'}->{$_} = $PARAMS->{$_};
401         }
402     }
403
404     _load_modules($plugindir);
405
406     unless (defined(@grabbers) && defined(@getters)) {
407         write_irssi(undef, 'No grabbers or no getters found, can not proceed.');
408         return;
409     }
410
411     $getter = $getters[0];
412     foreach $p (@getters) {
413         if ($conf->{'videosite'}->{'getter'} eq $p->{'NAME'}) {
414             $getter = $p;
415         }
416     }
417     write_debug(undef, 'Selected %s as getter', $getter->{'NAME'});
418     $conf->{'videosite'}->{'getter'} = $getter->{'NAME'};
419
420     # Loop through all plugins and load the config
421     foreach $p (@grabbers, @getters) {
422         $conf->{'videosite'}->{'config'}->{$p->{'NAME'}} = $p->mergeconfig($conf->{'videosite'}->{'config'}->{$p->{'NAME'}});
423     }
424
425     if ($bindings) {
426
427         Irssi::signal_add_first('command script load', 'sig_command_script_unload');
428         Irssi::signal_add_first('command script unload', 'sig_command_script_unload');
429         Irssi::signal_add('setup saved', 'cmd_save');
430
431
432         Irssi::command_bind('videosite' => \&cmdhandler);
433     }
434
435     write_irssi(undef, 'videosite initialized');
436 }
437
438 sub sig_complete {
439     my ($complist, $window, $word, $linestart, $want_space) = @_;
440     my @matches;
441
442     if ($linestart !~ m|^/videosite\b|) {
443         return;
444     }
445
446     if ('/videosite' eq $linestart) {
447         # No command enterd so far. Produce a list of possible follow-ups
448         @matches = grep {/^$word/} keys (%{$videosite_commands});
449     } elsif ('/videosite set' eq $linestart) {
450         # 'set' command entered. Produce a list of modules
451         foreach (@grabbers, @getters) {
452             push(@matches, $_->{'NAME'}) if $_->{'NAME'} =~ m|^$word|;
453         };
454     } elsif ($linestart =~ m|^/videosite set (\w+)$|) {
455         my $module = $1;
456
457         foreach my $p (@getters, @grabbers) {
458             if ($p->{'NAME'} eq $module) {
459                 @matches = $p->getparamlist($word);
460                 last;
461             }
462         }
463     } elsif ($linestart =~ m|/videosite set (\w+) (\w+)$|) {
464         my $module = $1;
465         my $param = $2;
466
467         foreach my $p (@getters, @grabbers) {
468             if ($p->{'NAME'} eq $module) {
469                 @matches = $p->getparamvalues($param, $word);
470                 last;
471             }
472         }
473     }
474
475
476     push(@{$complist}, sort @matches);
477     ${$want_space} = 0;
478
479     Irssi::signal_stop();
480 }
481
482 sub cmdhandler {
483     my ($data, $server, $item) = @_;
484     my ($cmd, @params) = split(/\s+/, $data);
485
486     if (exists($videosite_commands->{$cmd})) {
487         $videosite_commands->{$cmd}->(@params);
488     }
489 }
490
491 unshift(@INC, $scriptdir);
492 init_videosite(1);