File Coverage

blib/lib/Dezi/Aggregator.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Dezi::Aggregator;
2 3     3   4151 use Moose;
  3         9  
  3         24  
3             with 'Dezi::Role';
4 3     3   21535 use Carp;
  3         10  
  3         229  
5 3     3   1065 use Types::Standard qw( Bool Str InstanceOf Int Object );
  3         71947  
  3         35  
6 3     3   4310 use Dezi::Types qw( DeziFileOrCodeRef DeziEpoch );
  3         9  
  3         27  
7 3     3   2967 use Dezi::Utils;
  0            
  0            
8             use SWISH::Filter;
9             use Dezi::Indexer::Doc;
10             use Scalar::Util qw( blessed );
11             use Data::Dump qw( dump );
12              
13             use namespace::autoclean;
14              
15             our $VERSION = '0.014';
16              
17             has 'set_parser_from_type' => ( is => 'rw', isa => Bool, default => sub {1} );
18             has 'indexer' => (
19             is => 'rw',
20             isa => InstanceOf ['Dezi::Indexer'],
21             );
22             has 'doc_class' => (
23             is => 'rw',
24             isa => Str,
25             required => 1,
26             default => sub {'Dezi::Indexer::Doc'},
27             );
28             has 'swish_filter_obj' => (
29             is => 'rw',
30             isa => InstanceOf ['SWISH::Filter'],
31             default => sub { SWISH::Filter->new }
32             );
33             has 'test_mode' => ( is => 'rw', isa => Bool, default => sub {0} );
34             has 'filter' => ( is => 'rw', isa => DeziFileOrCodeRef, coerce => 1, );
35             has 'ok_if_newer_than' => ( is => 'rw', isa => DeziEpoch );
36             has 'progress' => ( is => 'rw', isa => Object ); # Term::ProgressBar
37             has 'count' => ( is => 'ro', isa => Int );
38              
39             =pod
40              
41             =head1 NAME
42              
43             Dezi::Aggregator - document aggregation base class
44              
45             =head1 SYNOPSIS
46              
47             package MyAggregator;
48             use Moose;
49             extends 'Dezi::Aggregator';
50            
51             sub get_doc {
52             my ($self, $url) = @_;
53            
54             # do something to create a Dezi::Indexer::Doc object from $url
55            
56             return $doc;
57             }
58            
59             sub crawl {
60             my ($self, @where) = @_;
61            
62             foreach my $place (@where) {
63            
64             # do something to search $place for docs to pass to get_doc()
65            
66             }
67             }
68            
69             1;
70              
71             =head1 DESCRIPTION
72              
73             Dezi::Aggregator is a base class that defines the basic API for writing
74             an aggregator. Only two methods are required: get_doc() and crawl(). See
75             the SYNOPSIS for the prototypes.
76              
77             See Dezi::Aggregator::FS and Dezi::Aggregator::Spider for examples
78             of aggregators that crawl the filesystem and web, respectively.
79              
80             =head1 METHODS
81              
82             =head2 BUILD
83              
84             Set object flags per Dezi::Class API. These are also accessors,
85             and include:
86              
87             =over
88              
89             =item set_parser_from_type
90              
91             This will set the parser() value in swish_filter() based on the
92             MIME type of the doc_class() object.
93              
94             =item indexer
95              
96             A Dezi::Indexer object.
97              
98             =item doc_class
99              
100             The name of the Dezi::Indexer::Doc-derived class to use in get_doc().
101             Default is Dezi::Indexer::Doc.
102              
103             =item swish_filter_obj
104              
105             A SWISH::Filter object. If not passed in new() one is created for you.
106              
107             =item test_mode
108              
109             Dry run mode, just prints info on stderr but does not
110             build index.
111              
112             =item filter
113              
114             Value should be a CODE ref. This is passed through to set_filter()
115             internally at BUILD() time. If you need to adjust the filter
116             after the Aggregator object is created, use set_filter().
117              
118             =item ok_if_newer_than
119              
120             Value should be a Unix timestamp (epoch seconds). Default is undef.
121             If set, aggregators should skip files that have a modification time
122             older than the timestamp.
123              
124             You may get/set the ok_if_newer_than value with the ok_if_newer_than()
125             attribute method, but use set_ok_if_newer_than() to include validation
126             of the supplied I<timestamp> value.
127              
128             =item progress( I<Term::ProgressBar object> )
129              
130             Get/set a progress object. The default used in the examples/swish3
131             script is Term::ProgressBar. If set, it will be incremented
132             just like count() is.
133              
134             =back
135              
136             =cut
137              
138             sub BUILD {
139             my $self = shift;
140             $self->{__progress_so_far} = 0;
141             $self->{__progress_next} = 0;
142             if ( $self->filter ) {
143             $self->set_filter( $self->filter );
144             }
145             }
146              
147             =head2 config
148              
149             Returns the Dezi::Indexer::Config object from the Indexer
150             being used. This is a read-only method (accessor not mutator).
151              
152             =cut
153              
154             sub config {
155             return shift->indexer->config;
156             }
157              
158             =head2 count
159              
160             Returns the total number of doc_class() objects returned by get_doc().
161              
162             =cut
163              
164             =head2 crawl( I<@where> )
165              
166             Override this method in your subclass. It does the aggregation,
167             and passes each doc_class() object from get_doc() to indexer->process().
168              
169             =cut
170              
171             sub crawl {
172             my $self = shift;
173             confess ref($self) . " does not implement crawl()";
174             }
175              
176             =head2 get_doc( I<url> )
177              
178             Override this method in your subclass. Should return a doc_class()
179             object.
180              
181             =cut
182              
183             sub get_doc {
184             my $self = shift;
185             confess ref($self) . " does not implement get_doc()";
186             }
187              
188             =head2 swish_filter( I<doc_class_object> )
189              
190             Passes the content() of the I<doc_class_object> through SWISH::Filter
191             and transforms it to something index-able. Returns
192             the I<doc_class_object>, filtered.
193              
194             B<NOTE:> This method should be called by all aggregators after
195             get_doc() and before passing to the indexer().
196              
197             See the SWISH::Filter documentation.
198              
199             =cut
200              
201             sub swish_filter {
202             my $self = shift;
203             my $doc = shift;
204             unless ( $doc && blessed($doc) && $doc->isa('Dezi::Indexer::Doc') ) {
205             croak "Dezi::Indexer::Doc-derived object required";
206             }
207              
208             if ( $self->debug ) {
209             warn "checking filter for " . $doc->url;
210             }
211              
212             unless ( defined $doc->parser ) {
213             if ( $self->set_parser_from_type ) {
214             my $type = $doc->type || 'default';
215             $doc->parser(
216             Dezi::Utils->get_parser_for_mime(
217             $type,
218             ( $self->indexer ? $self->indexer->swish3 : undef ),
219             )
220             );
221             }
222             }
223              
224             my $sfo = $self->swish_filter_obj;
225              
226             if ( $sfo->can_filter( $doc->type ) ) {
227              
228             if ( $self->debug ) {
229             warn sprintf
230             "debug=%d can_filter true for %s with parser %s for type %s",
231             $self->debug, $doc->url,
232             $doc->parser, $doc->type;
233             }
234              
235             my $content = $doc->content;
236             my $url = $doc->url;
237             my $type = $doc->type;
238             my $f = $sfo->convert(
239             document => \$content,
240             content_type => $type,
241             name => $url
242             );
243              
244             if ( !$f
245             || !$f->was_filtered
246             || $f->is_binary ) # is is_binary necessary?
247             {
248             warn "skipping $url - filtering error\n";
249             return;
250             }
251              
252             if ( $self->debug > 1 ) {
253             warn "$url [$type] was filtered\n";
254             if ( $doc->content ne ${ $f->fetch_doc } ) {
255             warn sprintf "content changed:'%s'\n", ${ $f->fetch_doc };
256             }
257             }
258              
259             $doc->content( ${ $f->fetch_doc } );
260              
261             # leave type and parser as-is
262             # since we want to store original mime in indexer.
263             # TODO test this.
264             # what about parser?
265             # since type will have changed ( $f->content_type ) from original
266             # the parser type might also have changed?
267              
268             $doc->parser( $f->swish_parser_type ) if $self->set_parser_from_type;
269              
270             }
271             else {
272              
273             if ( $self->debug ) {
274             warn sprintf(
275             "No filter applied to %s - cannot filter %s (parser %s)\n",
276             $doc->url, $doc->type, $doc->parser, );
277             warn sprintf( " available filter: %s\n", $_ )
278             for $sfo->filter_list;
279             }
280              
281             }
282              
283             }
284              
285             =head2 set_filter( I<code_ref> )
286              
287             Use I<code_ref> as the C<doc_class> filter. This method called by BUILD() if
288             C<filter> param set in constructor.
289              
290             =cut
291              
292             sub set_filter {
293             my $self = shift;
294             my $filter = shift;
295             unless ( ref($filter) eq 'CODE' ) {
296             croak "filter must be a CODE ref";
297             }
298              
299             # cheat a little by using this code instead of the default
300             # method in doc_class
301             {
302             no strict 'refs';
303             no warnings 'redefine';
304              
305             #warn "setting filter as method: " . $self->{doc_class} . '::filter';
306             *{ $self->{doc_class} . '::filter' } = $filter;
307             }
308              
309             }
310              
311             =head2 set_ok_if_newer_than( I<timestamp> )
312              
313             Set the ok_if_newer_than attribute. I<timestamp> should be a Unix
314             epoch value.
315              
316             =cut
317              
318             sub set_ok_if_newer_than {
319             my $self = shift;
320             my $ts = shift || 0;
321             if ( $ts =~ m/\D/ ) {
322             croak "timestamp should be an integer";
323             }
324             $self->ok_if_newer_than($ts);
325             }
326              
327             #
328             # private methods
329             #
330              
331             sub _increment_count {
332             my $self = shift;
333             my $count = shift || 1;
334             $self->{count} += $count;
335             if ( $self->{progress} ) {
336             $self->{__progress_so_far} += $count;
337             if ( $self->{__progress_so_far} >= $self->{__progress_next} ) {
338             $self->{__progress_next}
339             = $self->{progress}->update( $self->{__progress_so_far} );
340             }
341             }
342             return $self;
343             }
344              
345             sub _apply_file_rules {
346             my ( $self, $file, $file_rules ) = @_;
347             if ( !$file_rules
348             && !exists $self->{_file_rules}
349             && $self->config->FileRules )
350             {
351              
352             # cache obj
353             $self->{_file_rules} = File::Rules->new( $self->config->FileRules );
354             }
355             if ( $file_rules or exists $self->{_file_rules} ) {
356             $self->debug and warn "$file [applying DeziFileRules]\n";
357             my $rules = $file_rules || $self->{_file_rules};
358             my $match = $rules->match($file);
359             return $match;
360             }
361             return 0; # no rules
362             }
363              
364             sub _apply_file_match {
365             my ( $self, $file ) = @_;
366              
367             # TODO
368             return 0; # no-op for now
369             }
370              
371             __PACKAGE__->meta->make_immutable;
372              
373             1;
374              
375             __END__
376              
377             =head1 AUTHOR
378              
379             Peter Karman, E<lt>perl@peknet.comE<gt>
380              
381             =head1 BUGS
382              
383             Please report any bugs or feature requests to C<bug-swish-prog at rt.cpan.org>, or through
384             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Dezi-App>.
385             I will be notified, and then you'll
386             automatically be notified of progress on your bug as I make changes.
387              
388             =head1 SUPPORT
389              
390             You can find documentation for this module with the perldoc command.
391              
392             perldoc Dezi
393              
394              
395             You can also look for information at:
396              
397             =over 4
398              
399             =item * Mailing list
400              
401             L<http://lists.swish-e.org/listinfo/users>
402              
403             =item * RT: CPAN's request tracker
404              
405             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Dezi-App>
406              
407             =item * AnnoCPAN: Annotated CPAN documentation
408              
409             L<http://annocpan.org/dist/Dezi-App>
410              
411             =item * CPAN Ratings
412              
413             L<http://cpanratings.perl.org/d/Dezi-App>
414              
415             =item * Search CPAN
416              
417             L<http://search.cpan.org/dist/Dezi-App/>
418              
419             =back
420              
421             =head1 COPYRIGHT AND LICENSE
422              
423             Copyright 2008-2009 by Peter Karman
424              
425             This library is free software; you can redistribute it and/or modify
426             it under the same terms as Perl itself.
427              
428             =head1 SEE ALSO
429              
430             L<http://swish-e.org/>