branch jpl from perlext to perl

p4raw-id: //depot/perl@2410

3 files changed, 149 insertions, 0 deletions

diff --git a/jpl/get_jdk/README b/jpl/get_jdk/README
new file mode 100644
index 0000000000..0c38ccf7fd
--- /dev/null
+++ b/jpl/get_jdk/README
@@ -0,0 +1,74 @@
+
+This archive contains the following files:
+README - the README file which explains how to use this program (this file)
+get_jdk.pl - the program to download JDK
+jdk_hosts - the descriptor file required by the program
+
+Nate Patwardhan (nvp@oreilly.com) wrote get_jdk.pl to automate the
+download of JDK (Java Development Kit) from a distribution site based
+on your Unix flavor.  This program is based on some of the examples
+found in the LWP cookbook that was included with your LWP distribution.
+
+Current Unix flavors that appear in the descriptor file (more
+suggestions from Beta testers will be welcomed):
+	Solaris
+	Linux
+	FreeBSD
+
+To use get_jdk.pl properly, you *must* have LWP (libwww) and its
+dependencies installed.  Once you've installed LWP, you should be able
+to use this module without any problems on any Unix flavor.
+
+By default, get_jdk.pl uses #!/usr/local/bin/perl in its shebang path,
+so you may have to execute get_jdk.pl like:
+
+	perl get_jdk.pl
+
+-OR-
+
+	perl5 get_jdk.pl
+
+based on your site's Perl installation.
+
+get_jdk.pl reads the $^O to determine what Unix flavor you're using,
+and compares the value of $^O to the first field shown in the
+descriptor file, jdk_hosts.  For example, $^O for Solaris versions of
+Perl is: 'solaris'; Solaris is represented in the descriptor file
+like:
+
+	solaris=>ftp://ftp.javasoft.com/pub/jdk1.1/jdk1.1.3-solaris2-sparc.bin
+
+When get_jdk.pl reads the descriptor file, it splits the fields on
+'=>', and reads them into a hash, %HOSTS.  get_jdk.pl then compares
+the value of $^O to $HOSTS{'osname'}, and returns the address of the
+JDK distribution site if $^O eq $HOSTS{'osname'}.  If there is not a
+match, get_jdk.pl fails.
+
+get_jdk.pl represents the hostname of distribution sites in URL
+format: protocol://hostname.some.com/path/filename.extension  
+When a URL is found, get_jdk.pl parses out the filename; this is
+significant, because the output from the remote host is directed to
+the file parsed from the URL.
+
+When you execute get_jdk.pl, you'll know it's working correctly if it
+outputs something like:
+
+	A JDK port for your OS has been found.
+	Contacting:
+	ftp://ftp.javasoft.com/pub/jdk1.1/jdk1.1.3-solaris2-sparc.bin
+	Attempting to download: jdk1.1.3-solaris2-sparc.bin
+	0% - 1460 bytes received
+	0% - 4380 bytes received
+	0% - 7300 bytes received
+	0% - 8192 bytes received
+	[etc etc etc until you reach 100%]
+
+Future (PRK release) versions of get_jdk.pl will allow the user to
+update the descriptor file from the ora.com (oreilly.com) FTP/WWW
+site.  This version does not support the -update flag.
+
+Happy JDK'ing!  :-)
+
+--
+Nate Patwardhan
+nvp@oreilly.com
diff --git a/jpl/get_jdk/get_jdk.pl b/jpl/get_jdk/get_jdk.pl
new file mode 100755
index 0000000000..d6d399d669
--- /dev/null
+++ b/jpl/get_jdk/get_jdk.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/perl -w
+
+# Based on an ftp client found in the LWP Cookbook and
+# revised by Nathan V. Patwardhan <nvp@ora.com>.
+
+# Copyright 1997 O'Reilly and Associates
+# This package may be copied under the same terms as Perl itself.
+#
+# Code appears in the Unix version of the Perl Resource Kit
+
+use LWP::UserAgent;
+use URI::URL;
+
+my $ua = new LWP::UserAgent;
+
+# check to see if a JDK port exists for the OS.  i'd say
+# that we should use solaris by default, but a 9meg tarfile
+# is a hard pill to swallow if it won't work for somebody.  :-)
+my $os_type = $^O; my $URL = lookup_jdk_port($os_type);
+die("No JDK port found.  Contact your vendor for details.  Exiting.\n")
+    if $URL eq '';
+
+print "A JDK port for your OS has been found.\nContacting: ".$URL."\n";
+
+# Now, parse the URL using URI::URL
+my($jdk_file) = (url($URL)->crack)[5]; 
+$jdk_file =~ /(.+)\/(.+)/; $jdk_file = $2;
+
+print "Attempting to download: $jdk_file\n";
+
+my $expected_length;
+my $bytes_received = 0;
+
+open(OUT, ">".$jdk_file) or die("Can't open $jdk_file: $!");
+$ua->request(HTTP::Request->new('GET', $URL),
+	     sub {
+		 my($chunk, $res) = @_;
+
+		 $bytes_received += length($chunk);
+		 unless (defined $expected_length) {
+		     $expected_length = $res->content_length || 0;
+		 }
+		 if ($expected_length) {
+		     printf STDERR "%d%% - ",
+		     100 * $bytes_received / $expected_length;
+		 }
+		 print STDERR "$bytes_received bytes received\n";
+
+		 print OUT $chunk;
+	     }
+);
+close(OUT);
+
+sub lookup_jdk_port {
+    my($port_os) = @_;
+    my $jdk_hosts = 'jdk_hosts';
+    my %HOSTS = ();
+
+    open(CFG, $jdk_hosts) or die("hosts error: $!");
+    while(<CFG>) {
+	chop;
+	($os, $host) = split(/\s*=>\s*/, $_);
+	next unless $os eq $port_os;
+	push(@HOSTS, $host);
+    }
+    close(CFG);
+
+    return "" unless @HOSTS;
+    return $HOSTS[rand @HOSTS];		# Pick one at random.
+}
+
diff --git a/jpl/get_jdk/jdk_hosts b/jpl/get_jdk/jdk_hosts
new file mode 100644
index 0000000000..fa50b511eb
--- /dev/null
+++ b/jpl/get_jdk/jdk_hosts
@@ -0,0 +1,4 @@
+solaris => ftp://ftp.javasoft.com/pub/jdk1.1/jdk1.1.3-solaris2-sparc.bin
+linux	=> ftp://ftp.infomagic.com/pub/mirrors/linux/Java/JDK-1.1.3/linux-jdk.1.1.3-v2.tar.gz
+linux	=> ftp://ftp.connectnet.com/pub/java/JDK-1.1.3/linux-jdk.1.1.3-v2.tar.gz
+freebsd	=> http://www.csi.uottawa.ca/~kwhite/jdkbinaries/jdk1.1-FreeBSD.tar.gz