File Coverage

lib/URL/Transform/using/HTML/Parser.pm
Criterion Covered Total %
statement 133 133 100.0
branch 30 38 78.9
condition 25 32 78.1
subroutine 31 31 100.0
pod 5 5 100.0
total 224 239 93.7


line stmt bran cond sub pod time code
1             package URL::Transform::using::HTML::Parser;
2              
3             =head1 NAME
4              
5             URL::Transform::using::HTML::Parser - HTML::Parse parsing of the html/xml for url transformation
6              
7             =head1 SYNOPSIS
8              
9             my $urlt = URL::Transform::using::HTML::Parser->new(
10             'output_function' => sub { $output .= "@_" },
11             'transform_function' => sub { return (join '|', @_) },
12             );
13             $urlt->parse_file($Bin.'/data/URL-Transform-01.html');
14              
15             print "and this is the output: ", $output;
16              
17              
18             =head1 DESCRIPTION
19              
20             Using this module you can performs an url transformation on the HTML/XML documents.
21              
22             This module is used by L.
23              
24             The url matching algorithm is taken from L/eg/hrefsub example
25             script.
26              
27             =cut
28              
29 1     1   1790 use warnings;
  1         2  
  1         34  
30 1     1   4 use strict;
  1         2  
  1         38  
31              
32             our $VERSION = '0.01';
33              
34 1     1   1171 use HTML::Parser ();
  1         6918  
  1         59  
35 1     1   9 use Carp::Clan;
  1         2  
  1         9  
36 1     1   174 use English '$EVAL_ERROR';
  1         2  
  1         7  
37              
38 1     1   124 use URL::Transform ();
  1         2  
  1         43  
39              
40              
41             # Construct a hash of tag names that may have links.
42             my $_link_tags = URL::Transform::link_tags();
43             my $_js_attributes = URL::Transform::js_attributes();
44              
45              
46 1     1   6 use base 'Class::Accessor::Fast';
  1         1  
  1         1075  
47              
48             =head1 PROPERTIES
49              
50             output_function
51             transform_function
52             parser_for
53              
54             _html_parser
55              
56             =cut
57              
58             __PACKAGE__->mk_accessors(qw{
59             output_function
60             transform_function
61             parser_for
62              
63             _html_parser
64             });
65              
66             =head1 METHODS
67              
68             =cut
69              
70              
71             =head2 new
72              
73             Object constructor.
74              
75             Requires:
76              
77             output_function
78             transform_function
79              
80             Optional:
81              
82             parser_for
83              
84             =cut
85              
86             sub new {
87 5     5 1 102 my $class = shift;
88              
89 5         35 my $self = $class->SUPER::new({ @_ });
90              
91 5         74 my $output_function = $self->output_function;
92 5         38 my $transform_function = $self->transform_function;
93            
94 5 50       34 croak 'pass print function'
95             if not (ref $output_function eq 'CODE');
96            
97 5 50       14 croak 'pass transform url function'
98             if not (ref $transform_function eq 'CODE');
99              
100 5     26   23 $transform_function = sub { $self->transform_function_wrapper(@_) };
  26         57  
101            
102 5         43 my $html_parser = HTML::Parser->new(api_version => 3);
103              
104             # The default is to print everything as it is.
105             $html_parser->handler(
106             default => sub {
107 15     15   659 $output_function->(@_);
108 5         199 }, "text"
109             );
110            
111             # cleanup current tag on every end tag
112             # should work fine for our purpouse as we are not interrested in nested tags
113 5         10 my $current_tag = '';
114             $html_parser->handler(
115             end => sub {
116 47     47   308 $current_tag = '';
117 47         64 my $text = shift;
118            
119             # rename to in case javascript is removed
120 47 50       118 if ($self->parser_for->('application/x-javascript') eq 'Remove') {
121 47 100       117 $text = '' if $text =~ m{^
122             }
123            
124 47         171 $output_function->($text);
125 5         56 }, "text"
126             );
127            
128             # Links inside the text of the tag (just