/ModelSim-List-0.06/inc/Module/Install/Fetch.pm

# · Perl · 93 lines · 75 code · 15 blank · 3 comment · 8 complexity · 741e32c49c4372d052417e73cf2dd07b MD5 · raw file

  1. #line 1
  2. package Module::Install::Fetch;
  3. use strict;
  4. use Module::Install::Base;
  5. use vars qw{$VERSION $ISCORE @ISA};
  6. BEGIN {
  7. $VERSION = '0.67';
  8. $ISCORE = 1;
  9. @ISA = qw{Module::Install::Base};
  10. }
  11. sub get_file {
  12. my ($self, %args) = @_;
  13. my ($scheme, $host, $path, $file) =
  14. $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
  15. if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
  16. $args{url} = $args{ftp_url}
  17. or (warn("LWP support unavailable!\n"), return);
  18. ($scheme, $host, $path, $file) =
  19. $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
  20. }
  21. $|++;
  22. print "Fetching '$file' from $host... ";
  23. unless (eval { require Socket; Socket::inet_aton($host) }) {
  24. warn "'$host' resolve failed!\n";
  25. return;
  26. }
  27. return unless $scheme eq 'ftp' or $scheme eq 'http';
  28. require Cwd;
  29. my $dir = Cwd::getcwd();
  30. chdir $args{local_dir} or return if exists $args{local_dir};
  31. if (eval { require LWP::Simple; 1 }) {
  32. LWP::Simple::mirror($args{url}, $file);
  33. }
  34. elsif (eval { require Net::FTP; 1 }) { eval {
  35. # use Net::FTP to get past firewall
  36. my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
  37. $ftp->login("anonymous", 'anonymous@example.com');
  38. $ftp->cwd($path);
  39. $ftp->binary;
  40. $ftp->get($file) or (warn("$!\n"), return);
  41. $ftp->quit;
  42. } }
  43. elsif (my $ftp = $self->can_run('ftp')) { eval {
  44. # no Net::FTP, fallback to ftp.exe
  45. require FileHandle;
  46. my $fh = FileHandle->new;
  47. local $SIG{CHLD} = 'IGNORE';
  48. unless ($fh->open("|$ftp -n")) {
  49. warn "Couldn't open ftp: $!\n";
  50. chdir $dir; return;
  51. }
  52. my @dialog = split(/\n/, <<"END_FTP");
  53. open $host
  54. user anonymous anonymous\@example.com
  55. cd $path
  56. binary
  57. get $file $file
  58. quit
  59. END_FTP
  60. foreach (@dialog) { $fh->print("$_\n") }
  61. $fh->close;
  62. } }
  63. else {
  64. warn "No working 'ftp' program available!\n";
  65. chdir $dir; return;
  66. }
  67. unless (-f $file) {
  68. warn "Fetching failed: $@\n";
  69. chdir $dir; return;
  70. }
  71. return if exists $args{size} and -s $file != $args{size};
  72. system($args{run}) if exists $args{run};
  73. unlink($file) if $args{remove};
  74. print(((!exists $args{check_for} or -e $args{check_for})
  75. ? "done!" : "failed! ($!)"), "\n");
  76. chdir $dir; return !$?;
  77. }
  78. 1;