Changeset 20765

Timestamp:

10/05/08 12:26:32 (5 years ago)

Author:

miki

Message:

いくつかのバグを修正

Location:

lang/perl/HTML-Feature/trunk

Files:

• Changes (modified) (1 diff)
• lib/HTML/Feature.pm (modified) (12 diffs)
• lib/HTML/Feature/Engine/TagStructure.pm (modified) (6 diffs)
• t/03_run/engine.t (added)
• t/03_run/ua.t (added)
• t/regression (added)
• t/regression/join_several_words.t (added)

lang/perl/HTML-Feature/trunk/Changes

@@ -1 +1 @@
 Revision history for Perl extension HTML::Feature.
+
+
+2.00006 2008.10.05
+    - fix a bug that improperty joins of several words
+    - set 'user_agent' option
+    - an object of HTML::Feature::Engine can recognize the base_url
+      via context object ( $c->{base_url} )
+    - add test codes
 
 2.00005 2008.08.15

lang/perl/HTML-Feature/trunk/lib/HTML/Feature.pm

@@ -12 +12 @@
 use URI;
 
-$VERSION   = '2.00005';
+$VERSION   = '2.00006';
 @EXPORT_OK = qw(feature);
 
@@ -29 +29 @@
     my $obj  = shift;
 
-    if (! $obj) {
+    if ( !$obj ) {
         croak('Usage: parse( $uri | $http_response | $html_ref )');
     }
 
-    my $pkg  = blessed($obj);
-    if (! $pkg) {
-        if (my $ref = ref $obj) {
+    my $pkg = blessed($obj);
+    if ( !$pkg ) {
+        if ( my $ref = ref $obj ) {
+
             # if it's a scalar reference, then we've been passed a piece of
-            # HTML code. 
-            if ($ref eq 'SCALAR') {
+            # HTML code.
+            if ( $ref eq 'SCALAR' ) {
                 return $self->parse_html( $obj, @_ );
             }
@@ -52 +53 @@
 
     # If it's an object, then we can handle URI or HTTP::Response
-    if ($pkg->isa('URI')) {
+    if ( $pkg->isa('URI') ) {
         return $self->parse_url( $obj, @_ );
-    } elsif ($pkg->isa('HTTP::Response')) {
+    }
+    elsif ( $pkg->isa('HTTP::Response') ) {
         return $self->parse_response( $obj, @_ );
-    } else {
+    }
+    else {
         croak('Usage: parse( $uri | $http_response | $html_ref )');
     }
@@ -66 +69 @@
     my $ua   = $self->_user_agent();
     my $res  = $ua->get($url);
-    $self->parse_response($res, @_);
+    $self->parse_response( $res, @_ );
 }
 
@@ -72 +75 @@
     my $self = shift;
     my $res  = shift;
+    $self->{base_url} = $res->base;
     my $content = $self->_decode_response($res);
     $self->_run( \$content, @_ );
@@ -77 +81 @@
 
 sub parse_html {
-    my $self = shift;
-    my $html = shift;
+    my $self     = shift;
+    my $html     = shift;
     my $html_ref = ref $html ? $html : \$html;
-    $self->_decode_htmlref( $html_ref );
+    $self->_decode_htmlref($html_ref);
     $self->_run( $html_ref, @_ );
 }
 
-sub engine
-{
+sub engine {
     my $self   = shift;
     my $engine = $self->{engine_obj};
-    if(! $engine){
+    if ( !$engine ) {
         my $engine_module = $self->{engine} ? $self->{engine} : 'TagStructure';
         my $class = __PACKAGE__ . '::Engine::' . $engine_module;
@@ -94 +97 @@
         $engine = $class->new;
         $self->{engine_obj} = $engine;
-    }    
+    }
     return $engine;
 }
@@ -103 +106 @@
     my $opts     = shift || {};
 
-    local $self->{element_flag} = exists $opts->{element_flag} ? $opts->{element_flag} : $self->{element_flag};
-    $self->engine->run($self, $html_ref);
-}
-
-sub _decode_response
-{
+    local $self->{element_flag} =
+      exists $opts->{element_flag}
+      ? $opts->{element_flag}
+      : $self->{element_flag};
+    $self->engine->run( $self, $html_ref );
+}
+
+sub _decode_response {
     my $self = shift;
     my $res  = shift;
@@ -114 +119 @@
     my @encoding = (
         $res->encoding,
+
         # XXX - falling back to latin-1 may be risky. See Data::Decode
         # could be multiple because HTTP response and META might be different
@@ -119 +125 @@
         "latin-1",
     );
-    my $encoding =
-        first { defined $_ && Encode::find_encoding($_) } @encoding;
+    my $encoding = first { defined $_ && Encode::find_encoding($_) } @encoding;
     return Encode::decode( $encoding, $res->content );
 }
 
-sub _decode_htmlref
-{
-    my $self = shift;
+sub _decode_htmlref {
+    my $self     = shift;
     my $html_ref = shift;
 
     local $Encode::Guess::NoUTFAutoGuess = 1;
     my $guess =
-        Encode::Guess::guess_encoding( $$html_ref,
-            ( 'shiftjis', 'euc-jp', '7bit-jis', 'utf8' ) );
+      Encode::Guess::guess_encoding( $$html_ref,
+        ( 'shiftjis', 'euc-jp', '7bit-jis', 'utf8' ) );
     unless ( ref $guess ) {
         $$html_ref = Encode::decode( "latin-1", $$html_ref );
-    } else {
+    }
+    else {
         eval { $$html_ref = $guess->decode($$html_ref); };
     }
@@ -144 +149 @@
     require LWP::UserAgent;
     $UserAgent ||= LWP::UserAgent->new();
+    $self->{user_agent} and $UserAgent->agent( $self->{user_agent} );
     $self->{http_proxy} and $UserAgent->proxy( ['http'], $self->{http_proxy} );
-    $self->{timeout} and $UserAgent->timeout( $self->{timeout} );
+    $self->{timeout}    and $UserAgent->timeout( $self->{timeout} );
     return $UserAgent;
 }
@@ -232 +238 @@
         min_bytes => 10, # minimum number of bytes per node to analyze (default is '')
         enc_type => 'euc-jp', # encoding of return values (default: 'utf-8')
+        user_agent => 'my-agent-name', # LWP::UserAgent->agent (default: 'libwww-perl/#.##') 
         http_proxy => 'http://proxy:3128', # http proxy server (default: '')
         timeout => 10, # set the timeout value in seconds. (default: 180)

lang/perl/HTML-Feature/trunk/lib/HTML/Feature/Engine/TagStructure.pm

@@ -32 +32 @@
     # control code ( 0x00 - 0x1F, and 0x7F on ascii)
     for ( 0 .. 31 ) {
+        next if $_ == 10;# without NL(New Line)
         my $control_code = '\x' . sprintf( "%x", $_ );
         $$html_ref =~ s{$control_code}{}xmg;
@@ -93 +94 @@
         $node_hash{short_string_length} ||= 0;
         $node_hash{text}                ||= $text;
-
-        next if $node_hash{text} !~ /[^ ]+/;
 
         $data->[$i]->{text} = $node_hash{text};
@@ -142 +141 @@
         $_;
       } ( 0 .. $i );
-    $data->[ $sorted[0] ]->{text} =~ s/ $//s;
+
+    $data->[ $sorted[0] ]->{text} and $data->[ $sorted[0] ]->{text} =~ s/ $//s;
 
     $result->text( $data->[ $sorted[0] ]->{text} );
@@ -153 +153 @@
     if ( $c->{enc_type} ) {
         $result->title( Encode::encode( $c->{enc_type}, $result->title ) );
-        $result->desc( Encode::encode( $c->{enc_type},  $result->desc ) );
-        $result->text( Encode::encode( $c->{enc_type},  $result->text ) );
+        $result->desc( Encode::encode( $c->{enc_type}, $result->desc ) );
+        $result->text( Encode::encode( $c->{enc_type}, $result->text ) );
     }
 
@@ -166 +166 @@
 
     if ( ref $node ) {
-        if ( $node->tag =~ /p|br|hr|tr|ul|li|ol|dl|dd/ ) {
+        if ( $node->tag =~ /p|br|hr|tr|ul|li|ol|dl|dd|h[1-6]/ ) {
             $node_hash_ref->{text} .= "\n";
         }
@@ -185 +185 @@
 }
 
-
-
 1;