一段下载资料的脚本，请大家提些建议。
很多时候，我们需要的文档和资料以网页的形式存在，为了方便我们需要将其下载到本机上，一般来说 ，内容稍丰富的文档资料会由多个网页组成，比如apache 服务器的文档由多达200多个页面组成，我们当然可以用离线浏览器之类的 软件下载，除此以外，自己写脚本也不错，下面就是本人写的一段脚本，脚本使用举例，下载apache文档，down.pl http://man.chinaunix.net/newsoft ... N_2.2new/index.html（假设脚本取名为down.pl),目前存在的问题是 如果网页中存在和index.html所在目录平级或者更高的目录中的文件，就没法下载了，请大家给个建议。
#!/usr/bin/perl
#script for download html page.
#Author Huang Yong.
#2007-9-1
use File::Basename;
use File::Spec;
sub downloadpage{
my $main_path = dirname($_[0]);
getpage($_[0],$main_path);
}
sub catfile{
$dirname = $_[0];
$filename = $_[1];
if($filename =~ m@^\./(.+)@){
$filename = $1;
}
while($filename =~ m@^\.\./(.+)@){
$dirname = dirname($dirname);
$filename = $1;
}
my $re = File::Spec->catfile($dirname,$filename);
$re =~ s@http:/@http://@;
return $re;
}
sub getpage{
my $filename;
my $str=$_[1];
my $pageurl = $_[0];
my $main_path=$_[1];
$str=~s/\./\\./g;
my $pattern = "$str/(.+)";
$str=$pageurl;
if($str=~m@$pattern@){
$filename = $1;
}
my $dirname = dirname($filename);
unless (-d $dirname) {mkdir $dirname};
if (-e $filename){
return;
}
print "Page $pageurl is download now...\n";
`wget $pageurl -P $dirname`;
my $remote_path = dirname($pageurl);
if($filename =~ /htm[l]?$/){
open fp, "< $filename" or die "Can not open file $filename";
my @file = <fp>;
close fp;
my $line;
foreach $line(@file){
while($line =~ m@href\s*=\s*"([^"]+)"(.*$)@){
my $link_url = $1; #超链接
$line = $2; # 匹配剩余部分继续匹配
$link_url =~ s@([^#]+)#.+$@$1@; #去除锚点描述
unless ($link_url !~ m@http://@) {next;}
unless ($link_url !~ m@mailto@) {next;}
unless ($link_url !~ m@^#@) {next;}
$pageurl = catfile($remote_path,$link_url);
getpage($pageurl,$main_path);
}
}
}
}
foreach(@ARGV){
print "Page $_ download now,please wait...\n";
downloadpage($_);
}
print "Page download success!\n
|
