root/trunk/plagger/lib/Plagger.pm

Revision 1810 (checked in by miyagawa, 14 years ago)

packaging 0.7.15

  • Property svn:keywords set to Id Revision
Line 
1 package Plagger;
2 use strict;
3 our $VERSION = '0.7.15';
4
5 use 5.8.1;
6 use Carp;
7 use Data::Dumper;
8 use Encode ();
9 use File::Copy;
10 use File::Basename;
11 use File::Find::Rule (); # don't import rule()!
12 use YAML;
13 use Storable;
14 use UNIVERSAL::require;
15
16 use base qw( Class::Accessor::Fast );
17 __PACKAGE__->mk_accessors( qw(conf update subscription plugins_path cache) );
18
19 use Plagger::Cache;
20 use Plagger::CacheProxy;
21 use Plagger::ConfigLoader;
22 use Plagger::Date;
23 use Plagger::Entry;
24 use Plagger::Feed;
25 use Plagger::Subscription;
26 use Plagger::Template;
27 use Plagger::Update;
28 use Plagger::UserAgent; # use to define $XML::Feed::RSS::PREFERRED_PARSER
29
30 my $context;
31 sub context     { $context }
32 sub set_context { $context = $_[1] }
33
34 sub new {
35     my($class, %opt) = @_;
36
37     my $self = bless {
38         conf  => {},
39         update => Plagger::Update->new,
40         subscription => Plagger::Subscription->new,
41         plugins_path => {},
42         plugins => [],
43         rewrite_tasks => []
44     }, $class;
45
46     my $loader = Plagger::ConfigLoader->new;
47     my $config = $loader->load($opt{config}, $self);
48
49     $loader->load_include($config);
50     $self->{conf} = $config->{global};
51     $self->{conf}->{log} ||= { level => 'debug' };
52
53     if (eval { require Term::Encoding }) {
54         $self->{conf}->{log}->{encoding} ||= Term::Encoding::get_encoding();
55     }
56
57     Plagger->set_context($self);
58
59     $loader->load_recipes($config);
60     $self->load_cache($opt{config});
61     $self->load_plugins(@{ $config->{plugins} || [] });
62     $self->rewrite_config if @{ $self->{rewrite_tasks} };
63
64     $self;
65 }
66
67 sub bootstrap {
68     my $class = shift;
69     my $self = $class->new(@_);
70     $self->run();
71     $self;
72 }
73
74 sub clear_session {
75     my $self = shift;
76     $self->{update}       = Plagger::Update->new;
77     $self->{subscription} = Plagger::Subscription->new;
78 }
79
80 sub add_rewrite_task {
81     my($self, @stuff) = @_;
82     push @{ $self->{rewrite_tasks} }, \@stuff;
83 }
84
85 sub rewrite_config {
86     my $self = shift;
87
88     unless ($self->{config_path}) {
89         $self->log(warn => "config is not loaded from file. Ignoring rewrite tasks.");
90         return;
91     }
92
93     open my $fh, '<', $self->{config_path} or $self->error("$self->{config_path}: $!");
94     my $data = join '', <$fh>;
95     close $fh;
96
97     my $old = $data;
98     my $count;
99
100     # xxx this is a quick hack: It should be a YAML roundtrip maybe
101     for my $task (@{ $self->{rewrite_tasks} }) {
102         my($key, $old_value, $new_value ) = @$task;
103         if ($data =~ s/^(\s+$key:\s+)\Q$old_value\E[ \t]*$/$1$new_value/m) {
104             $count++;
105         } else {
106             $self->log(error => "$key: $old_value not found in $self->{config_path}");
107         }
108     }
109
110     if ($count) {
111         File::Copy::copy( $self->{config_path}, $self->{config_path} . ".bak" );
112         open my $fh, ">", $self->{config_path} or return $self->log(error => "$self->{config_path}: $!");
113         print $fh $data;
114         close $fh;
115
116         $self->log(info => "Rewrote $count password(s) and saved to $self->{config_path}");
117     }
118 }
119
120 sub load_cache {
121     my($self, $config) = @_;
122
123     # use config filename as a base directory for cache
124     my $base = ( basename($config) =~ /^(.*?)\.yaml$/ )[0] || 'config';
125     my $dir  = $base eq 'config' ? ".plagger" : ".plagger-$base";
126
127     # cache is auto-vivified but that's okay
128     $self->{conf}->{cache}->{base} ||= File::Spec->catfile($self->home_dir, $dir);
129
130     $self->cache( Plagger::Cache->new($self->{conf}->{cache}) );
131 }
132
133 sub home_dir {
134     eval { require File::HomeDir };
135     return $@ ? $ENV{HOME} : File::HomeDir->my_home;
136 }
137
138 sub load_plugins {
139     my($self, @plugins) = @_;
140
141     my $plugin_path = $self->conf->{plugin_path} || [];
142        $plugin_path = [ $plugin_path ] unless ref $plugin_path;
143
144     for my $path (@$plugin_path) {
145         opendir my $dir, $path or do {
146             $self->log(warn => "$path: $!");
147             next;
148         };
149         while (my $ent = readdir $dir) {
150             next if $ent =~ /^\./;
151             $ent = File::Spec->catfile($path, $ent);
152             if (-f $ent && $ent =~ /\.pm$/) {
153                 $self->add_plugin_path($ent);
154             } elsif (-d $ent) {
155                 my $lib = File::Spec->catfile($ent, "lib");
156                 if (-e $lib && -d _) {
157                     $self->log(debug => "Add $lib to INC path");
158                     unshift @INC, $lib;
159                 } else {
160                     my $rule = File::Find::Rule->new;
161                     $rule->file;
162                     $rule->name('*.pm');
163                     my @modules = $rule->in($ent);
164                     for my $module (@modules) {
165                         $self->add_plugin_path($module);
166                     }
167                 }
168             }
169         }
170     }
171
172     for my $plugin (@plugins) {
173         $self->load_plugin($plugin) unless $plugin->{disable};
174     }
175 }
176
177 sub add_plugin_path {
178     my($self, $file) = @_;
179
180     my $pkg = $self->extract_package($file)
181         or die "Can't find package from $file";
182     $self->plugins_path->{$pkg} = $file;
183     $self->log(debug => "$file is added as a path to plugin $pkg");
184 }
185
186 sub extract_package {
187     my($self, $file) = @_;
188
189     open my $fh, '<', $file or die "$file: $!";
190     while (<$fh>) {
191         /^package (Plagger::Plugin::.*?);/ and return $1;
192     }
193
194     return;
195 }
196
197 sub autoload_plugin {
198     my($self, $plugin) = @_;
199     unless ($self->is_loaded($plugin->{module})) {
200         $self->load_plugin($plugin);
201     }
202 }
203
204 sub is_loaded {
205     my($self, $stuff) = @_;
206
207     my $sub = ref $stuff && ref $stuff eq 'Regexp'
208         ? sub { $_[0] =~ $stuff }
209         : sub { $_[0] eq $stuff };
210
211     for my $plugin (@{ $self->{plugins} }) {
212         my $module = ref $plugin;
213            $module =~ s/^Plagger::Plugin:://;
214         return 1 if $sub->($module);
215     }
216
217     return;
218 }
219
220 sub load_plugin {
221     my($self, $config) = @_;
222
223     my $module = delete $config->{module};
224     $module =~ s/^Plagger::Plugin:://;
225     $module = "Plagger::Plugin::$module";
226
227     if ($module->isa('Plagger::Plugin')) {
228         $self->log(debug => "$module is loaded elsewhere ... maybe .t script?");
229     } elsif (my $path = $self->plugins_path->{$module}) {
230         eval { require $path } or die $@;
231     } else {
232         $module->require or die $@;
233     }
234
235     $self->log(info => "plugin $module loaded.");
236
237     my $plugin = $module->new($config);
238     $plugin->cache( Plagger::CacheProxy->new($plugin, $self->cache) );
239     $plugin->register($self);
240
241     push @{$self->{plugins}}, $plugin;
242 }
243
244 sub register_hook {
245     my($self, $plugin, @hooks) = @_;
246     while (my($hook, $callback) = splice @hooks, 0, 2) {
247         # set default rule_hook $hook to $plugin
248         $plugin->rule_hook($hook) unless $plugin->rule_hook;
249
250         push @{ $self->{hooks}->{$hook} }, +{
251             callback  => $callback,
252             plugin    => $plugin,
253         };
254     }
255 }
256
257 sub run_hook {
258     my($self, $hook, $args, $once, $callback) = @_;
259
260     my @ret;
261     for my $action (@{ $self->{hooks}->{$hook} }) {
262         my $plugin = $action->{plugin};
263         if ( $plugin->rule->dispatch($plugin, $hook, $args) ) {
264             my $ret = $action->{callback}->($plugin, $self, $args);
265             $callback->($ret) if $callback;
266             if ($once) {
267                 return $ret if defined $ret;
268             } else {
269                 push @ret, $ret;
270             }
271         } else {
272             push @ret, undef;
273         }
274     }
275
276     return if $once;
277     return @ret;
278 }
279
280 sub run_hook_once {
281     my($self, $hook, $args, $callback) = @_;
282     $self->run_hook($hook, $args, 1, $callback);
283 }
284
285 sub run {
286     my $self = shift;
287
288     $self->autoload_plugin({ module => 'Bundle::Defaults' });
289
290     $self->run_hook('plugin.init');
291     $self->run_hook('subscription.load');
292
293     for my $feed ($self->subscription->feeds) {
294         if (my $sub = $feed->aggregator) {
295             $sub->($self, { feed => $feed });
296         } else {
297             my $ok = $self->run_hook_once('customfeed.handle', { feed => $feed });
298             if (!$ok) {
299                 $self->log(error => $feed->url . " is not aggregated by any aggregator");
300                 $self->subscription->delete_feed($feed);
301             }
302         }
303     }
304
305     $self->run_hook('aggregator.finalize');
306     $self->do_run_with_feeds;
307     $self->run_hook('plugin.finalize');
308
309     Plagger->set_context(undef);
310     $self;
311 }
312
313 sub run_with_feeds {
314     my $self = shift;
315     $self->run_hook('plugin.init');
316     $self->do_run_with_feeds;
317     $self->run_hook('plugin.finalize');
318
319     Plagger->set_context(undef);
320     $self;
321 }
322
323 sub do_run_with_feeds {
324     my $self = shift;
325
326     for my $feed ($self->update->feeds) {
327         for my $entry ($feed->entries) {
328             $self->run_hook('update.entry.fixup', { feed => $feed, entry => $entry });
329         }
330         $self->run_hook('update.feed.fixup', { feed => $feed });
331     }
332
333     $self->run_hook('update.fixup');
334
335     $self->run_hook('smartfeed.init');
336     for my $feed ($self->update->feeds) {
337         for my $entry ($feed->entries) {
338             $self->run_hook('smartfeed.entry', { feed => $feed, entry => $entry });
339         }
340         $self->run_hook('smartfeed.feed', { feed => $feed });
341     }
342     $self->run_hook('smartfeed.finalize');
343
344     $self->run_hook('publish.init');
345     for my $feed ($self->update->feeds) {
346         for my $entry ($feed->entries) {
347             $self->run_hook('publish.entry.fixup', { feed => $feed, entry => $entry });
348         }
349
350         $self->run_hook('publish.feed', { feed => $feed });
351
352         for my $entry ($feed->entries) {
353             $self->run_hook('publish.entry', { feed => $feed, entry => $entry });
354         }
355     }
356
357     $self->run_hook('publish.finalize');
358 }
359
360 sub search {
361     my($self, $query) = @_;
362
363     Plagger->set_context($self);
364     $self->run_hook('plugin.init');
365
366     my @feeds;
367     $context->run_hook('searcher.search', { query => $query }, 0, sub { push @feeds, $_[0] });
368
369     Plagger->set_context(undef);
370     return @feeds;
371 }
372
373 sub log {
374     my($self, $level, $msg, %opt) = @_;
375
376     return unless $self->should_log($level);
377
378     # hack to get the original caller as Plugin or Rule
379     my $caller = $opt{caller};
380     unless ($caller) {
381         my $i = 0;
382         while (my $c = caller($i++)) {
383             last if $c !~ /Plugin|Rule/;
384             $caller = $c;
385         }
386         $caller ||= caller(0);
387     }
388
389     chomp($msg);
390     if ($self->conf->{log}->{encoding}) {
391         $msg = Encode::decode_utf8($msg) unless utf8::is_utf8($msg);
392         $msg = Encode::encode($self->conf->{log}->{encoding}, $msg);
393     }
394     warn "$caller [$level] $msg\n";
395 }
396
397 my %levels = (
398     debug => 0,
399     warn  => 1,
400     info  => 2,
401     error => 3,
402 );
403
404 sub should_log {
405     my($self, $level) = @_;
406     $levels{$level} >= $levels{$self->conf->{log}->{level}};
407 }
408
409 sub error {
410     my($self, $msg) = @_;
411     my($caller, $filename, $line) = caller(0);
412     chomp($msg);
413     die "$caller [fatal] $msg at line $line\n";
414 }
415
416 sub dumper {
417     my($self, $stuff) = @_;
418     local $Data::Dumper::Indent = 1;
419     $self->log(debug => Dumper($stuff));
420 }
421
422 sub template {
423     my $self = shift;
424     $self->log(error => "\$context->template is DEPRECATED NOW. use \$plugin->templatize()");
425     my $plugin = shift || (caller)[0];
426     Plagger::Template->new($self, $plugin);
427 }
428
429 sub templatize {
430     my($self, $plugin, $file, $vars) = @_;
431     $self->log(error => "\$context->templatize is DEPRECATED NOW. use \$plugin->templatize()");
432     $plugin->templatize($file, $vars);
433 }
434
435 1;
436 __END__
437
438 =head1 NAME
439
440 Plagger - Pluggable RSS/Atom Aggregator
441
442 =head1 SYNOPSIS
443
444   % plagger -c config.yaml
445
446 =head1 DESCRIPTION
447
448 Plagger is a pluggable RSS/Atom feed aggregator and remixer platform.
449
450 Everything is implemented as a small plugin just like qpsmtpd, blosxom
451 and perlbal. All you have to do is write a flow of aggregation,
452 filters, syndication, publishing and notification plugins in config
453 YAML file.
454
455 See L<http://plagger.org/> for cookbook examples, quickstart document,
456 development community (Mailing List and IRC), subversion repository
457 and bug tracking.
458
459 =head1 BUGS / DEVELOPMENT
460
461 If you find any bug, or you have an idea of nice plugin and want help
462 on it, drop us a line to our mailing list
463 L<http://groups.google.com/group/plagger-dev> or stop by the IRC
464 channel C<#plagger> at irc.freenode.net.
465
466 =head1 AUTHOR
467
468 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
469
470 See I<AUTHORS> file for the name of all the contributors.
471
472 =head1 LICENSE
473
474 Except where otherwise noted, Plagger is free software; you can
475 redistribute it and/or modify it under the same terms as Perl itself.
476
477 =head1 SEE ALSO
478
479 L<http://plagger.org/>
480
481 =cut
Note: See TracBrowser for help on using the browser.