请帮忙 html::parser ,从mp3.baidu.搜索mp3

gangjh

根据HTML::LinkExtor修改过来的package

1.<a href=http://aa.aa/>; <img=aa.img alt="asdf">;</a>;
2.<a href=http://aa.aa/>; fffff</a>;
3 .<a href=http://aa.aa/>;test <font size=12>;text2</font>; </a>;
第一,二种可以
第三种只能抓到 test ,后面的 text2抓不到,
请帮忙

刚学perl不久,玩玩而已,呵呵
          
perl 真是个好东西

1. 
   
2. package myLinkExtor;
   
3. 
   
4. # $Id: LinkExtor.pm,v 1.33 2003/10/10 10:20:56 gisle Exp $
   
5. 
   
6. require HTML::Parser;
   
7. @ISA = qw(HTML::Parser);
   
8. $VERSION = sprintf("%d.%02d", q$Revision: 1.33 $ =~ /(\d+)\.(\d+)/);
   
9. 
   
10. 
    
11. use strict;
    
12. use HTML::Tagset ();
    
13. 
    
14. # legacy (some applications grabs this hash directly)
    
15. use vars qw(%LINK_ELEMENT);
    
16. *LINK_ELEMENT = \%HTML::Tagset::linkElements;
    
17. 
    
18. 
    
19. sub new
    
20. {
    
21.     my($class, $cb, $base) = @_;
    
22.     my $self = $class->;SUPER::new(
    
23.                     start_h =>; [\&a_start_handler, "self,tagname,attr"],
    
24.                     report_tags =>; [qw(a img)],
    
25.                );
    
26.    
    
27.     if ($base) {
    
28.         require URI;
    
29.         $self->;{extractlink_base} = URI->;new($base);
    
30.     }
    
31.     $self;
    
32. }
    
33. 
    
34. 
    
35. sub _found_link
    
36. {
    
37.     my $self = shift;
    
38.     push(@{$self->;{'links'}}, [@_]);
    
39.    
    
40. }
    
41. 
    
42. 
    
43. sub links
    
44. {
    
45.     my $self = shift;
    
46.     exists($self->;{'links'}) ? @{delete $self->;{'links'}} : ();
    
47. }
    
48. 
    
49. # We override the parse_file() method so that we can clear the links
    
50. # before we start a new file.
    
51. sub parse_file
    
52. {
    
53.     my $self = shift;
    
54.     delete $self->;{'links'};
    
55.     $self->;SUPER::parse_file(@_);
    
56. }
    
57. 
    
58. 
    
59. 
    
60. ######
    
61. ##
    
62. #
    
63. #my declare
    
64. #
    
65. 
    
66. 
    
67. 
    
68. sub a_start_handler
    
69. {
    
70.     my($self, $tag, $attr) = @_;
    
71.     return unless $tag eq "a";
    
72.     return unless exists $attr->;{href};
    
73. 
    
74.     $self->;handler(text  =>; [], '@{dtext}' );
    
75. 
    
76.     push(@{$self->;handler("text")}, "href" );
    
77.     push(@{$self->;handler("text")}, $attr->;{href} );
    
78. 
    
79.     $self->;{'tag'}=$tag ;
    
80.    
    
81.    
    
82.     $self->;handler(start =>; \&img_handler);
    
83. #    $self->;handler(end   =>; \&a_end_handler, "self,tagname");
    
84.     $self->;handler(end   =>; \&a_end_handler, "self,tagname");
    
85. 
    
86. 
    
87. }
    
88. 
    
89. sub img_handler
    
90. {
    
91.     my($self, $tag, $attr) = @_;
    
92.     return unless (($tag eq "img") or ($tag eq "font")) ;
    
93.      
    
94.     push(@{$self->;handler("text")}, $attr->;{alt} || "[IMG]");
    
95. 
    
96. }
    
97. 
    
98. sub a_end_handler
    
99. {
    
100.     my($self, $tag) = @_;
     
101. #   my $text = join("", @{$self->;handler("text")});
     
102. #   $text =~ s/^\s+//;
     
103. #   $text =~ s/\s+$//;
     
104. #   $text =~ s/\s+/ /g;
     
105. 
     
106.     $self->;_found_link($self->;{'tag'} ,@{$self->;handler("text")}) ;
     
107. 
     
108.     $self->;handler("text", undef);
     
109.     $self->;handler("start", \&a_start_handler);
     
110.     $self->;handler("end", undef);
     
111. }
     
112. 
     

复制代码

