Perl日記

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

MVCその2

MVCその1 - Perl日記の続き。
とりあえず最初の段階、一枚岩でベタすぎるほどのベタ書きで作ってみた。
その割に、ものすごく馴染みがあるというか見覚えがあるというか親近感があるというか。
めちゃくちゃ小規模ならこれでもいいんだろうけどな…。
だめだなー。
あと、まだ動作未検証。多分動かない。
写経っぽく作ったので、これだけでも勉強になってしまった。
以下、コード。
(2010/2/6 23:27 追記:動くように修正しました)

#!/usr/local/bin/perl
# tag_search.cgi
use strict;
use warnings;
use CGI qw/:standard/;
use LWP::UserAgent;
use Params::Validate qw/:all/;
use URI;
use XML::Simple;
use Encode qw/encode/;

my $HATENA_TAG_API = "http://b.hatena.ne.jp/t/";

my $q = CGI->new;

# HTML Display
print
  header( -type => 'text/html', -charset => 'utf-8' ),
  start_html( -title => 'Hatena Tag Search' ),
  h1( 'Hatena Tag Search' ),
  start_form( -method => 'get' ),
  textfield( -name => 'search_tag', -value => $q->param('search_tag') || q{} ),
  submit( -value => 'Search' ),
  end_form,
;

# exist Query ?
if (my $search_tag = $q->param('search_tag')) {
  # Result of Search
  print
    h2('Result'),
    ul(
      li( [ map anchor($_), @{search_hatena_tag($search_tag)->{item}} ] )
    ),
  ;
}

print end_html;

sub search_hatena_tag {
  my ($query) = validate_pos(@_, { type => SCALAR });

  # Hatena Tag RSS API
  my $uri = URI->new($HATENA_TAG_API.$query);

  $uri->query_form( sort => 'eid', mode => 'rss' );

  my $ua = LWP::UserAgent->new;

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

  return _parse_data(\$res->content);
}

sub _parse_data {
  my ($xml_ref) = validate_pos(@_, { type => SCALARREF });
  my $parser = XML::Simple->new;
  my $data;
  eval { $data = $parser->XMLin($$xml_ref) };
  die $@ if $@;
  return $data;
}

sub anchor {
  my ($entry) = validate_pos(@_, { type => HASHREF });
  # <a>tag
  return( a({ href => $entry->{link} }, encode('utf8', $entry->{title})) );
}

__END__

明日また時間とってやる。



(2010/2/6 23:27 追記:画面イメージ)