File Coverage

blib/lib/Mojo/Ecrawler.pm
Criterion Covered Total %
statement 17 57 29.8
branch 0 16 0.0
condition n/a
subroutine 6 13 46.1
pod 1 7 14.2
total 24 93 25.8


line stmt bran cond sub pod time code
1             package Mojo::Ecrawler;
2              
3 1     1   66629 use Mojo::UserAgent;
  1         443246  
  1         9  
4 1     1   61 use 5.010;
  1         5  
5 1     1   8 use Encode qw(decode encode decode_utf8 encode_utf8);
  1         2  
  1         101  
6 1     1   8 use Mojo::IOLoop;
  1         3  
  1         8  
7 1     1   39 use strict;
  1         2  
  1         23  
8 1     1   5 use warnings;
  1         2  
  1         718  
9              
10             our @ISA = qw(Exporter);
11             our @EXPORT = qw(geturlcontent getdiv gettext);
12              
13             =encoding utf8
14              
15             =head1 NAME
16              
17             Mojo::Ecrawler - A Eeay crawler for html page!
18              
19             =head1 VERSION
20              
21             Version 0.04
22              
23             =cut
24              
25             our $VERSION = '0.05';
26              
27             =head1 SYNOPSIS
28              
29             use Mojo::Ecrawler;
30             $lurl='http://www.oschina.net';
31             $re1="div.TodayNews";#scope tag
32             $re2="li a";# line tag
33              
34             my $pcontent=geturlcontent($lurl);
35             my $pcout=getdiv($pcontent,$re1,$re2);
36             print $pcout;
37             ...
38              
39             =head1 EXPORT
40              
41             =head2 getulcontent()
42              
43             Using Mojo::UserAgent to get the page content。
44            
45             IN: $url,the page's url.
46             OUT:Mojo dom object .
47              
48             =head2 getdiv()
49              
50             Get content of filter using Mojo:DOM
51              
52             IN:1,Mojo dom object;
53             2,$re1: scope tag(div.xxx div#xxx div xx ..).
54             3,$rel: line tag(a hi ..);
55              
56             OUT: the final content.
57              
58             =cut
59              
60             my $DEBUG = 0;
61             my $host;
62             sub geturlcontent {
63 0     0 0   my $url = shift;
64 0 0         $host= $1 if $url=~/(http:\/\/[^\/]*)\//;
65 0           my $ua= Mojo::UserAgent->new;
66 0           $ua->transactor->name( 'Mozilla/5.0 (Macintosh; '
67             . 'Intel Mac OS X 10_8_5) AppleWebKit/537.36 '
68             . '(KHTML, like Gecko) Chrome/29.0.1547.76 Safari/537.36' );
69 0           my $recontent;
70 0           my $result = ( $ua->get($url) );
71 0           return $result->res->dom;
72             }
73              
74             sub getfile {
75 0     0 0   my ($url,$filename) = @_;
76 0           my $ua = Mojo::UserAgent->new;
77 0           $ua->transactor->name( 'Mozilla/5.0 (Macintosh; '
78             . 'Intel Mac OS X 10_8_5) AppleWebKit/537.36 '
79             . '(KHTML, like Gecko) Chrome/29.0.1547.76 Safari/537.36' );
80 0           my $tx = $ua->get($url);
81 0           $tx->res->content->asset->move_to($filename);
82             }
83              
84             sub getdiv {
85              
86 0     0 1   my ( $dom, $re1, $re2, $ind ) = @_;
87 0           my $recontent;
88 0           my @div = $dom->find($re1)->each;
89 0           for (@div){
90              
91 0 0         $recontent .= getndiv( $_, $re2, $ind ) if getndiv( $_, $re2, $ind );
92              
93             }
94 0 0         print "DEBUG:getndiv()\::OUT:\n", $recontent if $DEBUG;
95 0           return $recontent;
96             }
97              
98             sub getndiv {
99              
100             #my $DEBUG=1;
101 0     0 0   my ( $st, $re, $ind ) = @_;
102 0           my $ndom = gmyc($st);
103 0           my @ndiv = $ndom->find($re)->each;
104 0           my $nrecontent;
105 0           for (@ndiv) {
106 0           $nrecontent .= $_->content;
107 0 0         my $surl=$_->attr->{href} if $ind;
108             # $surl = $host.$surl unless $surl=~/https?:/;
109 0 0         $nrecontent .= " ".$surl if $surl;
110 0           $nrecontent .= "\n";
111             }
112 0 0         print "DEBUG:getndiv()\::OUT:\n", $nrecontent if $DEBUG;
113 0           return $nrecontent;
114              
115             }
116              
117             sub oplink {
118             ...
119              
120              
121 0     0 0   }
122             sub gettext {
123              
124 0     0 0   my ( $st, $re ) = @_;
125 0           my $ndom = gmyc($st);
126 0           my $nrecontent = $ndom->all_text;
127            
128 0           $nrecontent .= "\n";
129 0 0         print "DEBUG:getndiv()\::OUT:\n", $nrecontent if $DEBUG;
130 0           return $nrecontent;
131              
132             }
133              
134             sub gmyc {
135              
136 0     0 0   my ( $c, $s ) = @_;
137 0 0         my $dom = $s ? Mojo::DOM->new($c)->at($s) : Mojo::DOM->new($c);
138 0           return $dom;
139              
140             }
141              
142             =head1 AUTHOR
143              
144             ORANGE, C<< >>
145              
146             =head1 BUGS
147              
148             Please report any bugs or feature requests to C, or through
149             the web interface at L. I will be notified, and then you'll
150             automatically be notified of progress on your bug as I make changes.
151              
152              
153              
154              
155             =head1 SUPPORT
156              
157             You can find documentation for this module with the perldoc command.
158              
159             perldoc Mojo::Ecrawler
160              
161              
162             You can also look for information at:
163              
164             =over 4
165              
166             =item * RT: CPAN's request tracker (report bugs here)
167              
168             L
169              
170             =item * AnnoCPAN: Annotated CPAN documentation
171              
172             L
173              
174             =item * CPAN Ratings
175              
176             L
177              
178             =item * Search CPAN
179              
180             L
181              
182             =back
183              
184              
185             =head1 ACKNOWLEDGEMENTS
186              
187              
188             =head1 LICENSE AND COPYRIGHT
189              
190             Copyright 2016 ORANGE.
191              
192             This program is released under the following license: Perl
193              
194              
195             =cut
196              
197             1; # End of Mojo::Ecrawler