baidu top500 MP3 下载脚本perl

faithseed

看到有人用python写了一个，作为perl的用户，我们也不能落后。
把下面的代码存成baidu.pl，在同样的目录下面建一个mp3子目录。
chmod ＋x baidu.pl
./baidu.pl
这个程序会crawl baidu top500 mp3，然后自动下载mp3格式大于4M的音乐。Enjoy:2cool
注: 需要安装以下perl module
sudo apt-get install liburi-perl
sudo apt-get install libwww-perl

TIPs: 很短时间写的，暂时界面比较混乱，如果要监视下载进程可以
cd mp3
watch -d ls -lth

1. #!/usr/bin/perl -w
2. use strict;
3. use URI;
4. use LWP::UserAgent;
5. use HTTP::Response;
6. use URI::Heuristic;
7. use File::stat;
8. use Symbol;
9. use POSIX;
12. my $PREFORK                = 5;        # number of children to maintain
13. my %children               = ( );       # keys are current child process IDs
14. my $children               = 0;        # current number of children
16. sub REAPER {
17.       $SIG{CHLD} = \&REAPER;
18.       my $pid = wait;
19.       $children --;
20.       delete $children{$pid};
21. }
23. sub HUNTSMAN {
24.       local($SIG{CHLD}) = 'IGNORE';
25.       kill 'INT' => keys %children;
26.       exit;
27. }
29. # explore the initial link
30. my $url = URI->new('http://list.mp3.baidu.com/topso/mp3topsong.html');
31. $url->query_form(
32.         'id'    => '1#top2',
33.         );
35. my $ua = LWP::UserAgent->new();
36. my $response = $ua->get($url);
37. my @content;
38. if ($response->is_error()) {
39.         printf " %s\n", $response->status_line;
40.         exit;
41. } else {
42.         @content = split("\n", $response->content());
43. }
44. my @raw_index = grep /http:\/\/mp3\.baidu\.com\/m\?tn=baidump3/i, @content;
45. my @url_l1;
46. my @song;
48. for (my $i=0; $i<@raw_index; $i++) {
49.         if ($raw_index[$i] =~ /<a href="(.+)(\+(.+))+" target=_blank>(.+)<\/a>/) {
50.                 push @url_l1, $1.$2;
51.                 push @song, $4;
52.         }
53. }
55. my @url_rev = reverse @url_l1;
56. my @song_rev = reverse @song;
58. # Fork off our children.
59. for (1 .. $PREFORK) {
60.       make_new_child( pop(@url_rev), pop(@song_rev) );
61. }
63. # Install signal handlers.
64. $SIG{CHLD} = \&REAPER;
65. $SIG{INT}  = \&HUNTSMAN;
67. # And maintain the population.
68. while (1) {
69.         sleep;
70.         for (my $i=$children; $i<$PREFORK; $i++) {
71.                 if (@url_l1 < 1) {
72.                         # We are done
73.                         exit;
74.                 }
75.                 make_new_child( pop(@url_rev), pop(@song_rev) );
76.         }
77. }
79. sub make_new_child {
80.         my ($url_proc, $song_name) = @_;
81.         my $pid;
82.         my $sigset;
83.         # block signal for fork
84.         $sigset = POSIX::SigSet->new(SIGINT);
85.         sigprocmask(SIG_BLOCK, $sigset)
86.                 or die "Can't block SIGINT for fork: $!\n";
88.         die "fork: $!" unless defined ($pid = fork);
90.         if ($pid) {
91.                 # Parent records the child's birth and returns.
92.                 sigprocmask(SIG_UNBLOCK, $sigset)
93.                         or die "Can't unblock SIGINT for fork: $!\n";
94.                 $children{$pid} = 1;
95.                 $children++;
96.                 return;
97.         } else {
98.                 # Child can *not* return from this subroutine.
99.                 $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
101.                 # unblock signals
102.                 sigprocmask(SIG_UNBLOCK, $sigset)
103.                         or die "Can't unblock SIGINT for fork: $!\n";
105.                 # explore the baby
106.                 $response = $ua->get($url_proc);
107.                 if ($response->is_error()) {
108.                         printf " %s\n", $response->status_line;
109.                         exit;
110.                 } else {
111.                         @content = split("\n", $response->content());
112.                 }
114.                 @raw_index = grep /<a target="_blank"/i, @content;
115.                 my @size_index = grep /M<\/td>|<td>未知<\/td>/, @content;
117.                 for (my $i=0; $i<@raw_index; $i++) {
118.                         my @tmp = split (',', $raw_index[$i]);
119.                         # filter file type other than .mp3
120.                         next if ($tmp[2] !~ /(.+)\.mp3$/i);
121.                         # filter file size less than 3 M
122.                         next if ($size_index[$i] !~ /<td>(\d+)\.(\d+) M<\/td>/);
123.                         if ($1 >= 5) {
124.                                 $raw_index[$i] =~ /href="(.+)" onclick=/i;
125.                                 $response = $ua->get($1);
126.                                 if ($response->is_error()) {
127.                                         #printf " %s\n", $response->status_line;
128.                                         next;
129.                                 } else {
130.                                         @content = split("\n", $response->content());
131.                                 }
132.                                 my @link_index = grep /"http:\/\/(.+)\.mp3"/i, @content;
133.                                 next if (@link_index < 1);
134.                                 next if ($link_index[0] !~ /href="http:\/\/(.+)\/(.+)\.mp3">/i);
135.                                 print "Downloading http:\/\/$1\/$2\.mp3 \t $song_name\n";
136.                                 sleep(rand(30));
137.                                 $song_name = time();
138.                                 my @args = ("wget", "-T 300", "http://$1/$2.mp3", "-O./mp3/$song_name.mp3");
139.                                 system(@args) == 0 or next;
140.                                 if (stat("./mp3/$song_name.mp3")->size < 4000000) {
141.                                         system("rm", "-f", "./mp3/$song_name.mp3");
142.                                         next;
143.                                 }
144.                                 # TODO maybe we can choose the largest file
145.                                 last;
146.                         }
147.                 }
148.                 # tidy up gracefully and finish
149.                 exit;
150.         }
151. }
153. exit;

复制代码

faithseed

改这个就可以增加并发下载线程数

my $PREFORK                = 5;        # number of children to maintain

：）

aiyi

短小精悍，厉害，呵呵
不过下载后的文件名好像有点难以辨认：

faithseed

hehe, 搞不定文件名的encoding, 在我的系统里面是乱码。其实真实的文件名都存在$song_name 里面了，没办法只好又暂时该成了epoch time。希望mp3的tag能解决问题。最近也要学习python，你的程序可以给我很好的参考：）