root/trunk/plagger/lib/Plagger.pm

Revision 1588 (checked in by miyagawa, 14 years ago)
  • Added Test::Perl::Critic test and t/perlcriticrc policy file
  • Fixed 2 args open() to comfort with PBP
  • Added ## no critic to express "I know what I'm doing"
  • Property svn:keywords set to Id Revision
Line 
1 package Plagger;
2 use strict;
3 our $VERSION = '0.7.9';
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});
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)) {
200         $self->load_plugin({ module => $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 @ret;
277 }
278
279 sub run_hook_once {
280     my($self, $hook, $args, $callback) = @_;
281     $self->run_hook($hook, $args, 1, $callback);
282 }
283
284 sub run {
285     my $self = shift;
286
287     $self->run_hook('plugin.init');
288     $self->run_hook('subscription.load');
289
290     unless ( $self->is_loaded(qr/^Aggregator::/) ) {
291         $self->load_plugin({ module => 'Aggregator::Simple' });
292     }
293
294     for my $feed ($self->subscription->feeds) {
295         if (my $sub = $feed->aggregator) {
296             $sub->($self, { feed => $feed });
297         } else {
298             my $ok = $self->run_hook_once('customfeed.handle', { feed => $feed });
299             if (!$ok) {
300                 Plagger->context->log(error => $feed->url . " is not aggregated by any aggregator");
301                 Plagger->context->subscription->delete_feed($feed);
302             }
303         }
304     }
305
306     $self->run_hook('aggregator.finalize');
307     $self->do_run_with_feeds;
308     $self->run_hook('plugin.finalize');
309
310     Plagger->set_context(undef);
311     $self;
312 }
313
314 sub run_with_feeds {
315     my $self = shift;
316     $self->run_hook('plugin.init');
317     $self->do_run_with_feeds;
318     $self->run_hook('plugin.finalize');
319
320     Plagger->set_context(undef);
321     $self;
322 }
323
324 sub do_run_with_feeds {
325     my $self = shift;
326
327     for my $feed ($self->update->feeds) {
328         for my $entry ($feed->entries) {
329             $self->run_hook('update.entry.fixup', { feed => $feed, entry => $entry });
330         }
331         $self->run_hook('update.feed.fixup', { feed => $feed });
332     }
333
334     $self->run_hook('update.fixup');
335
336     $self->run_hook('smartfeed.init');
337     for my $feed ($self->update->feeds) {
338         for my $entry ($feed->entries) {
339             $self->run_hook('smartfeed.entry', { feed => $feed, entry => $entry });
340         }
341         $self->run_hook('smartfeed.feed', { feed => $feed });
342     }
343     $self->run_hook('smartfeed.finalize');
344
345     $self->run_hook('publish.init');
346     for my $feed ($self->update->feeds) {
347         for my $entry ($feed->entries) {
348             $self->run_hook('publish.entry.fixup', { feed => $feed, entry => $entry });
349         }
350
351         $self->run_hook('publish.feed', { feed => $feed });
352
353         for my $entry ($feed->entries) {
354             $self->run_hook('publish.entry', { feed => $feed, entry => $entry });
355         }
356     }
357
358     $self->run_hook('publish.finalize');
359 }
360
361 sub search {
362     my($self, $query) = @_;
363
364     Plagger->set_context($self);
365     $self->run_hook('plugin.init');
366
367     my @feeds;
368     $context->run_hook('searcher.search', { query => $query }, 0, sub { push @feeds, $_[0] });
369
370     Plagger->set_context(undef);
371     return @feeds;
372 }
373
374 sub log {
375     my($self, $level, $msg, %opt) = @_;
376
377     return unless $self->should_log($level);
378
379     # hack to get the original caller as Plugin or Rule
380     my $caller = $opt{caller};
381     unless ($caller) {
382         my $i = 0;
383         while (my $c = caller($i++)) {
384             last if $c !~ /Plugin|Rule/;
385             $caller = $c;
386         }
387         $caller ||= caller(0);
388     }
389
390     chomp($msg);
391     if ($self->conf->{log}->{encoding}) {
392         $msg = Encode::decode_utf8($msg) unless utf8::is_utf8($msg);
393         $msg = Encode::encode($self->conf->{log}->{encoding}, $msg);
394     }
395     warn "$caller [$level] $msg\n";
396 }
397
398 my %levels = (
399     debug => 0,
400     warn  => 1,
401     info  => 2,
402     error => 3,
403 );
404
405 sub should_log {
406     my($self, $level) = @_;
407     $levels{$level} >= $levels{$self->conf->{log}->{level}};
408 }
409
410 sub error {
411     my($self, $msg) = @_;
412     my($caller, $filename, $line) = caller(0);
413     chomp($msg);
414     die "$caller [fatal] $msg at line $line\n";
415 }
416
417 sub dumper {
418     my($self, $stuff) = @_;
419     local $Data::Dumper::Indent = 1;
420     $self->log(debug => Dumper($stuff));
421 }
422
423 sub template {
424     my $self = shift;
425     $self->log(error => "\$context->template is DEPRECATED NOW. use \$plugin->templatize()");
426     my $plugin = shift || (caller)[0];
427     Plagger::Template->new($self, $plugin);
428 }
429
430 sub templatize {
431     my($self, $plugin, $file, $vars) = @_;
432     $self->log(error => "\$context->templatize is DEPRECATED NOW. use \$plugin->templatize()");
433     $plugin->templatize($file, $vars);
434 }
435
436 1;
437 __END__
438
439 =head1 NAME
440
441 Plagger - Pluggable RSS/Atom Aggregator
442
443 =head1 SYNOPSIS
444
445   % plagger -c config.yaml
446
447 =head1 DESCRIPTION
448
449 Plagger is a pluggable RSS/Atom feed aggregator and remixer platform.
450
451 Everything is implemented as a small plugin just like qpsmtpd, blosxom
452 and perlbal. All you have to do is write a flow of aggregation,
453 filters, syndication, publishing and notification plugins in config
454 YAML file.
455
456 See L<http://plagger.org/> for cookbook examples, quickstart document,
457 development community (Mailing List and IRC), subversion repository
458 and bug tracking.
459
460 =head1 BUGS / DEVELOPMENT
461
462 If you find any bug, or you have an idea of nice plugin and want help
463 on it, drop us a line to our mailing list
464 L<http://groups.google.com/group/plagger-dev> or stop by the IRC
465 channel C<#plagger> at irc.freenode.net.
466
467 =head1 AUTHOR
468
469 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
470
471 See I<AUTHORS> file for the name of all the contributors.
472
473 =head1 LICENSE
474
475 Except where otherwise noted, Plagger is free software; you can
476 redistribute it and/or modify it under the same terms as Perl itself.
477
478 =head1 SEE ALSO
479
480 L<http://plagger.org/>
481
482 =cut
Note: See TracBrowser for help on using the browser.