一个安装cpan模块的脚本

CPAN命令好像是用Net::FTP来获取下载地址的，但是我的ftp端口被禁了，所以不能用cpan命令来安装了，不过http端口可以用，以前都是一个一个下载安装，最近觉得有必要自己写一个自动安装的脚本。 到目前为止还比较好使，大家感兴趣的可以试一下

1. #!/usr/local/bin/perl5
   
2. 
   
3. use warnings;
   
4. use strict;
   
5. 
   
6. use WWW::Mechanize;
   
7. use HTML::TreeBuilder;
   
8. use HTML::Query 'query';
   
9. use Cwd;
   
10. use File::Basename;
    
11. 
    
12. die "Usage: $0 module_name\n" unless @ARGV;
    
13. my ($module) = @ARGV;
    
14. 
    
15. my $prefix  = "~/perl5";
    
16. my $tmp_dir = "~/test";
    
17. my $http_proxy = "http://proxy.com:80";
    
18. 
    
19. my $mech = WWW::Mechanize->new(autocheck=>1);
    
20. $mech->stack_depth(0);
    
21. $mech->proxy(['http'], $http_proxy) if (! $ENV{http_proxy});
    
22. 
    
23. print "you want to install $module...\n";
    
24. &install($module);
    
25. 
    
26. ###########################
    
27. sub get_url_from_cpan {
    
28.     my $module = shift;
    
29.     my $cpan_url = "http://search.cpan.org";
    
30.     print "get search_page ...\nurl=$cpan_url\n";
    
31.     # search the module in CPAN main page
    
32.     $mech->get($cpan_url);
    
33.     $mech->set_fields(query => $module);
    
34.     $mech->submit();
    
35.     my $search_page_content = $mech->content();
    
36. 
    
37.     # parse the search page to find the url of this module
    
38.     my $tree = HTML::TreeBuilder->new;
    
39.     my $success = $tree->parse($search_page_content);
    
40.     $success    = $tree->eof();
    
41.     die "parse search_page_content failed: $!\n" unless $success;
    
42. 
    
43.     my $h2s = $tree->query('h2.sr'); #<h2> with sr class
    
44.     my $href;
    
45.     for my $h2 (@$h2s) {
    
46.         my $module_name = $h2->query('a[href]')->as_trimmed_text->[0];
    
47.         print "module_name: $module_name, module: $module\n";
    
48.         if ($module_name eq $module) {
    
49.             $href = $h2->query('a[href]')->attr('href')->[0];
    
50.             last;
    
51.         }
    
52.     }
    
53. 
    
54.     # fetch the page of this module from CPAN
    
55.     my $module_url = $cpan_url . $href;
    
56.     print "get module_page ...\nurl=$module_url\n";
    
57.     $mech->get($module_url);
    
58.     my $module_page_content = $mech->content();
    
59.     undef $tree;
    
60.     $tree = HTML::TreeBuilder->new;
    
61.     $success = $tree->parse($module_page_content);
    
62.     $success = $tree->eof();
    
63.     die "parse module_page_content failed: $!\n" unless $success;
    
64. 
    
65.     # find the download url for this module
    
66.     my $ps = $tree->query("p[style]");
    
67.     for my $p (@$ps) {
    
68.         if ($p->as_trimmed_text =~ m/Download:/) {
    
69.             my $href = $p->query('a[href]')->attr('href')->[0];
    
70.             print "Path = " . $cpan_url . $href . "\n";
    
71.             return $cpan_url . $href;
    
72.         }
    
73.     }
    
74.     return undef; # fail if reach here
    
75. }
    
76. 
    
77. sub install {
    
78.     my $module = shift;
    
79.     my $suffix = ".tar.gz";
    
80. 
    
81.     my $cur_dir = getcwd;
    
82.     chdir($tmp_dir);
    
83.     print "cur_dir: $cur_dir, chidr to: " . getcwd . "\n";
    
84. 
    
85.     # judge if file already exists.
    
86.     # for example, file A-B.tar.gz for module A::B
    
87.     my @files = grep {-f $_} <*>;
    
88.     my $dir = $module;
    
89.     $dir =~ s/::/-/g;
    
90.     @files = grep /^$dir-(\d.)+/, @files;
    
91.     print "files=@files\n";
    
92. 
    
93.     # if module.tar.gz does not exists, we wget it from CPAN
    
94.     # else use it directly
    
95.     unless (@files) {
    
96.         my $url = &get_url_from_cpan($module);
    
97.         $dir = fileparse($url, $suffix);
    
98.         system("wget $url 1>/dev/null 2>&1");
    
99.     }
    
100.     else {
     
101.         $dir = fileparse($files[0], $suffix);
     
102.     }
     
103. 
     
104.     # unpack the module.tar.gz file
     
105.     # and chdir to the related dir
     
106.     print "dir = $dir\n";
     
107.     system("gunzip < $dir$suffix|tar -xf -");
     
108.     chdir($dir);
     
109. 
     
110.     # start to install this module
     
111.     # 1. perl5 Makefile.PL prefix=$prefix
     
112.     # 2. make
     
113.     # 3. make install
     
114.     # If there is dependency, we should install them first
     
115.     # until all dependency are installed.
     
116.     my $dependency = 1;
     
117.     while ($dependency) {
     
118.         my $mf_result = `perl5 Makefile.PL prefix=$prefix 2>&1`;
     
119.         if ($mf_result =~ m/Warning: prerequisite (\S*) .* not found/) {
     
120.             my ($new_module) = $1 ;
     
121.             $new_module =~ s/-(\d.)+$//;
     
122.             $new_module =~ s/-/::/g;
     
123.             print ">" x 30 . "\n";
     
124.             print "$new_module shoulde be installed first\n";
     
125.             system("~/bin/cpan_install.pl",  $new_module);
     
126.         }
     
127.         else {
     
128.             $dependency = 0;
     
129.         }
     
130.     }
     
131.     system("make && make install");
     
132. 
     
133.     chdir($cur_dir);
     
134. }

复制代码

作者: hp_truth   发布时间: 2010-09-10

作者: wfnh   发布时间: 2010-09-10

回复 wfnh


    谢谢， 就是觉得HTML:uery挺好用的，所以拿来当作练习了。 应该还有别的方法可以下载的。

作者: hp_truth   发布时间: 2010-09-10

作者: liyangole   发布时间: 2010-09-10