Changeset 9987

Show
Ignore:
Timestamp:
04/20/08 16:52:19 (7 years ago)
Author:
hio
Message:

lang/perl/tiarra: 見出し抽出の追加, 200以外でも抽出を行えるように.

Files:
1 modified

Legend:

Unmodified
Added
Removed
  • lang/perl/tiarra/trunk/module/Auto/FetchTitle.pm

    r9012 r9987  
    10451045  my $config = [ 
    10461046    { 
     1047      # 1. ぷりんと楽譜. 
    10471048      url        => 'http://www.print-gakufu.com/*', 
    10481049      recv_limit => 8*1024, 
     
    10511052    }, 
    10521053    { 
     1054      # 2. zakzak. 
    10531055      url        => 'http://www.zakzak.co.jp/*', 
    10541056      recv_limit => 10*1024, 
     
    10561058    }, 
    10571059    { 
     1060      # 3. nikkei. 
    10581061      url        => 'http://www.nikkei.co.jp/*', 
    10591062      recv_limit => 16*1024, 
     
    10651068    }, 
    10661069    { 
     1070      # 4. nhkニュース. 
    10671071      url     => 'http://www*.nhk.or.jp/news/*', 
    10681072      extract => qr{<p class="newstitle">(.*?)</p>}, 
    10691073    }, 
    10701074    { 
     1075      # 5. creative (timeout). 
    10711076      url     => 'http://*.creative.com/*', 
    10721077      timeout => 5, 
    10731078    }, 
    10741079    { 
     1080      # 6. soundhouse news. 
    10751081      url        => 'http://www.soundhouse.co.jp/shop/News.asp?NewsNo=*', 
    10761082      recv_limit => 50*1024, 
     
    10781084    }, 
    10791085    { 
    1080       # trac changeset. 
     1086      # 7. trac changeset. 
    10811087      url        => '*/changeset/*', 
    10821088      extract    => qr{<dd class="message" id="searchable"><p>(.*?)</p>}s, 
    10831089    }, 
    10841090    { 
     1091      # 8a. amazon (page size). 
    10851092      url        => 'http://www.amazon.co.jp/*', 
    10861093      recv_limit => 15*1024, 
    10871094    }, 
    10881095    { 
     1096      # 8b. amazon (page size). 
    10891097      url        => 'http://www.amazon.com/*', 
    10901098      recv_limit => 15*1024, 
     1099    }, 
     1100    { 
     1101      # 9. ニコニコ動画 (メンテ画面). 
     1102      status     => 503, 
     1103      url        => 'http://www.nicovideo.jp/*', 
     1104      extract    => sub{ 
     1105        if( m{<div class="mb16p4 TXT12">\s*<p>現在ニコニコ動画は(メンテナンス中)です。</p>\s*<p>(.*?)<br />}s ) 
     1106        { 
     1107          "$1: $2"; 
     1108        }else 
     1109        { 
     1110          return; 
     1111        } 
     1112      }, 
     1113    }, 
     1114    { 
     1115      # 10. sanspo. 
     1116      url        => 'http://www.sanspo.com/*', 
     1117      recv_limit => 5*1024, 
     1118      extract    => qr{<h2>(.*?)</h2>}s, 
     1119    }, 
     1120    { 
     1121      # 11. sakura. 
     1122      url        => 'http://www.sakura.ad.jp/news/archives/*', 
     1123      recv_limit => 10*1024, 
     1124      extract    => qr{<h3 class="newstitle">(.*?)</h3>}s, 
    10911125    }, 
    10921126  ]; 
     
    11071141  my $type  = shift; 
    11081142 
    1109   my $conflist = $this->_extract_heading_config(); 
    1110  
    1111   foreach my $conf (@$conflist) 
     1143  my $extract_list = $this->_extract_heading_config(); 
     1144 
     1145  foreach my $conf (@$extract_list) 
    11121146  { 
    11131147    Mask::match($conf->{url}, $req->{url}) or next; 
     
    11471181    return; 
    11481182  } 
    1149   if( $req->{result}{status_code}!=200 ) 
    1150   { 
    1151     $DEBUG and $this->_debug($req, "debug: - - skip/not success:$req->{result}{status_code}"); 
    1152     return; 
    1153   } 
    1154  
    1155   my $conflist = $this->_extract_heading_config(); 
     1183  my $status = $req->{result}{status_code}; 
     1184 
     1185  my $extract_list = $this->_extract_heading_config(); 
    11561186 
    11571187  my $heading; 
    11581188 
    1159   foreach my $conf (@$conflist) 
     1189  foreach my $conf (@$extract_list) 
    11601190  { 
    11611191    Mask::match($conf->{url}, $req->{url}) or next; 
    11621192    $DEBUG and $this->_debug($req, "debug: - $conf->{url}"); 
     1193 
     1194    my $extract_status = $conf->{status} || 200; 
     1195    if( $status != $extract_status ) 
     1196    { 
     1197      $DEBUG and $this->_debug($req, "debug: - - status:$status not match with $extract_status"); 
     1198      next; 
     1199    } 
    11631200 
    11641201    my $extract_list = $conf->{extract}; 
     
    11721209      my $extract = $_extract; # sharrow-copy. 
    11731210      $extract = ref($extract) ? $extract : qr/\Q$extract/; 
    1174       my @match = $req->{result}{decoded_content} =~ $extract; 
     1211      my @match; 
     1212      if( ref($extract) eq 'CODE' ) 
     1213      { 
     1214        local($_) = $req->{result}{decoded_content}; 
     1215        @match = $extract->($req); 
     1216      }else 
     1217      { 
     1218        @match = $req->{result}{decoded_content} =~ $extract; 
     1219      } 
    11751220      @match or next; 
     1221      @match==1 && !defined($match[0]) and next; 
    11761222      $heading = $match[0]; 
    11771223      last; 
     
    14191465    content_length => undef, 
    14201466    decoded_content => undef, 
     1467    fetch_length    => undef, 
    14211468  }; 
    14221469 
     
    14451492  my $headers     = $res->{Header}; # hash-ref. 
    14461493  my $content     = $res->{Content}; 
     1494  $result->{fetch_length} = defined($content) ? length($content) : undef; 
    14471495  defined($content) or $content = ''; 
     1496  my @opts; 
    14481497 
    14491498  $result->{status_code}    = $status_code; 
     
    14831532  if( int($status_code / 100) != 2 && !$result->{redirect} ) 
    14841533  { 
    1485     my @opts; 
    1486     $status_msg and push(@opts, $status_msg); 
     1534    $result->{title} = $status_msg; 
    14871535    push(@opts, "http status $status_code"); 
    1488     if( $req->{redirected} ) 
    1489     { 
    1490       my $redirs = $req->{redirected}==1 ? 'redir' : 'redirs'; 
    1491       push(@opts, "$req->{redirected} $redirs"); 
    1492     } 
    1493     my $reply = shift @opts; 
    1494     if( @opts ) 
    1495     { 
    1496       $reply .= " (".join("; ", @opts).")"; 
    1497     } 
    1498     $result->{result} = $reply; 
    1499     return $result; 
    15001536  } 
    15011537 
     
    15591595    $title = $this->_fixup_title($title); 
    15601596    $result->{title} = $title; 
     1597  }else 
     1598  { 
     1599    $title = $result->{title}; 
    15611600  } 
    15621601 
     
    15951634  } 
    15961635 
    1597   my @opts; 
    15981636  if( $reply eq '' || $ctype !~ /html/ ) 
    15991637  {