jpl/get_jdk/get_jdk.pl

   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