findmp3.pl
可按歌手搜索mp3列表,
因为不好判断有多少页,就默认5 可传入参数改变,

1. 
   
2. 
   
3. #!/usr/bin/perl
   
4. #
   
5. #Coder : Gan Jian Hui
   
6. #
   
7. #Last Modify :2005-07-29
   
8. #
   
9. use LWP::UserAgent;
   
10. use URI::URL ;
    
11. use strict ;
    
12. use myLinkExtor;
    
13. use URI::Escape;
    
14. 
    
15. 
    
16. if (@ARGV <= 0)
    
17. {
    
18.         print STDERR "usage: get liu de hua \n";
    
19.         exit(1) ;
    
20. }
    
21. 
    
22. my ($word,$maxpage) =@ARGV ;
    
23. $maxpage=$maxpage || 5 ;
    
24. $word=uri_escape($word) ;
    
25. 
    
26. my $browser = LWP::UserAgent->;new;
    
27. $browser->;env_proxy;
    
28. $browser->;agent('Mozilla/5.0');
    
29. 
    
30. my $p = myLinkExtor->;new() ;
    
31. 
    
32. my $i=0 ;
    
33. my $fsurl ;
    
34. for ($i=0; $i<$maxpage; $i++)
    
35. {
    
36.         $fsurl = &findnext($i,$word);
    
37.         &geturl($browser, $p, $fsurl) ;
    
38. }
    
39. 
    
40. sub geturl()
    
41. {       
    
42.         my ($bs, $lkextor , $url) = @_ ;
    
43.                
    
44.         my $req=HTTP::Request->;new(GET =>; $url) ;
    
45.         my $response = $bs->;request($req) ;
    
46.         $lkextor->;parse($response->;content) ;
    
47. 
    
48.         my $base = $response->;base;
    
49.        
    
50.         my $nurl ;
    
51. 
    
52. #        <a href=aa.htm>;asdf</a>;
    
53. #         0  1    2      3
    
54.         foreach my $link  ($lkextor->;links)
    
55.         {
    
56.                 next if @$link[0] ne 'a' ;
    
57.                 $nurl = url(@$link[2],$base)->;abs ;
    
58.                 shift (@$link) ;
    
59.                 shift (@$link) ;
    
60.                 shift (@$link) ;
    
61. 
    
62.                 if ($nurl =~ /.(mp3|rm|wma)$/ )
    
63.                 {
    
64.                         my $text = join("",@$link)  ;
    
65.                         $text =~ s/^\s+//;
    
66.                         $text =~ s/\s+$//;
    
67.                         $text =~ s/\s+/ /g;
    
68. #   
    
69.                         print $nurl."\t " . $text ."\n" ;
    
70.                 }
    
71.        
    
72.         }
    
73. }
    
74. 
    
75. 
    
76. 
    
77. sub findnext(){
    
78.         my ($page,$WORD) = @_ ;
    
79.         my $RM=30 ;
    
80.         my $PM=$RM*$page ;
    
81.         my $MAXPM=100 ;
    
82.         my $NL=  "http://mp3.baidu.com/m?z=0&cl=3&ct=134217728&sn=&lm=-1&cm=1&sc=1&bu=&rn=30&tn=baidump3&word=$WORD&pn=$PM" ;
    
83.         return  $NL ;       
    
84. }
    
85. 
    
86. 
    

复制代码

gangjh

可能是我搞错了,
好像可以输出

rorot

第三种URL, <a href="#">;text1 <font color=#>;text2</font>; text3</a>; 用HTML::TreeBuilder可以解决

1. 
   
2. 
   
3. #!/usr/bin/perl -w
   
4. 
   
5. use strict;
   
6. use HTML::TreeBuilder;
   
7. sub extract_link_content($);
   
8. 
   
9. my $root = HTML::TreeBuilder->;new_from_file("./link.html");
   
10. my @links = $root->;find_by_tag_name('a');
    
11. map { print $_->;attr('href'), "\t", extract_link_content($_), "\n"; } @links;
    
12. 
    
13. sub extract_link_content($)
    
14. {
    
15.         my $link = shift;
    
16.         my $text = "";
    
17.         my @content = $link->;content_list;
    
18.         for (my $i = 0; $i <= $#content; ++$i)
    
19.         {
    
20.                 $text .= (ref($content[$i]) eq 'HTML::Element' ?
    
21.                                         extract_link_content($content[$i]) : $content[$i]);
    
22.         }
    
23. 
    
24.         return $text;
    
25. }
    
26. 
    

复制代码