Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

add new_from_url (Using LWP) (David Pottage) (RT #68097)

  • Loading branch information...
commit 5785d7fc8c33e7c43b8d3b678ed4c1f38beeab86 1 parent 9e691ff
Jeff Fearn authored June 07, 2011
36  Build.PL
@@ -25,25 +25,29 @@ my $class = Module::Build->subclass(
25 25
 );
26 26
 
27 27
 my $builder = $class->new(
28  
-    module_name       => 'HTML::Tree',
29  
-    license           => 'perl',
30  
-    dist_author       => 'Jeff Fearn <jfearn@cpan.org>',
31  
-    dist_version_from => 'lib/HTML/Element.pm',
32  
-	create_makefile_pl => 'traditional',
33  
-    build_requires    => {
34  
-        'Module::Build'       => 0,
35  
-        'Test::Exception'     => 0,
36  
-        'Test::More'          => 0,
37  
-        'HTML::Parser'        => 3.46,
38  
-        'HTML::Tagset'        => 3.02,
  28
+    module_name        => 'HTML::Tree',
  29
+    license            => 'perl',
  30
+    dist_author        => 'Jeff Fearn <jfearn@cpan.org>',
  31
+    dist_version_from  => 'lib/HTML/Element.pm',
  32
+    create_makefile_pl => 'traditional',
  33
+    build_requires     => {
  34
+        'Module::Build'   => 0,
  35
+        'Test::Exception' => 0,
  36
+        'Test::More'      => 0,
  37
+        'HTML::Parser'    => 3.46,
  38
+        'HTML::Tagset'    => 3.02,
  39
+        'LWP::UserAgent'  => 0,
  40
+        'URI::file'       => 0,
39 41
     },
40 42
     requires => {
41  
-        'HTML::Parser' => 3.46,
42  
-        'HTML::Tagset' => 3.02,
43  
-        'perl'         => '5.8.0',
  43
+        'HTML::Parser'    => 3.46,
  44
+        'HTML::Tagset'    => 3.02,
  45
+        'perl'            => '5.8.0',
  46
+        'LWP::UserAgent'  => 0,
44 47
     },
45  
-    add_to_cleanup => [ 'HTML-Tree-*', 'tmp', 'blib', 'lwp-test-*', 'MANIFEST.bak' ],
46  
-    script_files   => ['htmltree'],
  48
+    add_to_cleanup =>
  49
+        [ 'HTML-Tree-*', 'tmp', 'blib', 'lwp-test-*', 'MANIFEST.bak' ],
  50
+    script_files => ['htmltree'],
47 51
 );
48 52
 
49 53
 $builder->create_build_script();
6  Changes
... ...
@@ -1,5 +1,9 @@
1 1
 Changelog for HTML-Tree
2  
-4.2
  2
+4.3 UNRELEASED
  3
+    [FIXES]
  4
+    * add new_from_url (Using LWP) (David Pottage) (RT #68097)
  5
+
  6
+4.2 Wed 06 Apr 2011
3 7
     [FIXES]
4 8
     * Tied all $VERSION to HTML::Element to ensure latest package is used
5 9
       for all modules. RT #66110
1  Makefile.PL
@@ -15,6 +15,7 @@ WriteMakefile
15 15
                            'Test::Exception' => 0,
16 16
                            'HTML::Tagset' => '3.02',
17 17
                            'HTML::Parser' => '3.46',
  18
+                           'LWP::UserAgent' => 0,
18 19
                            'Module::Build' => 0
19 20
                          }
20 21
         )
6  lib/HTML/Tree.pm
@@ -55,6 +55,12 @@ sub new_from_content {
55 55
     goto &HTML::TreeBuilder::new_from_content;
56 56
 }
57 57
 
  58
+sub new_from_url {
  59
+    shift;
  60
+    unshift @_, 'HTML::TreeBuilder';
  61
+    goto &HTML::TreeBuilder::new_from_url;
  62
+}
  63
+
58 64
 1;
59 65
 __END__
60 66
 
18  lib/HTML/TreeBuilder.pm
@@ -52,12 +52,13 @@ BEGIN {
52 52
 
53 53
 #---------------------------------------------------------------------------
54 54
 
  55
+use LWP::UserAgent;
55 56
 use HTML::Entities ();
56 57
 use HTML::Tagset 3.02 ();
57 58
 
58 59
 use HTML::Element ();
59 60
 use HTML::Parser  ();
60  
-@ISA = qw(HTML::Element HTML::Parser);
  61
+@ISA     = qw(HTML::Element HTML::Parser);
61 62
 $VERSION = 4.2;
62 63
 
63 64
 # This looks schizoid, I know.
@@ -109,8 +110,21 @@ sub new_from_content {    # from any number of scalars
109 110
     return $new;
110 111
 }
111 112
 
  113
+sub new_from_url {                     # should accept anything that LWP does.
  114
+    my $class = shift;
  115
+    Carp::croak("new_from_url takes only one argument")
  116
+        unless @_ == 1;
  117
+    Carp::croak("new_from_url is a class method only")
  118
+        if ref $class;
  119
+    my $new = $class->new();
  120
+
  121
+    my $fetch_result = LWP::UserAgent->new->get( $_[0] );
  122
+    $new->parse( $fetch_result->content );
  123
+    return $new;
  124
+}
  125
+
112 126
 # TODO: document more fully?
113  
-sub parse_content {                    # from any number of scalars
  127
+sub parse_content {    # from any number of scalars
114 128
     my $tree = shift;
115 129
     my $retval;
116 130
     foreach my $whunk (@_) {
19  t/construct_tree.t
... ...
@@ -1,9 +1,9 @@
1  
-#!/usr/bin/perl -T
  1
+#!/usr/bin/perl
2 2
 
3 3
 use warnings;
4 4
 use strict;
5 5
 
6  
-use Test::More tests => ( 3 + 7 * 8 );
  6
+use Test::More tests => ( 3 + 7 * 10 );
7 7
 
8 8
 #initial tests + number of tests in test_new_obj() * number of times called
9 9
 
@@ -69,6 +69,21 @@ is( $HTMLPart1 . $HTMLPart2, $HTML, "split \$HTML correctly" );
69 69
     test_new_obj( $parse_content_obj, "new(); parse_content Scalar" );
70 70
 }
71 71
 
  72
+# URL tests
  73
+{
  74
+    my $file_url = URI->new( "file:" . $TestInput );
  75
+
  76
+    {
  77
+        my $file_obj = HTML::Tree->new_from_url( $file_url->as_string );
  78
+        test_new_obj( $file_obj, "new_from_url Scalar" );
  79
+    }
  80
+
  81
+    {
  82
+        my $file_obj = HTML::Tree->new_from_url($file_url);
  83
+        test_new_obj( $file_obj, "new_from_url Object" );
  84
+    }
  85
+}
  86
+
72 87
 # Scalar REF Tests
73 88
 {
74 89
     my $content_obj = HTML::Tree->new_from_content($HTML);

0 notes on commit 5785d7f

Please sign in to comment.
Something went wrong with that request. Please try again.