home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / jpl / get_jdk / get_jdk.pl
Perl Script  |  1999-09-14  |  2KB  |  72 lines
  1. #!/usr/bin/perl -w
  2.  
  3. # Based on an ftp client found in the LWP Cookbook and
  4. # revised by Nathan V. Patwardhan <nvp@ora.com>.
  5.  
  6. # Copyright 1997 O'Reilly and Associates
  7. # This package may be copied under the same terms as Perl itself.
  8. #
  9. # Code appears in the Unix version of the Perl Resource Kit
  10.  
  11. use LWP::UserAgent;
  12. use URI::URL;
  13.  
  14. my $ua = new LWP::UserAgent;
  15.  
  16. # check to see if a JDK port exists for the OS.  i'd say
  17. # that we should use solaris by default, but a 9meg tarfile
  18. # is a hard pill to swallow if it won't work for somebody.  :-)
  19. my $os_type = $^O; my $URL = lookup_jdk_port($os_type);
  20. die("No JDK port found.  Contact your vendor for details.  Exiting.\n")
  21.     if $URL eq '';
  22.  
  23. print "A JDK port for your OS has been found.\nContacting: ".$URL."\n";
  24.  
  25. # Now, parse the URL using URI::URL
  26. my($jdk_file) = (url($URL)->crack)[5]; 
  27. $jdk_file =~ /(.+)\/(.+)/; $jdk_file = $2;
  28.  
  29. print "Attempting to download: $jdk_file\n";
  30.  
  31. my $expected_length;
  32. my $bytes_received = 0;
  33.  
  34. open(OUT, ">".$jdk_file) or die("Can't open $jdk_file: $!");
  35. $ua->request(HTTP::Request->new('GET', $URL),
  36.          sub {
  37.          my($chunk, $res) = @_;
  38.  
  39.          $bytes_received += length($chunk);
  40.          unless (defined $expected_length) {
  41.              $expected_length = $res->content_length || 0;
  42.          }
  43.          if ($expected_length) {
  44.              printf STDERR "%d%% - ",
  45.              100 * $bytes_received / $expected_length;
  46.          }
  47.          print STDERR "$bytes_received bytes received\n";
  48.  
  49.          print OUT $chunk;
  50.          }
  51. );
  52. close(OUT);
  53.  
  54. sub lookup_jdk_port {
  55.     my($port_os) = @_;
  56.     my $jdk_hosts = 'jdk_hosts';
  57.     my %HOSTS = ();
  58.  
  59.     open(CFG, $jdk_hosts) or die("hosts error: $!");
  60.     while(<CFG>) {
  61.     chop;
  62.     ($os, $host) = split(/\s*=>\s*/, $_);
  63.     next unless $os eq $port_os;
  64.     push(@HOSTS, $host);
  65.     }
  66.     close(CFG);
  67.  
  68.     return "" unless @HOSTS;
  69.     return $HOSTS[rand @HOSTS];        # Pick one at random.
  70. }
  71.  
  72.