File Coverage

lib/WWW/Mixi/Scraper/Plugin.pm

Criterion	Covered	Total	%
statement	48	121	39.6
branch	6	48	12.5
condition	0	17	0.0
subroutine	11	24	45.8
pod	7	7	100.0
total	72	217	33.1

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 ?
  # $content =~ 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__