File Coverage

blib/lib/Mojo/Ecrawler.pm
Criterion Covered Total %
statement 17 52 32.6
branch 0 16 0.0
condition n/a
subroutine 6 12 50.0
pod 1 6 16.6
total 24 86 27.9


line stmt bran cond sub pod time code
1             package Mojo::Ecrawler;
2              
3 1     1   48727 use Mojo::UserAgent;
  1         305750  
  1         7  
4 1     1   57 use 5.010;
  1         4  
5 1     1   5 use Encode qw(decode encode decode_utf8 encode_utf8);
  1         4  
  1         54  
6 1     1   6 use Mojo::IOLoop;
  1         5  
  1         7  
7 1     1   18 use strict;
  1         2  
  1         23  
8 1     1   5 use warnings;
  1         3  
  1         525  
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.04';
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 $feed = shift;
64 0 0         $host= $1 if $feed=~/(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($feed) );
71 0           return $result->res->dom;
72             }
73              
74             sub getdiv {
75              
76 0     0 1   my ( $dom, $re1, $re2, $ind ) = @_;
77 0           my $recontent;
78 0           my @div = $dom->find($re1)->each;
79 0           for (@div){
80              
81 0 0         $recontent .= getndiv( $_, $re2, $ind ) if getndiv( $_, $re2, $ind );
82              
83             }
84 0 0         print "DEBUG:getndiv()\::OUT:\n", $recontent if $DEBUG;
85 0           return $recontent;
86             }
87              
88             sub getndiv {
89              
90             #my $DEBUG=1;
91 0     0 0   my ( $st, $re, $ind ) = @_;
92 0           my $ndom = gmyc($st);
93 0           my @ndiv = $ndom->find($re)->each;
94 0           my $nrecontent;
95 0           for (@ndiv) {
96 0           $nrecontent .= $_->content;
97 0 0         my $surl=$_->attr->{href} if $ind;
98             # $surl = $host.$surl unless $surl=~/https?:/;
99 0 0         $nrecontent .= $surl if $surl;
100 0           $nrecontent .= "\n";
101             }
102 0 0         print "DEBUG:getndiv()\::OUT:\n", $nrecontent if $DEBUG;
103 0           return $nrecontent;
104              
105             }
106              
107             sub oplink {
108             ...
109              
110              
111 0     0 0   }
112             sub gettext {
113              
114 0     0 0   my ( $st, $re ) = @_;
115 0           my $ndom = gmyc($st);
116 0           my $nrecontent = $ndom->all_text;
117            
118 0           $nrecontent .= "\n";
119 0 0         print "DEBUG:getndiv()\::OUT:\n", $nrecontent if $DEBUG;
120            
121 0           return $nrecontent;
122              
123             }
124              
125             sub gmyc {
126              
127 0     0 0   my ( $c, $s ) = @_;
128 0 0         my $dom = $s ? Mojo::DOM->new($c)->at($s) : Mojo::DOM->new($c);
129 0           return $dom;
130              
131             }
132              
133             =head1 AUTHOR
134              
135             ORANGE, C<< >>
136              
137             =head1 BUGS
138              
139             Please report any bugs or feature requests to C, or through
140             the web interface at L. I will be notified, and then you'll
141             automatically be notified of progress on your bug as I make changes.
142              
143              
144              
145              
146             =head1 SUPPORT
147              
148             You can find documentation for this module with the perldoc command.
149              
150             perldoc Mojo::Ecrawler
151              
152              
153             You can also look for information at:
154              
155             =over 4
156              
157             =item * RT: CPAN's request tracker (report bugs here)
158              
159             L
160              
161             =item * AnnoCPAN: Annotated CPAN documentation
162              
163             L
164              
165             =item * CPAN Ratings
166              
167             L
168              
169             =item * Search CPAN
170              
171             L
172              
173             =back
174              
175              
176             =head1 ACKNOWLEDGEMENTS
177              
178              
179             =head1 LICENSE AND COPYRIGHT
180              
181             Copyright 2016 ORANGE.
182              
183             This program is released under the following license: Perl
184              
185              
186             =cut
187              
188             1; # End of Mojo::Ecrawler