Perl日記

日々の知ったことのメモなどです。Perlは最近やってないです。

MVCその7

続き。
前回のModelのTestに沿った処理を書く。
まずはResult.pm。PODは省略。

lib/MyHatena::Web::Model::Tag::Result.pm
package MyHatena::Web::Model::Tag::Result;
use Moose;
use namespace::autoclean;

extends 'Catalyst::Model';

__PACKAGE__->meta->make_immutable;

sub entries {
  my $self = shift;
  return @{$self->{entries}};
}

1;
__END__

Mooseも初めてだなー。
make_immutableってしなくてもいいのかなー。
no Mooseってした方がいいのかなー。
namespace::autocleanって何者やねん。
などなどあるけど気にせずGo。

lib/MyHatena::Web::Model::Tag::Search
package MyHatena::Web::Model::Tag::Search;
use Moose;
use namespace::autoclean;

extends 'Catalyst::Model';

has 'title' => (
  is => 'rw',
  isa => 'Str',
);

has 'link' => (
  is => 'rw',
  isa => 'Str',
);

__PACKAGE__->meta->make_immutable;

use LWP::UserAgent;
use Params::Validate qw/:all/;
use URI;
use XML::Simple;
use Encode qw/encode/;
use MyHatena::Web::Model::Tag::Result;

my $HATENA_TAG_API = 'http://b.hatena.ne.jp/t/';
my $HATENA_USERS_API = 'http://b.hatena.ne.jp/entry/';
my $HATENA_USERS_IMG_API = 'http://b.hatena.ne.jp/entry/image/';
my $HATENA_FAVICON_IMG_API = 'http://favicon.st-hatena.com/?url=';

sub search {
  my $class = shift;
  # validate?
  my ($query) = eval {
    validate_pos(@_, { type => SCALAR })
  };

  if ($@ or (q{} eq $query)) {
    return MyHatena::Web::Model::Tag::Result->new(entries => []);
  }

  my $uri = URI->new($HATENA_TAG_API.$query);
  $uri->query_form( sort => 'eid', mode => 'rss' );

  my $ua = LWP::UserAgent->new;
  $ua->agent('VERSION0.01');

  my $res = $ua->get($uri);
  die $res->status_line if $res->is_error;

  my @entries = $class->_parse_xml(\$res->content);

  return MyHatena::Web::Model::Tag::Result->new(entries => \@entries);
}

sub _parse_xml {
  my $class = shift;
  my ($xml_ref) = validate_pos(@_, { type => SCALARREF });
  my $parser = XML::Simple->new;

  my $xml;
  eval { $xml = $parser->XMLin($$xml_ref) };
  die $@ if $@;

  my @entries;
  for my $entry (@{$xml->{item}}) {
    push @entries, $class->new({
      title       => encode('utf8', $entry->{title}),
      link        => $entry->{link},
      description => encode('utf8', $entry->{description}),
      users_link  => $HATENA_USERS_API.$entry->{link},
      users_img   => $HATENA_USERS_IMG_API.$entry->{link},
      favicon_img => $HATENA_FAVICON_IMG_API.$entry->{link},
    });
  }

  return @entries;
}

1;
__END__

うーん。
validateって確かMoose用のがあったはず…。
調べたらMooseX::Params::Validateっていうのがあった。
が、まあ気にせずGo。あとでちゃんと調べよう。
これでtestは通るはず。

$ perl -Ilib t/model_Tag-Search.t 
ok 1 - use MyHatena::Web::Model::Tag::Search;
ok 2 - The object isa MyHatena::Web::Model::Tag::Result
ok 3
ok 4 - The object isa MyHatena::Web::Model::Tag::Result
ok 5
ok 6 - The object isa MyHatena::Web::Model::Tag::Result
ok 7
1..7

通った!
というのは嘘で、通るようにちょっとずつ上のモジュールは修正してた。
特にやっぱりサブルーチン内での引数のチェックがよく分からない。
まあなんとなくいまこんな感じ。