Changeset 16148 for lang/perl/tiarra

Show
Ignore:
Timestamp:
07/24/08 01:29:52 (6 years ago)
Author:
drry
Message:
  • 正規表現を修正しました。
  • HTTP を優先するように変更しました。
Files:
1 modified

Legend:

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

    r15771 r16148  
    16351635  my $content2 = $content; 
    16361636  $content2 =~ s/<!--.*?-->//g; 
    1637   if( $content2 =~ m{<META\s+HTTP-EQUIV\s*=\s*(["'])refresh\1\s+CONTENT\s*=\s*(["'])(\d+)\s*;\s*URL=(.+?)\2>}i ) 
    1638   { 
    1639     my $after = $3; 
    1640     my $url   = $4; 
     1637  if( $content2 =~ m{ 
     1638                     <META(?:\s[^>]*?)?\s 
     1639                     (?:HTTP-EQUIV\s*=\s*(["'])refresh\1(?:\s[^>]*?)?\sCONTENT\s*=\s*(["'])(\d+)\s*;\s*URL=(.+?)\2 
     1640                       |CONTENT\s*=\s*(["'])(\d+)\s*;\s*URL=(.+?)\5(?:\s[^>]*?)?\sHTTP-EQUIV\s*=\s*(["'])refresh\8) 
     1641                     (?:\s[^>]*|/)?> 
     1642                   }ix ) 
     1643  { 
     1644    my $after = $3 || $6; 
     1645    my $url   = $4 || $7; 
    16411646    $DEBUG and $this->_debug($full_ch_name, "debug: meta.refresh found: $after; $url"); 
    16421647    $result->{redirect} = $url; 
     
    16451650  # detect encoding. 
    16461651  my $enc = 'auto'; 
    1647   if( $content2 =~ m{<meta\s+http-equiv\s*=\s*(["'])Content-Type\1\s+content\s*=\s*(["'])\w+/\w+(?:\+\w+)*\s*;\s*charset=([-\w]+)\2\s*/?>}i ) 
    1648   { 
    1649     my $e = lc($3); 
    1650     $enc = $e =~ /s\w*jis/     ? 'sjis' 
    1651          : $e =~ /euc/         ? 'euc' 
    1652          : $e =~ /utf-?8/      ? 'utf8' 
    1653          : $e =~ /iso-2022-jp/ ? 'jis' 
    1654          : $e =~ /\bjis\b/     ? 'jis' 
    1655          : $enc; 
    1656     $DEBUG and $this->_debug($full_ch_name, "debug: charset $enc from meta ($e)"); 
    1657   } 
    1658   if( $enc eq 'auto' && $headers->{'Content-Type'} && $headers->{'Content-Type'} =~ /;\s*charset=(\S+)/ ) 
     1652  if( $headers->{'Content-Type'} && $headers->{'Content-Type'} =~ /;\s*charset=(\S+)/ ) 
    16591653  { 
    16601654    my $e = lc($1); 
     
    16661660         : $enc; 
    16671661    $DEBUG and $this->_debug($full_ch_name, "debug: charset $enc from http-header ($e)"); 
     1662  } 
     1663  if( $enc eq 'auto' && $content2 =~ m{ 
     1664                                       <meta(?:\s[^>]*?)?\s 
     1665                                       (?:http-equiv\s*=\s*(["'])Content-Type\1(?:\s[^>]*?)?\scontent\s*=\s*(["'])\w+/\w+(?:\+\w+)*\s*;\s*charset=([-\w]+)\2 
     1666                                         |content\s*=\s*(["'])\w+/\w+(?:\+\w+)*\s*;\s*charset=([-\w]+)\4(?:\s[^>]+?)?\shttp-equiv\s*=\s*(["'])Content-Type\6) 
     1667                                       (?:\s[^>]*|/)?> 
     1668                                     }ix ) 
     1669  { 
     1670    my $e = lc($3 || $5); 
     1671    $enc = $e =~ /s\w*jis/     ? 'sjis' 
     1672         : $e =~ /euc/         ? 'euc' 
     1673         : $e =~ /utf-?8/      ? 'utf8' 
     1674         : $e =~ /iso-2022-jp/ ? 'jis' 
     1675         : $e =~ /\bjis\b/     ? 'jis' 
     1676         : $enc; 
     1677    $DEBUG and $this->_debug($full_ch_name, "debug: charset $enc from meta ($e)"); 
    16681678  } 
    16691679  if( $enc eq 'auto' )