| WWW-Mixi-Scraper documentation | Contained in the WWW-Mixi-Scraper distribution. |
WWW::Mixi::Scraper::Plugin - base class for plugins
package WWW::Mixi::Scraper::Plugin::<SamplePlugin>
use strict;
use warnings;
use WWW::Mixi::Scraper::Plugin;
validator {qw( id is_number )};
sub scrape {
my ($self, $html) = @_;
my %scraper;
$scraper{...} = scraper {
process '...',
text => 'TEXT'; # always plain text
process '...',
text => 'HTML'; # always HTML
process '...',
depends => $self->html_or_text; # HTML or TEXT
result qw( text depends );
};
return $self->post_process($scraper{...}->scrape(\$html));
return $arrayref;
}
1;
This is a base class for WWW::Mixi::Scraper plugins. You don't need to use base qw( WWW::Mixi::Scraper::Plugin ); just use it. This exports Web::Scraper functions and several public and private methods/functions of its own.
creates an object.
returns the rendering mode of choice ('TEXT' or 'HTML').
gets content from a uri, scrapes, and returns an array (or a hash reference, etc) of data.
used internally to build uri from query paramters (and optional hash). If you want to tweak the uri (e.g. to change authority from 'mixi.jp' to 'video.mixi.jp', etc), provide tweak_uri() in your plugin.
gets content from the uri specified or from an optional html data.
does some common tasks such as to make sure the result be an array reference, remove some temporary data to extract exact information, objectify link data (and maybe datetime data in the future?).
prepares some simple validator for query parameters, though I'm not sure if this is really useful.
Kenichi Ishigaki, <ishigaki at cpan.org>
Copyright (C) 2007 by Kenichi Ishigaki.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| WWW-Mixi-Scraper documentation | Contained in the WWW-Mixi-Scraper distribution. |
package WWW::Mixi::Scraper::Plugin; use strict; use warnings; use Web::Scraper; use String::CamelCase qw( decamelize ); use WWW::Mixi::Scraper::Utils qw( _force_arrayref _uri _datetime ); sub import { my $class = shift; my $pkg = caller; my @subs = qw( new parse scraper process process_first result get_content post_process validator build_uri html_or_text _extract_name ); no strict 'refs'; no warnings 'redefine'; foreach my $sub ( @subs ) { *{"$pkg\::$sub"} = *{"$class\::$sub"}; } } sub new { my ($class, %options) = @_; bless \%options, $class; } sub html_or_text { shift->{mode} || 'HTML' } sub parse { my $self = shift; my $res = $self->scrape($self->get_content(@_)); return ( wantarray and ref $res eq 'ARRAY' ) ? @{ $res || [] } : $res; } sub get_content { my ($self, %options) = @_; my $content = delete $options{html}; unless ( $content ) { $content = $self->{mech}->get_content($self->build_uri(%options)); } die "no content" unless $content; # XXX: preserve some tags like <br>? # $content =~ s/<br(\s[^>]*)?>/\n/g; # at least preserve as a space $content =~ s/ / /g; # as it'd be converted as '?' return $content; } sub build_uri { my ($self, %query) = @_; my ($name) = (ref $self) =~ /::(\w+)$/; my $path = sprintf '/%s.pl', decamelize($name); my $uri = URI->new($path); foreach my $key ( keys %query ) { if ( $self->_is_valid( $key, $query{$key} ) ) { $uri->query_param( $key => $query{$key} ); } } $uri = $self->tweak_uri($uri) if $self->can('tweak_uri'); $self->{uri} = $uri; # preserve for later use. return $uri; } sub validator ($) { my $hashref = shift; my $pkg = caller; my %rules; foreach my $key ( keys %{ $hashref } ) { my $rule = $hashref->{$key}; if ( $rule eq 'is_number' ) { $rules{$key} = sub { my $value = shift; $value && $value =~ /^\d+$/ ? 1 : 0; }; } if ( $rule eq 'is_number_or_all' ) { $rules{$key} = sub { my $value = shift; $value && $value =~ /^(?:\d+|all)$/ ? 1 : 0; }; } if ( $rule eq 'is_anything' ) { $rules{$key} = sub { 1 }; } } no strict 'refs'; no warnings 'redefine'; *{"$pkg\::_is_valid"} = sub { return $rules{$_[1]} && $rules{$_[1]}->($_[2]) }; } sub post_process { my ($self, $data, $callback) = @_; my $arrayref = _force_arrayref($data); foreach my $item ( @{ $arrayref } ) { if ( ref $callback eq 'CODE' ) { $callback->($item); } foreach my $key ( keys %{ $item } ) { next unless $item->{$key}; if ( $key =~ /time$/ ) { $item->{$key} = _datetime($item->{$key}) } elsif ( $key =~ /(?:link|envelope|image|background|src|icon)$/ ) { $item->{$key} = _uri($item->{$key}); } elsif ( $key eq 'images' ) { $item->{$key} = _images($item->{$key}); } } } $arrayref = [ grep { %{ $_ } && !$_->{_delete} } @{ $arrayref } ]; return $arrayref; } sub _images { my $item = shift; $item = [ $item ] unless ref $item; # a thumbnail my @images; foreach my $i ( @{ $item || [] } ) { next unless $item; push @images, __images($i); } return \@images; } sub __images { my $item = shift; my ($link, $thumb); unless ( ref $item eq 'HASH' ) { $link = $thumb = $item; $link =~ s/s\.jpg$/\.jpg/; $thumb =~ s/(?:[^s])\.jpg$/s\.jpg/; } else { $link = $item->{link} || ''; $thumb = $item->{thumb_link}; if ( $link =~ /MM_openBrWindow\(\s*'([^']+)'/ ) { $link = $1; } } return { link => _uri($link), thumb_link => _uri($thumb) }; } sub _extract_name { my $item = shift; return unless defined $item->{string} && defined $item->{subject}; my $name = substr( delete $item->{string}, length $item->{subject} ); $name =~ s/^\s*\(//; $name =~ s/\)\s*$//; $item->{name} = $name; } 1; __END__