Show
Ignore:
Timestamp:
08/29/08 16:42:16 (4 months ago)
Author:
bayashi
Message:

いろいろと手を加えました

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Net-DMM/trunk/lib/Net/DMM.pm

    r18397 r18428  
    11package Net::DMM; 
    2 # 
    3 # DMMから情報を取得する 
    4 # 
     2 
    53use strict; 
    64use warnings; 
    … …  
    1513 
    1614sub new { 
    17         my $class = shift; 
    18         my $opt   = shift; 
    19         $opt->{ua} = LWP::UserAgent->new unless $opt->{ua}; 
    20         my $self = bless $opt, $class; 
    21         return $self; 
     15    my $class = shift; 
     16    my $opt   = shift; 
     17    $opt->{ua} = LWP::UserAgent->new unless $opt->{ua}; 
     18    my $self = bless $opt, $class; 
     19    return $self; 
    2220} 
    2321 
    2422sub do_scrape { 
    25         my $self = shift; 
    26         my $opt  = shift; 
    27         croak "no url." unless $opt->{url}; 
    28         croak "no scraper." unless $opt->{scraper}; 
    29         my $scrape_module = __PACKAGE__ . "::Scraper::" . $opt->{scraper}; 
    30         return $scrape_module->new({ url => $opt->{url}, opt => $self, }); 
     23    my $self = shift; 
     24    my $opt  = shift; 
     25    croak "no url." unless $opt->{url}; 
     26    croak "no scraper." unless $opt->{scraper}; 
     27    my $scrape_module = __PACKAGE__ . "::Scraper::" . $opt->{scraper}; 
     28    return $scrape_module->new({ 
     29        url => $opt->{url}, 
     30        opt => $self, 
     31    }); 
    3132} 
    3233 
    3334sub search { 
    3435    my $self = shift; 
    35         my $opt  = shift; 
    36         return undef if !$opt->{searchstr} && !$self->{searchstr}; 
    37         $opt->{area} = $self->{area} unless defined $opt->{area}; 
    38         croak "area param is invalid. set 'com' or 'co.jp'." 
    39                 if !$opt->{area} || $opt->{area} !~ /^(?:com|co\.jp)$/; 
    40         $self->{svr} = 'www' unless $self->{svr}; 
    41         $self->{sort} = 'rank_asc' unless $self->{sort}; 
    42         $self->{limit} = 10 unless $self->{limit}; 
    43         $self->{search_url}   = $self->_make_searchurl($opt); 
    44         $self->{redirect_url} = $self->{ua}->get($self->{search_url})->base if $opt->{redirect_url}; 
    45         return { 
    46                 search_url   => $self->{search_url}->as_string, 
    47                 redirect_url => $self->{redirect_url}, 
    48         }; 
     36    my $opt  = shift; 
     37    return if !$opt->{searchstr} && !$self->{searchstr}; 
     38    $opt->{area} = $self->{area} unless defined $opt->{area}; 
     39    croak "area param is invalid. set 'com' or 'co.jp'." 
     40        if !$opt->{area} || $opt->{area} !~ /^(?:com|co\.jp)$/; 
     41    $self->{svr} = 'www' unless $self->{svr}; 
     42    $self->{sort} = 'rank_asc' unless $self->{sort}; 
     43    $self->{limit} = 10 unless $self->{limit}; 
     44    $self->{search_url}   = $self->_make_searchurl($opt); 
     45    $self->{redirect_url} = $self->{ua}->get($self->{search_url})->base if $opt->{redirect_url}; 
     46    return { 
     47        search_url   => $self->{search_url}->as_string, 
     48        redirect_url => $self->{redirect_url}, 
     49    }; 
    4950} 
    5051 
    5152sub _make_searchurl { 
    52         my $self = shift; 
    53         my $opt  = shift; 
    54         my $searchstr = $opt->{searchstr} || $self->{searchstr}; 
    55         my $uri = URI->new("http://".$opt->{svr}.".dmm.".$opt->{area}."/search/"); 
    56         $uri->query_form( 
    57                 category  => $opt->{category} || $self->{category}, 
    58                 searchstr => $self->_make_searchstr($searchstr), 
    59                 sort      => $opt->{sort} || $self->{sort}, 
    60                 limit     => $opt->{limit} || $self->{limit}, 
    61                 redirect  => 1, 
    62         ); 
    63         return $uri; 
     53    my $self = shift; 
     54    my $opt  = shift; 
     55    my $searchstr = $opt->{searchstr} || $self->{searchstr}; 
     56    my $uri = URI->new("http://".$self->{svr}.".dmm.".$opt->{area}."/search/"); 
     57    $uri->query_form( 
     58        category  => $opt->{category} || $self->{category}, 
     59        searchstr => $self->_make_searchstr($searchstr), 
     60        sort      => $opt->{sort} || $self->{sort}, 
     61        limit     => $opt->{limit} || $self->{limit}, 
     62        redirect  => 1, 
     63    ); 
     64    return $uri; 
    6465} 
    6566 
    6667sub _make_searchstr { 
    67         my $self      = shift; 
    68         my $searchstr = shift || return; 
    69         utf8::encode($searchstr) if utf8::is_utf8($searchstr); 
    70         return encode('euc-jp', decode('utf8', $searchstr)); 
     68    my $self      = shift; 
     69    my $searchstr = shift || return; 
     70    utf8::encode($searchstr) if utf8::is_utf8($searchstr); 
     71    return encode('euc-jp', decode('utf8', $searchstr)); 
    7172} 
    7273 
    … …  
    7980Net::DMM - Search and Scrape DMM http://www.dmm.com/ and DMM.ADULT http://www.dmm.co.jp/ 
    8081 
    81  
    82 =head1 VERSION 
    83  
    84 This document describes Net::DMM version 0.0.3 
    85  
    86  
    8782=head1 SYNOPSIS 
    8883 
    89         use Net::DMM; 
    90         use Data::Dumper; 
     84    use Net::DMM; 
     85    use Data::Dumper; 
    9186 
    92         my $dmm = Net::DMM->new(); 
     87    my $dmm = Net::DMM->new(); 
    9388 
    94         my $search = $dmm->search( 
    95                 { 
    96                         'searchstr' => 'てすと', 
    97                         'area'      => 'co.jp', 
    98                         'category'  => 'pcgames', 
    99                 } 
    100         ); 
    101         print Dumper($search); 
     89    my $search = $dmm->search( 
     90        { 
     91            'searchstr' => 'てすと', 
     92            'area'      => 'co.jp', 
     93            'category'  => 'pcgames', 
     94        } 
     95    ); 
     96    print Dumper($search); 
    10297 
    103         my $items = $search->do_scrape( 
    104                 { 
    105                         url     => $search->{search_url}, 
    106                         scraper => 'SearchResult', 
    107                 } 
    108         ); 
    109         print Dumper($items); 
     98    my $items = $dmm->do_scrape( 
     99        { 
     100            url     => $search->{search_url}, 
     101            scraper => 'SearchResult', 
     102        } 
     103    ); 
     104    print Dumper($items); 
     105 
     106=head1 METHOD 
     107 
     108=over 
     109 
     110=item new(I<$args>) 
     111 
     112=item search(I<$args>) 
     113 
     114=item do_scrape(I<$args>) 
     115 
     116=back 
    110117 
    111118=head1 AUTHOR