commit for archiving

Perl/bin/IISScriptMap.pl

@@ -0,0 +1,72 @@
+###############################################################################
+#
+# File:         IISScriptMap.pl
+# Description:  Creates script mappings in the IIS metabase.
+#
+# Copyright (c) 2000-2005 ActiveState Software Inc.  All rights reserved.
+#
+###############################################################################
+BEGIN {
+    $tmp = $ENV{'TEMP'} || $ENV{'tmp'} ||
+	($Config{'osname'} eq 'MSWin32' ? 'c:/temp' : '/tmp');
+    open(STDERR, ">> $tmp/ActivePerlInstall.log");
+}
+
+use strict;
+use Win32 ();
+use Win32::OLE;
+
+my $iis = Win32::GetFolderPath(Win32::CSIDL_SYSTEM)."\\inetsrv\\inetinfo.exe";
+exit 0 unless -f $iis;
+
+my($server_id,$virt_dir,$file_ext,$exec_path,$flags,$verbs) = @ARGV;
+my @dirs = split /;/, $virt_dir, -1;
+push @dirs, "" unless @dirs;
+
+my $iis_version = int(Win32::GetFileVersion($iis));
+
+unless (defined $flags) {
+    # 1 The script is allowed to run in directories given Script
+    #   permission. If this value is not set, then the script can only be
+    #   executed in directories that are flagged for Execute permission.
+    # 4 The server attempts to access the PATH_INFO portion of the URL, as a
+    #   file, before starting the scripting engine. If the file can't be
+    #   opened, or doesn't exist, an error is returned to the client.
+    $flags = 5;
+}
+unless (defined $verbs) {
+    # In IIS version 4.0 and earlier, the syntax was to list excluded verbs
+    # rather than included verbs. In version 5.0, if no verbs are listed, a
+    # value of "all verbs" is assumed.
+    $verbs = $iis_version < 5 ? "PUT,DELETE" : "GET,HEAD,POST";
+}
+
+# Add script mappings
+foreach my $id (split /;/, $server_id) {
+    foreach my $dir (@dirs) {
+	my $node = "IIS://localhost/W3SVC";
+	# NOTE: A serverID of "0" is treated as the W3SVC root; any supplied
+	# virtual directory for this case is ignored.
+	$node .= "/$id/ROOT" if $id;
+	$node .= "/$dir"     if $id and length($dir);
+
+	my $server = Win32::OLE->GetObject($node) or next;
+	my @list = grep { !/^\Q$file_ext,\E/ } @{$server->{ScriptMaps}};
+	$server->{ScriptMaps} = [@list, "$file_ext,$exec_path,$flags,$verbs"];
+	$server->SetInfo(); # save!
+    }
+}
+
+# Check for Windows 2003 Server
+exit 0 unless $iis_version >= 6;
+
+# Add Web Server Extension entry
+my %types = (".pl"   => "Perl CGI",
+	     ".plx"  => "Perl ISAPI",
+	     ".plex" => "PerlEx ISAPI");
+my $type = $types{$file_ext} || "Perl $file_ext";
+
+my $server = Win32::OLE->GetObject("IIS://localhost/W3SVC") or exit;
+my @list = @{$server->{WebSvcExtRestrictionList}};
+$server->{WebSvcExtRestrictionList} = [@list, "0,$exec_path,1,,$type Extension"];
+$server->SetInfo();

Perl/bin/IISVirtualDir.pl

@@ -0,0 +1,41 @@
+use strict;
+use warnings;
+use Win32::OLE;
+
+my($ServerNumber, $Name, $Path, $Browse, $Read, $Write, $Execute,
+   $Script, $AuthAnon, $AuthNTLM, $NoDelete) = @ARGV;
+
+$Browse   = 0 unless defined $Browse;
+$Read     = 1 unless defined $Read;
+$Write    = 0 unless defined $Write;
+$Execute  = 1 unless defined $Execute;
+$Script   = 0 unless defined $Script;
+# if unspecified, enable anonymous access (this is the IIS default)
+$AuthAnon = 1 unless defined $AuthAnon;
+# if unspecified, enable NTLM access (this is the IIS default)
+$AuthNTLM = 1 unless defined $AuthNTLM;
+
+my $ADsPath = "IIS://localhost/W3SVC/$ServerNumber/ROOT";
+my $website = Win32::OLE->GetObject($ADsPath) or exit;
+$website->Delete('IISWebVirtualDir', $Name) unless $NoDelete;
+my $virdir = $website->Create('IISWebVirtualDir', $Name) or exit;
+
+$virdir->{Path}                  = $Path;
+$virdir->{AppFriendlyName}       = $Name;
+
+$virdir->{EnableDirBrowsing}     = $Browse;
+$virdir->{AccessRead}            = $Read;
+$virdir->{AccessWrite}           = $Write;
+$virdir->{AccessExecute}         = $Execute;
+$virdir->{AccessScript}          = $Script;
+
+$virdir->{AccessNoRemoteRead}    = 0;
+$virdir->{AccessNoRemoteScript}  = 0;
+$virdir->{AccessNoRemoteWrite}   = 0;
+$virdir->{AccessNoRemoteExecute} = 0;
+
+$virdir->{AuthAnonymous}         = $AuthAnon;
+$virdir->{AuthNTLM}              = $AuthNTLM;
+
+$virdir->AppCreate(1);
+$virdir->SetInfo();

Perl/bin/PerlExOverLimit.txt

@@ -0,0 +1,8 @@
+HTTP 200 OK
+Content-type: text/html
+
+
+<html>
+Your request exceeded the PerlEx data size limits configured on this
+server.  Please contact the web site administrator.
+</html>

Perl/bin/SOAPsh.bat

@@ -0,0 +1,95 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/bin/env perl
+#line 15
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use strict;
+use SOAP::Lite;
+use Data::Dumper; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 1;
+
+@ARGV or die "Usage: $0 proxy [uri [commands...]]\n";
+my($proxy, $uri) = (shift, shift);
+my %can;
+my $soap = SOAP::Lite->proxy($proxy)->on_fault(sub{});
+                $soap->uri($uri) if $uri;
+print STDERR "Usage: method[(parameters)]\n> ";
+while (defined($_ = shift || <>)) {
+  next unless /\w/;
+  my($method) = /\s*(\w+)/;
+  $can{$method} = $soap->can($method) unless exists $can{$method};
+  my $res = eval "\$soap->$_";
+  $@                               ? print(STDERR join "\n", "--- SYNTAX ERROR ---", $@, '') :
+  $can{$method} && !UNIVERSAL::isa($res => 'SOAP::SOM')
+                                   ? print(STDERR join "\n", "--- METHOD RESULT ---", $res || '', '') :
+  defined($res) && $res->fault     ? print(STDERR join "\n", "--- SOAP FAULT ---", $res->faultcode, $res->faultstring, '') :
+  !$soap->transport->is_success    ? print(STDERR join "\n", "--- TRANSPORT ERROR ---", $soap->transport->status, '') :
+                                     print(STDERR join "\n", "--- SOAP RESULT ---", Dumper($res->paramsall), '')
+} continue {
+  print STDERR "\n> ";
+}
+
+__END__
+
+=head1 NAME
+
+SOAPsh.pl - Interactive shell for SOAP calls
+
+=head1 SYNOPSIS
+
+  perl SOAPsh.pl http://services.soaplite.com/examples.cgi http://www.soaplite.com/My/Examples
+  > getStateName(2)
+  > getStateNames(1,2,3,7)
+  > getStateList([1,9])
+  > getStateStruct({a=>1, b=>24})
+  > Ctrl-D (Ctrl-Z on Windows)
+
+or
+
+  # all parameters after uri will be executed as methods
+  perl SOAPsh.pl http://soap.4s4c.com/ssss4c/soap.asp http://simon.fell.com/calc doubler([10,20,30])
+  > Ctrl-D (Ctrl-Z on Windows)
+
+=head1 DESCRIPTION
+
+SOAPsh.pl is a shell for making SOAP calls. It takes two parameters:
+mandatory endpoint and optional uri (actually it will tell you about it
+if you try to run it). Additional commands can follow.
+
+After that you'll be able to run any methods of SOAP::Lite, like autotype,
+readable, encoding, etc. You can run it the same way as you do it in
+your Perl script. You'll see output from method, result of SOAP call,
+detailed info on SOAP faulure or transport error.
+
+For full list of available methods see documentation for SOAP::Lite.
+
+Along with methods of SOAP::Lite you'll be able (and that's much more
+interesting) run any SOAP methods you know about on remote server and
+see processed results. You can even switch on debugging (with call
+something like: C<on_debug(sub{print@_})>) and see SOAP code with
+headers sent and recieved.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000 Paul Kulchenko. All rights reserved.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger@yahoo.com)
+
+=cut
+
+__END__
+:endofperl

Perl/bin/SOAPsh.pl

@@ -0,0 +1,79 @@
+#!/bin/env perl
+#!d:\perl\bin\perl.exe
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use strict;
+use SOAP::Lite;
+use Data::Dumper; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 1;
+
+@ARGV or die "Usage: $0 proxy [uri [commands...]]\n";
+my($proxy, $uri) = (shift, shift);
+my %can;
+my $soap = SOAP::Lite->proxy($proxy)->on_fault(sub{});
+                $soap->uri($uri) if $uri;
+print STDERR "Usage: method[(parameters)]\n> ";
+while (defined($_ = shift || <>)) {
+  next unless /\w/;
+  my($method) = /\s*(\w+)/;
+  $can{$method} = $soap->can($method) unless exists $can{$method};
+  my $res = eval "\$soap->$_";
+  $@                               ? print(STDERR join "\n", "--- SYNTAX ERROR ---", $@, '') :
+  $can{$method} && !UNIVERSAL::isa($res => 'SOAP::SOM')
+                                   ? print(STDERR join "\n", "--- METHOD RESULT ---", $res || '', '') :
+  defined($res) && $res->fault     ? print(STDERR join "\n", "--- SOAP FAULT ---", $res->faultcode, $res->faultstring, '') :
+  !$soap->transport->is_success    ? print(STDERR join "\n", "--- TRANSPORT ERROR ---", $soap->transport->status, '') :
+                                     print(STDERR join "\n", "--- SOAP RESULT ---", Dumper($res->paramsall), '')
+} continue {
+  print STDERR "\n> ";
+}
+
+__END__
+
+=head1 NAME
+
+SOAPsh.pl - Interactive shell for SOAP calls
+
+=head1 SYNOPSIS
+
+  perl SOAPsh.pl http://services.soaplite.com/examples.cgi http://www.soaplite.com/My/Examples
+  > getStateName(2)
+  > getStateNames(1,2,3,7)
+  > getStateList([1,9])
+  > getStateStruct({a=>1, b=>24})
+  > Ctrl-D (Ctrl-Z on Windows)
+
+or
+
+  # all parameters after uri will be executed as methods
+  perl SOAPsh.pl http://soap.4s4c.com/ssss4c/soap.asp http://simon.fell.com/calc doubler([10,20,30])
+  > Ctrl-D (Ctrl-Z on Windows)
+
+=head1 DESCRIPTION
+
+SOAPsh.pl is a shell for making SOAP calls. It takes two parameters:
+mandatory endpoint and optional uri (actually it will tell you about it
+if you try to run it). Additional commands can follow.
+
+After that you'll be able to run any methods of SOAP::Lite, like autotype,
+readable, encoding, etc. You can run it the same way as you do it in
+your Perl script. You'll see output from method, result of SOAP call,
+detailed info on SOAP faulure or transport error.
+
+For full list of available methods see documentation for SOAP::Lite.
+
+Along with methods of SOAP::Lite you'll be able (and that's much more
+interesting) run any SOAP methods you know about on remote server and
+see processed results. You can even switch on debugging (with call
+something like: C<on_debug(sub{print@_})>) and see SOAP code with
+headers sent and recieved.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000 Paul Kulchenko. All rights reserved.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger@yahoo.com)
+
+=cut

Perl/bin/XMLRPCsh.bat

@@ -0,0 +1,94 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/bin/env perl 
+#line 15
+#!d:\perl\bin\perl.exe 
+
+# -- XMLRPC::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use strict;
+use XMLRPC::Lite;
+use Data::Dumper; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 1;
+
+@ARGV or die "Usage: $0 endpoint [commands...]\n";
+my $proxy = shift;
+my %can;
+my $xmlrpc = XMLRPC::Lite->proxy($proxy)->on_fault(sub{});
+print STDERR "Usage: method[(parameters)]\n> ";
+while (defined($_ = shift || <>)) {
+  next unless /\w/;
+  my($method, $parameters) = /^\s*([.\w]+)(.*)/;
+  $can{$method} = $xmlrpc->can($method) unless exists $can{$method};
+  my $res = $method =~ /\./ ? eval "\$xmlrpc->call(\$method, $parameters)" : eval "\$xmlrpc->$_";
+  $@                               ? print(STDERR join "\n", "--- SYNTAX ERROR ---", $@, '') :
+  $can{$method} && !UNIVERSAL::isa($res => 'XMLRPC::SOM')
+                                   ? print(STDERR join "\n", "--- METHOD RESULT ---", $res || '', '') :
+  defined($res) && $res->fault     ? print(STDERR join "\n", "--- XMLRPC FAULT ---", @{$res->fault}{'faultCode', 'faultString'}, '') :
+  !$xmlrpc->transport->is_success  ? print(STDERR join "\n", "--- TRANSPORT ERROR ---", $xmlrpc->transport->status, '') :
+                                     print(STDERR join "\n", "--- XMLRPC RESULT ---", Dumper($res->paramsall), '')
+} continue {
+  print STDERR "\n> ";
+}
+
+__END__
+
+=head1 NAME
+
+XMLRPCsh.pl - Interactive shell for XMLRPC calls
+
+=head1 SYNOPSIS
+
+  perl XMLRPCsh.pl http://betty.userland.com/RPC2
+  > examples.getStateName(2)
+  > examples.getStateNames(1,2,3,7)
+  > examples.getStateList([1,9])
+  > examples.getStateStruct({a=>1, b=>24})
+  > Ctrl-D (Ctrl-Z on Windows)
+
+or
+
+  # all parameters after uri will be executed as methods
+  perl XMLRPCsh.pl http://betty.userland.com/RPC2 examples.getStateName(2)
+  > Ctrl-D (Ctrl-Z on Windows)
+
+=head1 DESCRIPTION
+
+XMLRPCsh.pl is a shell for making XMLRPC calls. It takes one parameter,
+endpoint (actually it will tell you about it if you try to run it).
+Additional commands can follow.
+
+After that you'll be able to run any methods of XMLRPC::Lite, like autotype,
+readable, etc. You can run it the same way as you do it in
+your Perl script. You'll see output from method, result of XMLRPC call,
+detailed info on XMLRPC faulure or transport error.
+
+For full list of available methods see documentation for XMLRPC::Lite.
+
+Along with methods of XMLRPC::Lite you'll be able (and that's much more
+interesting) run any XMLRPC methods you know about on remote server and
+see processed results. You can even switch on debugging (with call
+something like: C<on_debug(sub{print@_})>) and see XMLRPC code with
+headers sent and recieved.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000 Paul Kulchenko. All rights reserved.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger@yahoo.com)
+
+=cut
+
+__END__
+:endofperl

Perl/bin/XMLRPCsh.pl

@@ -0,0 +1,78 @@
+#!/bin/env perl 
+#!d:\perl\bin\perl.exe 
+
+# -- XMLRPC::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use strict;
+use XMLRPC::Lite;
+use Data::Dumper; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 1;
+
+@ARGV or die "Usage: $0 endpoint [commands...]\n";
+my $proxy = shift;
+my %can;
+my $xmlrpc = XMLRPC::Lite->proxy($proxy)->on_fault(sub{});
+print STDERR "Usage: method[(parameters)]\n> ";
+while (defined($_ = shift || <>)) {
+  next unless /\w/;
+  my($method, $parameters) = /^\s*([.\w]+)(.*)/;
+  $can{$method} = $xmlrpc->can($method) unless exists $can{$method};
+  my $res = $method =~ /\./ ? eval "\$xmlrpc->call(\$method, $parameters)" : eval "\$xmlrpc->$_";
+  $@                               ? print(STDERR join "\n", "--- SYNTAX ERROR ---", $@, '') :
+  $can{$method} && !UNIVERSAL::isa($res => 'XMLRPC::SOM')
+                                   ? print(STDERR join "\n", "--- METHOD RESULT ---", $res || '', '') :
+  defined($res) && $res->fault     ? print(STDERR join "\n", "--- XMLRPC FAULT ---", @{$res->fault}{'faultCode', 'faultString'}, '') :
+  !$xmlrpc->transport->is_success  ? print(STDERR join "\n", "--- TRANSPORT ERROR ---", $xmlrpc->transport->status, '') :
+                                     print(STDERR join "\n", "--- XMLRPC RESULT ---", Dumper($res->paramsall), '')
+} continue {
+  print STDERR "\n> ";
+}
+
+__END__
+
+=head1 NAME
+
+XMLRPCsh.pl - Interactive shell for XMLRPC calls
+
+=head1 SYNOPSIS
+
+  perl XMLRPCsh.pl http://betty.userland.com/RPC2
+  > examples.getStateName(2)
+  > examples.getStateNames(1,2,3,7)
+  > examples.getStateList([1,9])
+  > examples.getStateStruct({a=>1, b=>24})
+  > Ctrl-D (Ctrl-Z on Windows)
+
+or
+
+  # all parameters after uri will be executed as methods
+  perl XMLRPCsh.pl http://betty.userland.com/RPC2 examples.getStateName(2)
+  > Ctrl-D (Ctrl-Z on Windows)
+
+=head1 DESCRIPTION
+
+XMLRPCsh.pl is a shell for making XMLRPC calls. It takes one parameter,
+endpoint (actually it will tell you about it if you try to run it).
+Additional commands can follow.
+
+After that you'll be able to run any methods of XMLRPC::Lite, like autotype,
+readable, etc. You can run it the same way as you do it in
+your Perl script. You'll see output from method, result of XMLRPC call,
+detailed info on XMLRPC faulure or transport error.
+
+For full list of available methods see documentation for XMLRPC::Lite.
+
+Along with methods of XMLRPC::Lite you'll be able (and that's much more
+interesting) run any XMLRPC methods you know about on remote server and
+see processed results. You can even switch on debugging (with call
+something like: C<on_debug(sub{print@_})>) and see XMLRPC code with
+headers sent and recieved.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2000 Paul Kulchenko. All rights reserved.
+
+=head1 AUTHOR
+
+Paul Kulchenko (paulclinger@yahoo.com)
+
+=cut

Perl/bin/ap-update-html

@@ -0,0 +1,51 @@
+#!/usr/bin/perl -w
+
+my %opt;
+if (@ARGV) {
+    require Getopt::Long;
+    Getopt::Long::GetOptions(
+        \%opt,
+	'force',
+	'verbose',
+    ) || usage();
+    usage() if @ARGV;
+
+    sub usage {
+	(my $progname = $0) =~ s,.*[/\\],,;
+	die "Usage: $progname [--force] [--verbose]\n";
+    }
+}
+
+use ActivePerl::DocTools ();
+ActivePerl::DocTools::UpdateHTML(raise_error => 1, %opt);
+
+__END__
+
+=head1 NAME
+
+ap-update-html - Regenerate any out-of-date HTML
+
+=head1 SYNOPSIS
+
+B<ap-update-html> [ B<--force> ] [ B<--verbose> ]
+
+=head1 DESCRIPTION
+
+If new modules has been installed then they might not have had their
+documentation converted to HTML yet.  This script will bring the HTML
+up-to-date with what modules are installed.
+
+The following command line options are recognized:
+
+=over
+
+=item B<--force>
+
+Force HTML documents to be regenerated even if they appear to be
+up-to-date.
+
+=item B<--verbose>
+
+Print noise about what's done while running.
+
+=back

Perl/bin/ap-update-html.bat

@@ -0,0 +1,67 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl -w
+#line 15
+
+my %opt;
+if (@ARGV) {
+    require Getopt::Long;
+    Getopt::Long::GetOptions(
+        \%opt,
+	'force',
+	'verbose',
+    ) || usage();
+    usage() if @ARGV;
+
+    sub usage {
+	(my $progname = $0) =~ s,.*[/\\],,;
+	die "Usage: $progname [--force] [--verbose]\n";
+    }
+}
+
+use ActivePerl::DocTools ();
+ActivePerl::DocTools::UpdateHTML(raise_error => 1, %opt);
+
+__END__
+
+=head1 NAME
+
+ap-update-html - Regenerate any out-of-date HTML
+
+=head1 SYNOPSIS
+
+B<ap-update-html> [ B<--force> ] [ B<--verbose> ]
+
+=head1 DESCRIPTION
+
+If new modules has been installed then they might not have had their
+documentation converted to HTML yet.  This script will bring the HTML
+up-to-date with what modules are installed.
+
+The following command line options are recognized:
+
+=over
+
+=item B<--force>
+
+Force HTML documents to be regenerated even if they appear to be
+up-to-date.
+
+=item B<--verbose>
+
+Print noise about what's done while running.
+
+=back
+
+__END__
+:endofperl

Perl/bin/ap-user-guide

@@ -0,0 +1,16 @@
+#!/usr/bin/perl -w
+
+# This script will open up the ActivePerl User Guide in your
+# web browser.
+
+use strict;
+use Config qw(%Config);
+
+my $htmldir = $Config{installhtmldir} || "$Config{prefix}/html";
+my $index = "$htmldir/index.html";
+
+die "No HTML docs installed at $htmldir\n"
+    unless -f $index;
+
+require ActiveState::Browser;
+ActiveState::Browser::open($index);

Perl/bin/ap-user-guide.bat

@@ -0,0 +1,32 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl -w
+#line 15
+
+# This script will open up the ActivePerl User Guide in your
+# web browser.
+
+use strict;
+use Config qw(%Config);
+
+my $htmldir = $Config{installhtmldir} || "$Config{prefix}/html";
+my $index = "$htmldir/index.html";
+
+die "No HTML docs installed at $htmldir\n"
+    unless -f $index;
+
+require ActiveState::Browser;
+ActiveState::Browser::open($index);
+
+__END__
+:endofperl

Perl/bin/config.pl

@@ -0,0 +1,242 @@
+###############################################################################
+#
+# Script:	config.pl
+# Purpose:	Fix up Config.pm after a binary installation
+#
+# Copyright (c) 1999-2005 ActiveState Corp.  All rights reserved.
+#
+###############################################################################
+
+use File::Basename qw(dirname);
+
+my $prefix = dirname(dirname($^X));
+my $libpth = $ENV{LIB};
+my $user   = $ENV{USERNAME};
+my $file   = $prefix . '\lib\Config.pm';
+my $oldfile = $prefix . '\lib\Config.pm~';
+
+$tmp = $ENV{'TEMP'} || $ENV{'tmp'};
+if ($^O =~ /MSWin/) {
+    $tmp ||= 'c:/temp';
+}
+else {
+    $tmp ||= '/tmp';
+}
+
+print 'Configuring Perl ... ' . "\n";
+
+# Remove the "command" value from the file association to prevent the MSI
+# "Repair" feature from triggering once an included extension has been
+# upgraded by PPM.
+if ($^O =~ /MSWin/) {
+    require Win32::Registry;
+    $::HKEY_CLASSES_ROOT->Open('Perl\shell\Open\command', my $command);
+    $command->DeleteValue('command') if $command;
+}
+
+my %replacements = (
+	archlib			=> "'$prefix\\lib'",
+	archlibexp		=> "'$prefix\\lib'",
+	bin			=> "'$prefix\\bin'",
+	binexp			=> "'$prefix\\bin'",
+	cf_by			=> "'ActiveState'",
+	installarchlib		=> "'$prefix\\lib'",
+	installbin		=> "'$prefix\\bin'",
+	installhtmldir		=> "'$prefix\\html'",
+	installhtmlhelpdir 	=> "'$prefix\\htmlhelp'",
+	installman1dir		=> "''",
+	installman3dir		=> "''",
+	installprefix		=> "'$prefix'",
+	installprefixexp	=> "'$prefix'",
+	installprivlib		=> "'$prefix\\lib'",
+	installscript		=> "'$prefix\\bin'",
+	installsitearch		=> "'$prefix\\site\\lib'",
+	installsitebin		=> "'$prefix\\bin'",
+	installsitelib		=> "'$prefix\\site\\lib'",
+	libpth			=> q('") . join(q(" "), split(/;/, $libpth), $prefix . "\\lib\\CORE") . q("'),
+	man1dir			=> "''",
+	man1direxp		=> "''",
+	man3dir			=> "''",
+	man3direxp		=> "''",
+	perlpath		=> "'$prefix\\bin\\perl.exe'",
+	prefix			=> "'$prefix'",
+	prefixexp		=> "'$prefix'",
+	privlib			=> "'$prefix\\lib'",
+	privlibexp		=> "'$prefix\\lib'",
+	scriptdir		=> "'$prefix\\bin'",
+	scriptdirexp		=> "'$prefix\\bin'",
+	sitearch		=> "'$prefix\\site\\lib'",
+	sitearchexp		=> "'$prefix\\site\\lib'",
+	sitebin			=> "'$prefix\\site\\bin'",
+	sitebinexp		=> "'$prefix\\site\\bin'",
+	sitelib			=> "'$prefix\\site\\lib'",
+	sitelibexp		=> "'$prefix\\site\\lib'",
+	siteprefix		=> "'$prefix\\site'",
+	siteprefixexp		=> "'$prefix\\site'",
+);
+
+my $pattern = '^(' . join('|', keys %replacements) . ')=.*';
+
+chmod(0644, $file)
+    or warn "Unable to chmod(0644, $file) : $!";
+    
+if(open(FILE, "+<$file")) {
+    my @Config;
+    while(<FILE>) {
+	s/$pattern/$1=$replacements{$1}/;
+	push(@Config, $_); 
+    }
+
+    seek(FILE, 0, 0);
+    truncate(FILE, 0);
+    print FILE @Config;
+    close(FILE);
+    chmod(0444, $file)
+	or warn "Unable to chmod(0444, $file) : $!";
+}
+else {
+    print "Unable to open $file : $!\n\n";
+    print "Press [Enter] to continue:\n";
+    <STDIN>;
+    exit 1;
+}
+
+###############################################################################
+# Config.pm values to propogate when doing an upgrade installation
+###############################################################################
+my @propagateThese = qw(
+	ar
+	awk
+	bash
+	bin
+	binexp
+	bison
+	byacc
+	cat
+	cc
+	cp
+	cryptlib
+	csh
+	date
+	echo
+	egrep
+	emacs
+	expr
+	find
+	flex
+	full_csh
+	full_sed
+	gccversion
+	glibpth
+	gzip
+	incpath
+	inews
+	ksh
+	ld
+	lddlflags
+	ldflags
+	less
+	libc
+	libpth
+	ln
+	lns
+	loincpth
+	lolibpth
+	lp
+	lpr
+	ls
+	mail
+	mailx
+	make
+	mkdir
+	more
+	mv
+	mydomain
+	myhostname
+	myuname
+	pager
+	rm
+	rmail
+	sed
+	sendmail
+	sh
+	tar
+	touch
+	tr
+	usrinc
+	vi
+	xlibpth
+	zcat
+	zip
+);
+
+if(-f $oldfile) {
+    mergeConfig($oldfile, $file);
+}
+
+###############################################################################
+#
+###############################################################################
+sub mergeConfig {
+    my $file1 = shift;
+    my $file2 = shift;
+
+    open(FILE1, "<$file1")
+	|| do {
+		warn "Could not open file $file1 : $!";
+		return -1;
+	};
+    
+    my $foundConfigBegin = 0;
+    my $foundConfigEnd = 0;
+    my %Config1 = ();
+    while(<FILE1>) {
+	chomp;
+	if (!$foundConfigBegin && /^my \$config_sh = <<'!END!';$/) {
+	    $foundConfigBegin = 1;
+	    next;
+	} 
+	elsif (!$foundConfigEnd && /^!END!$/) {
+	    last;
+	}
+	next if(!$foundConfigBegin);
+	my ($name, $value) = split(/=/, $_, 2);
+	if(grep(/$name/, @propagateThese)) {
+	    $Config1{$name} = $value;
+	}
+    }
+    close(FILE1);
+
+    open(FILE2, "+<$file2")
+	|| do {
+		warn "Could not open file $file2 : $!";
+		return -1;
+	};
+
+    $foundConfigBegin = 0;
+    $foundConfigEnd = 0;
+    my @Config2 = ();
+    while(<FILE2>) {
+	my $line = $_;
+	chomp($line);
+	if (!$foundConfigBegin && $line =~ /^my \$config_sh = <<'!END!';$/) {
+	    $foundConfigBegin = 1;
+	} 
+	elsif (!$foundConfigEnd && $line =~ /^!END!$/) {
+	    $foundConfigEnd = 1;
+	}
+	elsif ($foundConfigBegin && !$foundConfigEnd) {
+	    my ($name, $value) = split(/=/, $line, 2);
+	    if(exists $Config1{$name} && length($Config1{$name}) > 0) {
+		$line = "$name=$Config1{$name}";
+	    }
+	}
+	push(@Config2, $line . "\n");
+    }
+    truncate(FILE2, 0);
+    seek(FILE2, 0, 0);
+    print FILE2 (@Config2);
+    close(FILE2);
+    return; 
+}
+

Perl/bin/configPPM3.pl

@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+
+my $p_ppm3 = $ARGV[0];
+my $p_cdpkgs = $ARGV[1];
+my $p_pdpkgs = "http://ActivePerlEE.ActiveState.com/packages/5.8.4";
+
+Win32::SetChildShowWindow(0) if defined &Win32::SetChildShowWindow;
+
+#system("$p_ppm3 repo add \"ActivePerl Enterprise Edition Package Repository\" $p_pdpkgs");
+system("$p_ppm3 repo add \"LocalCD\" $p_cdpkgs");
+system("$p_ppm3 repo del \"ActiveState Package Repository\"");
+system("$p_ppm3 repo del \"ActiveState PPM2 Repository\"");

Perl/bin/cpan.bat

@@ -0,0 +1,222 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+	if $running_under_some_shell;
+#!/usr/bin/perl
+# $Id: cpan,v 1.3 2002/08/30 08:55:15 k Exp $
+use strict;
+
+=head1 NAME
+
+cpan - easily interact with CPAN from the command line
+
+=head1 SYNOPSIS
+
+	# with arguments, installs specified modules
+	cpan module_name [ module_name ... ]
+	
+	# with switches, installs modules with extra behavior
+	cpan [-cimt] module_name [ module_name ... ]
+	
+	# without arguments, starts CPAN shell
+	cpan
+	
+	# without arguments, but some switches
+	cpan [-ahrv]
+
+=head1 DESCRIPTION
+
+This script provides a command interface (not a shell) to CPAN.pm.
+
+=head2 Meta Options
+
+These options are mutually exclusive, and the script processes
+them in this order: [ahvr].  Once the script finds one, it ignores
+the others, and then exits after it finishes the task.  The script
+ignores any other command line options.
+
+=over 4
+
+=item -a
+
+Creates the CPAN.pm autobundle with CPAN::Shell->autobundle.  
+
+=item -h
+
+Prints a help message.
+
+=item -r
+
+Recompiles dynamically loaded modules with CPAN::Shell->recompile.
+
+=item -v
+
+Print the script version and CPAN.pm version.
+
+=back
+
+=head2 Module options
+
+These options are mutually exclusive, and the script processes
+them in alphabetical order. 
+
+=over 4
+
+=item c
+
+Runs a `make clean` in the specified module's directories.
+
+=item i
+
+Installed the specified modules.
+
+=item m
+
+Makes the specified modules.
+
+=item t
+
+Runs a `make test` on the specified modules.
+
+=back
+
+=head2 Examples
+
+	# print a help message
+	cpan -h
+	
+	# print the version numbers
+	cpan -v
+	
+	# create an autobundle
+	cpan -a
+	
+	# recompile modules
+	cpan -r 
+	
+	# install modules
+	cpan -i Netscape::Booksmarks Business::ISBN
+
+=head1 TO DO
+
+* add options for other CPAN::Shell functions
+autobundle, clean, make, recompile, test
+
+=head1 BUGS
+
+* none noted
+
+=head1 SEE ALSO
+
+Most behaviour, including environment variables and configuration,
+comes directly from CPAN.pm.
+
+=head1 AUTHOR
+
+brian d foy <bdfoy@cpan.org>
+
+=cut
+
+use CPAN ();
+use Getopt::Std;
+
+my $VERSION = 
+	sprintf "%d.%02d", q$Revision: 1.3 $ =~ m/ (\d+) \. (\d+) /xg;
+
+my $Default = 'default';
+
+my $META_OPTIONS = 'ahvr';
+
+my %CPAN_METHODS = (
+	$Default => 'install',
+	'c'      => 'clean',
+	'i'      => 'install',
+	'm'      => 'make',
+	't'      => 'test',
+	);
+
+my @cpan_options = grep { $_ ne $Default } sort keys %CPAN_METHODS;
+
+my $arg_count = @ARGV;
+my %options;
+
+Getopt::Std::getopts( 
+	join( '', @cpan_options, $META_OPTIONS ), \%options );
+	
+if( $options{h} )
+	{
+	print STDERR "Printing help message -- ignoring other arguments\n"
+		if $arg_count > 1;
+
+	print STDERR "Use perldoc to read the documentation\n";
+	exit 0;
+	}
+elsif( $options{v} )
+	{
+	print STDERR "Printing version message -- ignoring other arguments\n"
+	
+		if $arg_count > 1;
+
+	my $CPAN_VERSION = CPAN->VERSION;
+	print STDERR "cpan script version $VERSION\n" .
+		"CPAN.pm version $CPAN_VERSION\n";
+	exit 0;
+	}
+elsif( $options{a} )
+	{
+	print "Creating autobundle in ", $CPAN::Config->{cpan_home}, 
+		"/Bundle\n";
+	print STDERR "Creating autobundle -- ignoring other arguments\n"
+		if $arg_count > 1;
+
+	CPAN::Shell->autobundle;
+	exit 0;
+	}
+elsif( $options{r} )
+	{
+	print STDERR "Creating autobundle -- ignoring other arguments\n"
+		if $arg_count > 1;
+		
+	CPAN::Shell->recompile;
+	}
+else
+	{
+	my $switch = '';
+	
+	foreach my $option ( @cpan_options )
+		{
+		next unless $options{$option};
+		$switch = $option;
+		last;
+		}
+	
+	   if( not $switch and     @ARGV ) { $switch = $Default;     }
+	elsif( not $switch and not @ARGV ) { CPAN::shell(); exit 0;  }	
+	elsif(     $switch and not @ARGV ) 
+		{ die "Nothing to $CPAN_METHODS{$switch}!\n"; }
+
+	my $method = $CPAN_METHODS{$switch};
+	die "CPAN.pm cannot $method!\n" unless CPAN::Shell->can( $method );
+	
+	foreach my $arg ( @ARGV )
+		{
+		CPAN::Shell->$method( $arg );
+		}
+	}
+	
+1;
+
+__END__
+:endofperl

Perl/bin/crc32

@@ -0,0 +1,28 @@
+#! /usr/bin/perl -w
+# computes and prints to stdout the CRC-32 values of the given files
+use lib qw( blib/lib lib );
+use Archive::Zip;
+use FileHandle;
+
+my $totalFiles = scalar(@ARGV);
+foreach my $file (@ARGV) {
+    if ( -d $file ) {
+        warn "$0: ${file}: Is a directory\n";
+        next;
+    }
+    my $fh = FileHandle->new();
+    if ( !$fh->open( $file, 'r' ) ) {
+        warn "$0: $!\n";
+        next;
+    }
+    binmode($fh);
+    my $buffer;
+    my $bytesRead;
+    my $crc = 0;
+    while ( $bytesRead = $fh->read( $buffer, 32768 ) ) {
+        $crc = Archive::Zip::computeCRC32( $buffer, $crc );
+    }
+    printf( "%08x", $crc );
+    print("\t$file") if ( $totalFiles > 1 );
+    print("\n");
+}

Perl/bin/crc32.bat

@@ -0,0 +1,44 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#! /usr/bin/perl -w
+#line 15
+# computes and prints to stdout the CRC-32 values of the given files
+use lib qw( blib/lib lib );
+use Archive::Zip;
+use FileHandle;
+
+my $totalFiles = scalar(@ARGV);
+foreach my $file (@ARGV) {
+    if ( -d $file ) {
+        warn "$0: ${file}: Is a directory\n";
+        next;
+    }
+    my $fh = FileHandle->new();
+    if ( !$fh->open( $file, 'r' ) ) {
+        warn "$0: $!\n";
+        next;
+    }
+    binmode($fh);
+    my $buffer;
+    my $bytesRead;
+    my $crc = 0;
+    while ( $bytesRead = $fh->read( $buffer, 32768 ) ) {
+        $crc = Archive::Zip::computeCRC32( $buffer, $crc );
+    }
+    printf( "%08x", $crc );
+    print("\t$file") if ( $totalFiles > 1 );
+    print("\n");
+}
+
+__END__
+:endofperl

Perl/bin/dbiprof

@@ -0,0 +1,204 @@
+#!perl
+
+use strict;
+
+my $VERSION = "1.0";
+
+use DBI::ProfileData;
+use Getopt::Long;
+
+# default options
+my $number         = 10;
+my $sort           = 'total';
+my $filename       = 'dbi.prof';
+my $reverse        = 0;
+my $case_sensitive = 0;
+my (%match, %exclude);
+
+# get options from command line
+GetOptions(
+           'version'        => sub { die "dbiprof $VERSION\n"; },
+           'number=i'       => \$number,
+           'sort=s'         => \$sort,
+           'reverse'        => \$reverse,
+           'match=s'        => \%match,
+           'exclude=s'      => \%exclude,
+           'case-sensitive' => \$case_sensitive,
+          );
+
+# list of files defaults to dbi.prof
+my @files = @ARGV ? @ARGV : ('dbi.prof');
+
+
+# instantiate ProfileData object
+my $prof;
+eval { $prof = DBI::ProfileData->new(Files => \@files) };
+die "Unable to load profile data: $@\n" if $@;
+
+# handle matches
+while (my ($key, $val) = each %match) {
+    if ($val =~ m!^/(.+)/$!) {
+        $val = $case_sensitive ? qr/$1/ : qr/$1/i;
+    } 
+    $prof->match($key, $val, case_sensitive => $case_sensitive);
+}
+
+# handle excludes
+while (my ($key, $val) = each %exclude) {
+    if ($val =~ m!^/(.+)/$!) {
+        $val = $case_sensitive ? qr/$1/ : qr/$1/i;
+    } 
+    $prof->exclude($key, $val, case_sensitive => $case_sensitive);
+}
+
+# sort the data
+$prof->sort(field => $sort, reverse => $reverse);
+
+# all done, print it out
+print $prof->report(number => $number);
+exit 0;
+
+__END__
+
+=head1 NAME
+
+dbiprof - command-line client for DBI::ProfileData
+
+=head1 SYNOPSIS
+
+See a report of the ten queries with the longest total runtime in the
+profile dump file F<prof1.out>:
+
+ dbiprof prof1.out
+
+See the top 10 most frequently run queries in the profile file
+F<dbi.prof> (the default):
+
+  dbiprof --sort count
+
+See the same report with 15 entries:
+
+  dbiprof --sort count --number 15
+
+=head1 DESCRIPTION
+
+This tool is a command-line client for the DBI::ProfileData.  It
+allows you to analyze the profile data file produced by
+DBI::ProfileDumper and produce various useful reports.
+
+=head1 OPTIONS
+
+This program accepts the following options:
+
+=over 4
+
+=item --number N
+
+Produce this many items in the report.  Defaults to 10.  If set to
+"all" then all results are shown.
+
+=item --sort field
+
+Sort results by the given field.  The available sort fields are:
+
+=over 4
+
+=item total
+
+Sorts by total time run time across all runs.  This is the default
+sort.
+
+=item longest
+
+Sorts by the longest single run.
+
+=item count
+
+Sorts by total number of runs.
+
+=item first
+
+Sorts by the time taken in the first run.
+
+=item shortest
+
+Sorts by the shortest single run.
+
+=back
+
+=item --reverse
+
+Reverses the selected sort.  For example, to see a report of the
+shortest overall time:
+
+  dbiprof --sort total --reverse
+
+=item --match keyN=value
+
+Consider only items where the specified key matches the given value.
+Keys are numbered from 1.  For example, let's say you used a
+DBI::Profile Path of:
+
+  [ DBIprofile_Statement, DBIprofile_Methodname ]
+
+And called dbiprof as in:
+
+  dbiprof --match key2=execute
+
+Your report would only show execute queries, leaving out prepares,
+fetches, etc.
+
+If the value given starts and ends with slashes (C</>) then it will be
+treated as a regular expression.  For example, to only include SELECT
+queries where key1 is the statement:
+
+  dbiprof --match key1=/^SELECT/
+
+By default the match expression is matched case-insensitively, but
+this can be changed with the --case-sensitive option.
+
+=item --exclude keyN=value
+
+Remove items for where the specified key matches the given value.  For
+example, to exclude all prepare entries where key2 is the method name:
+
+  dbiprof --exclude key2=prepare
+
+Like C<--match>, If the value given starts and ends with slashes
+(C</>) then it will be treated as a regular expression.  For example,
+to exclude UPDATE queries where key1 is the statement:
+
+  dbiprof --match key1=/^UPDATE/
+
+By default the exclude expression is matched case-insensitively, but
+this can be changed with the --case-sensitive option.
+
+=item --case-sensitive
+
+Using this option causes --match and --exclude to work
+case-sensitively.  Defaults to off.
+
+=item --version
+
+Print the dbiprof version number and exit.
+
+=back
+
+=head1 AUTHOR
+
+Sam Tregar <sam@tregar.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002 Sam Tregar
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl 5 itself.
+
+=head1 SEE ALSO
+
+L<DBI::ProfileDumper|DBI::ProfileDumper>,
+L<DBI::Profile|DBI::Profile>, L<DBI|DBI>.
+
+=cut
+

Perl/bin/dbiprof.bat

@@ -0,0 +1,220 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+
+use strict;
+
+my $VERSION = "1.0";
+
+use DBI::ProfileData;
+use Getopt::Long;
+
+# default options
+my $number         = 10;
+my $sort           = 'total';
+my $filename       = 'dbi.prof';
+my $reverse        = 0;
+my $case_sensitive = 0;
+my (%match, %exclude);
+
+# get options from command line
+GetOptions(
+           'version'        => sub { die "dbiprof $VERSION\n"; },
+           'number=i'       => \$number,
+           'sort=s'         => \$sort,
+           'reverse'        => \$reverse,
+           'match=s'        => \%match,
+           'exclude=s'      => \%exclude,
+           'case-sensitive' => \$case_sensitive,
+          );
+
+# list of files defaults to dbi.prof
+my @files = @ARGV ? @ARGV : ('dbi.prof');
+
+
+# instantiate ProfileData object
+my $prof;
+eval { $prof = DBI::ProfileData->new(Files => \@files) };
+die "Unable to load profile data: $@\n" if $@;
+
+# handle matches
+while (my ($key, $val) = each %match) {
+    if ($val =~ m!^/(.+)/$!) {
+        $val = $case_sensitive ? qr/$1/ : qr/$1/i;
+    } 
+    $prof->match($key, $val, case_sensitive => $case_sensitive);
+}
+
+# handle excludes
+while (my ($key, $val) = each %exclude) {
+    if ($val =~ m!^/(.+)/$!) {
+        $val = $case_sensitive ? qr/$1/ : qr/$1/i;
+    } 
+    $prof->exclude($key, $val, case_sensitive => $case_sensitive);
+}
+
+# sort the data
+$prof->sort(field => $sort, reverse => $reverse);
+
+# all done, print it out
+print $prof->report(number => $number);
+exit 0;
+
+__END__
+
+=head1 NAME
+
+dbiprof - command-line client for DBI::ProfileData
+
+=head1 SYNOPSIS
+
+See a report of the ten queries with the longest total runtime in the
+profile dump file F<prof1.out>:
+
+ dbiprof prof1.out
+
+See the top 10 most frequently run queries in the profile file
+F<dbi.prof> (the default):
+
+  dbiprof --sort count
+
+See the same report with 15 entries:
+
+  dbiprof --sort count --number 15
+
+=head1 DESCRIPTION
+
+This tool is a command-line client for the DBI::ProfileData.  It
+allows you to analyze the profile data file produced by
+DBI::ProfileDumper and produce various useful reports.
+
+=head1 OPTIONS
+
+This program accepts the following options:
+
+=over 4
+
+=item --number N
+
+Produce this many items in the report.  Defaults to 10.  If set to
+"all" then all results are shown.
+
+=item --sort field
+
+Sort results by the given field.  The available sort fields are:
+
+=over 4
+
+=item total
+
+Sorts by total time run time across all runs.  This is the default
+sort.
+
+=item longest
+
+Sorts by the longest single run.
+
+=item count
+
+Sorts by total number of runs.
+
+=item first
+
+Sorts by the time taken in the first run.
+
+=item shortest
+
+Sorts by the shortest single run.
+
+=back
+
+=item --reverse
+
+Reverses the selected sort.  For example, to see a report of the
+shortest overall time:
+
+  dbiprof --sort total --reverse
+
+=item --match keyN=value
+
+Consider only items where the specified key matches the given value.
+Keys are numbered from 1.  For example, let's say you used a
+DBI::Profile Path of:
+
+  [ DBIprofile_Statement, DBIprofile_Methodname ]
+
+And called dbiprof as in:
+
+  dbiprof --match key2=execute
+
+Your report would only show execute queries, leaving out prepares,
+fetches, etc.
+
+If the value given starts and ends with slashes (C</>) then it will be
+treated as a regular expression.  For example, to only include SELECT
+queries where key1 is the statement:
+
+  dbiprof --match key1=/^SELECT/
+
+By default the match expression is matched case-insensitively, but
+this can be changed with the --case-sensitive option.
+
+=item --exclude keyN=value
+
+Remove items for where the specified key matches the given value.  For
+example, to exclude all prepare entries where key2 is the method name:
+
+  dbiprof --exclude key2=prepare
+
+Like C<--match>, If the value given starts and ends with slashes
+(C</>) then it will be treated as a regular expression.  For example,
+to exclude UPDATE queries where key1 is the statement:
+
+  dbiprof --match key1=/^UPDATE/
+
+By default the exclude expression is matched case-insensitively, but
+this can be changed with the --case-sensitive option.
+
+=item --case-sensitive
+
+Using this option causes --match and --exclude to work
+case-sensitively.  Defaults to off.
+
+=item --version
+
+Print the dbiprof version number and exit.
+
+=back
+
+=head1 AUTHOR
+
+Sam Tregar <sam@tregar.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002 Sam Tregar
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl 5 itself.
+
+=head1 SEE ALSO
+
+L<DBI::ProfileDumper|DBI::ProfileDumper>,
+L<DBI::Profile|DBI::Profile>, L<DBI|DBI>.
+
+=cut
+
+
+__END__
+:endofperl

Perl/bin/dbiproxy

@@ -0,0 +1,182 @@
+#!perl
+
+use strict;
+
+my $arg_test    = shift(@ARGV)		if $ARGV[0] eq '--test';
+$ENV{DBI_TRACE} = shift(@ARGV) || 2	if $ARGV[0] =~ s/^--dbitrace=?//;
+
+require DBI::ProxyServer;
+
+# XXX these should probably be moved into DBI::ProxyServer
+delete $ENV{IFS};
+delete $ENV{CDPATH};
+delete $ENV{ENV};
+delete $ENV{BASH_ENV};
+
+if ($arg_test) {
+    require RPC::PlServer::Test;
+    @DBI::ProxyServer::ISA = qw(RPC::PlServer::Test DBI);
+}
+
+DBI::ProxyServer::main(@ARGV);
+
+exit(0);
+
+
+__END__
+
+=head1 NAME
+
+dbiproxy - A proxy server for the DBD::Proxy driver
+
+
+=head1 SYNOPSIS
+
+    dbiproxy <options> --localport=<port>
+
+
+=head1 DESCRIPTION
+
+This tool is just a front end for the DBI::ProxyServer package. All it
+does is picking options from the command line and calling
+DBI::ProxyServer::main(). See L<DBI::ProxyServer(3)> for details.
+
+Available options include:
+
+=over 4
+
+=item B<--chroot=dir>
+
+(UNIX only)  After doing a bind(), change root directory to the given
+directory by doing a chroot(). This is usefull for security, but it
+restricts the environment a lot. For example, you need to load DBI
+drivers in the config file or you have to create hard links to Unix
+sockets, if your drivers are using them. For example, with MySQL, a
+config file might contain the following lines:
+
+    my $rootdir = '/var/dbiproxy';
+    my $unixsockdir = '/tmp';
+    my $unixsockfile = 'mysql.sock';
+    foreach $dir ($rootdir, "$rootdir$unixsockdir") {
+	mkdir 0755, $dir;
+    }
+    link("$unixsockdir/$unixsockfile",
+	 "$rootdir$unixsockdir/$unixsockfile");
+    require DBD::mysql;
+
+    {
+	'chroot' => $rootdir,
+	...
+    }
+
+If you don't know chroot(), think of an FTP server where you can see a
+certain directory tree only after logging in. See also the --group and
+--user options.
+
+=item B<--configfile=file>
+
+Config files are assumed to return a single hash ref that overrides the
+arguments of the new method. However, command line arguments in turn take
+precedence over the config file. See the L<"CONFIGURATION FILE"> section
+below for details on the config file.
+
+=item B<--debug>
+
+Turn debugging mode on. Mainly this asserts that logging messages of
+level "debug" are created.
+
+=item B<--facility=mode>
+
+(UNIX only) Facility to use for L<Sys::Syslog (3)>. The default is
+B<daemon>.
+
+=item B<--group=gid>
+
+After doing a bind(), change the real and effective GID to the given.
+This is usefull, if you want your server to bind to a privileged port
+(<1024), but don't want the server to execute as root. See also
+the --user option.
+
+GID's can be passed as group names or numeric values.
+
+=item B<--localaddr=ip>
+
+By default a daemon is listening to any IP number that a machine
+has. This attribute allows to restrict the server to the given
+IP number.
+
+=item B<--localport=port>
+
+This attribute sets the port on which the daemon is listening. It
+must be given somehow, as there's no default.
+
+=item B<--logfile=file>
+
+Be default logging messages will be written to the syslog (Unix) or
+to the event log (Windows NT). On other operating systems you need to
+specify a log file. The special value "STDERR" forces logging to
+stderr. See L<Net::Daemon::Log(3)> for details.
+
+=item B<--mode=modename>
+
+The server can run in three different modes, depending on the environment.
+
+If you are running Perl 5.005 and did compile it for threads, then the
+server will create a new thread for each connection. The thread will
+execute the server's Run() method and then terminate. This mode is the
+default, you can force it with "--mode=threads".
+
+If threads are not available, but you have a working fork(), then the
+server will behave similar by creating a new process for each connection.
+This mode will be used automatically in the absence of threads or if
+you use the "--mode=fork" option.
+
+Finally there's a single-connection mode: If the server has accepted a
+connection, he will enter the Run() method. No other connections are
+accepted until the Run() method returns (if the client disconnects).
+This operation mode is usefull if you have neither threads nor fork(),
+for example on the Macintosh. For debugging purposes you can force this
+mode with "--mode=single".
+
+=item B<--pidfile=file>
+
+(UNIX only) If this option is present, a PID file will be created at the
+given location. Default is to not create a pidfile.
+
+=item B<--user=uid>
+
+After doing a bind(), change the real and effective UID to the given.
+This is usefull, if you want your server to bind to a privileged port
+(<1024), but don't want the server to execute as root. See also
+the --group and the --chroot options.
+
+UID's can be passed as group names or numeric values.
+
+=item B<--version>
+
+Supresses startup of the server; instead the version string will
+be printed and the program exits immediately.
+
+=back
+
+
+=head1 AUTHOR
+
+    Copyright (c) 1997    Jochen Wiedmann
+                          Am Eisteich 9
+                          72555 Metzingen
+                          Germany
+
+                          Email: joe@ispsoft.de
+                          Phone: +49 7123 14881
+
+The DBI::ProxyServer module is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself. In particular
+permission is granted to Tim Bunce for distributing this as a part of
+the DBI.
+
+
+=head1 SEE ALSO
+
+L<DBI::ProxyServer(3)>, L<DBD::Proxy(3)>, L<DBI(3)>
+

Perl/bin/dbiproxy.bat

@@ -0,0 +1,198 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+
+use strict;
+
+my $arg_test    = shift(@ARGV)		if $ARGV[0] eq '--test';
+$ENV{DBI_TRACE} = shift(@ARGV) || 2	if $ARGV[0] =~ s/^--dbitrace=?//;
+
+require DBI::ProxyServer;
+
+# XXX these should probably be moved into DBI::ProxyServer
+delete $ENV{IFS};
+delete $ENV{CDPATH};
+delete $ENV{ENV};
+delete $ENV{BASH_ENV};
+
+if ($arg_test) {
+    require RPC::PlServer::Test;
+    @DBI::ProxyServer::ISA = qw(RPC::PlServer::Test DBI);
+}
+
+DBI::ProxyServer::main(@ARGV);
+
+exit(0);
+
+
+__END__
+
+=head1 NAME
+
+dbiproxy - A proxy server for the DBD::Proxy driver
+
+
+=head1 SYNOPSIS
+
+    dbiproxy <options> --localport=<port>
+
+
+=head1 DESCRIPTION
+
+This tool is just a front end for the DBI::ProxyServer package. All it
+does is picking options from the command line and calling
+DBI::ProxyServer::main(). See L<DBI::ProxyServer(3)> for details.
+
+Available options include:
+
+=over 4
+
+=item B<--chroot=dir>
+
+(UNIX only)  After doing a bind(), change root directory to the given
+directory by doing a chroot(). This is usefull for security, but it
+restricts the environment a lot. For example, you need to load DBI
+drivers in the config file or you have to create hard links to Unix
+sockets, if your drivers are using them. For example, with MySQL, a
+config file might contain the following lines:
+
+    my $rootdir = '/var/dbiproxy';
+    my $unixsockdir = '/tmp';
+    my $unixsockfile = 'mysql.sock';
+    foreach $dir ($rootdir, "$rootdir$unixsockdir") {
+	mkdir 0755, $dir;
+    }
+    link("$unixsockdir/$unixsockfile",
+	 "$rootdir$unixsockdir/$unixsockfile");
+    require DBD::mysql;
+
+    {
+	'chroot' => $rootdir,
+	...
+    }
+
+If you don't know chroot(), think of an FTP server where you can see a
+certain directory tree only after logging in. See also the --group and
+--user options.
+
+=item B<--configfile=file>
+
+Config files are assumed to return a single hash ref that overrides the
+arguments of the new method. However, command line arguments in turn take
+precedence over the config file. See the L<"CONFIGURATION FILE"> section
+below for details on the config file.
+
+=item B<--debug>
+
+Turn debugging mode on. Mainly this asserts that logging messages of
+level "debug" are created.
+
+=item B<--facility=mode>
+
+(UNIX only) Facility to use for L<Sys::Syslog (3)>. The default is
+B<daemon>.
+
+=item B<--group=gid>
+
+After doing a bind(), change the real and effective GID to the given.
+This is usefull, if you want your server to bind to a privileged port
+(<1024), but don't want the server to execute as root. See also
+the --user option.
+
+GID's can be passed as group names or numeric values.
+
+=item B<--localaddr=ip>
+
+By default a daemon is listening to any IP number that a machine
+has. This attribute allows to restrict the server to the given
+IP number.
+
+=item B<--localport=port>
+
+This attribute sets the port on which the daemon is listening. It
+must be given somehow, as there's no default.
+
+=item B<--logfile=file>
+
+Be default logging messages will be written to the syslog (Unix) or
+to the event log (Windows NT). On other operating systems you need to
+specify a log file. The special value "STDERR" forces logging to
+stderr. See L<Net::Daemon::Log(3)> for details.
+
+=item B<--mode=modename>
+
+The server can run in three different modes, depending on the environment.
+
+If you are running Perl 5.005 and did compile it for threads, then the
+server will create a new thread for each connection. The thread will
+execute the server's Run() method and then terminate. This mode is the
+default, you can force it with "--mode=threads".
+
+If threads are not available, but you have a working fork(), then the
+server will behave similar by creating a new process for each connection.
+This mode will be used automatically in the absence of threads or if
+you use the "--mode=fork" option.
+
+Finally there's a single-connection mode: If the server has accepted a
+connection, he will enter the Run() method. No other connections are
+accepted until the Run() method returns (if the client disconnects).
+This operation mode is usefull if you have neither threads nor fork(),
+for example on the Macintosh. For debugging purposes you can force this
+mode with "--mode=single".
+
+=item B<--pidfile=file>
+
+(UNIX only) If this option is present, a PID file will be created at the
+given location. Default is to not create a pidfile.
+
+=item B<--user=uid>
+
+After doing a bind(), change the real and effective UID to the given.
+This is usefull, if you want your server to bind to a privileged port
+(<1024), but don't want the server to execute as root. See also
+the --group and the --chroot options.
+
+UID's can be passed as group names or numeric values.
+
+=item B<--version>
+
+Supresses startup of the server; instead the version string will
+be printed and the program exits immediately.
+
+=back
+
+
+=head1 AUTHOR
+
+    Copyright (c) 1997    Jochen Wiedmann
+                          Am Eisteich 9
+                          72555 Metzingen
+                          Germany
+
+                          Email: joe@ispsoft.de
+                          Phone: +49 7123 14881
+
+The DBI::ProxyServer module is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself. In particular
+permission is granted to Tim Bunce for distributing this as a part of
+the DBI.
+
+
+=head1 SEE ALSO
+
+L<DBI::ProxyServer(3)>, L<DBD::Proxy(3)>, L<DBI(3)>
+
+
+__END__
+:endofperl

Perl/bin/decode-base64

@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+use MIME::Base64 qw(decode_base64);
+
+while (<>) {
+    print decode_base64($_);
+}
+

Perl/bin/decode-base64.bat

@@ -0,0 +1,24 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl
+#line 15
+
+use MIME::Base64 qw(decode_base64);
+
+while (<>) {
+    print decode_base64($_);
+}
+
+
+__END__
+:endofperl

Perl/bin/decode-qp

@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+use MIME::QuotedPrint qw(decode_qp);
+
+while (<>) {
+    print decode_qp($_);
+}
+

Perl/bin/decode-qp.bat

@@ -0,0 +1,24 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl
+#line 15
+
+use MIME::QuotedPrint qw(decode_qp);
+
+while (<>) {
+    print decode_qp($_);
+}
+
+
+__END__
+:endofperl

Perl/bin/dprofpp.bat

@@ -0,0 +1,945 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec perl -S $0 "$@"'
+	if 0;
+
+require 5.003;
+
+my $VERSION = '20050603.00';
+my $stty    = undef;
+
+=head1 NAME
+
+dprofpp - display perl profile data
+
+=head1 SYNOPSIS
+
+dprofpp [B<-a>|B<-z>|B<-l>|B<-v>|B<-U>] [B<-d>] [B<-s>|B<-r>|B<-u>] [B<-q>] [B<-F>] [B<-I|-E>] [B<-O cnt>] [B<-A>] [B<-R>] [B<-S>] [B<-g subroutine>] [B<-G> <regexp> [B<-P>]] [B<-f> <regexp>] [profile]
+  
+dprofpp B<-T> [B<-F>] [B<-g subroutine>] [profile]
+
+dprofpp B<-t> [B<-F>] [B<-g subroutine>] [profile]
+
+dprofpp B<-G> <regexp> [B<-P>] [profile]
+ 
+dprofpp B<-p script> [B<-Q>] [other opts]
+
+dprofpp B<-V> [profile]
+
+=head1 DESCRIPTION
+
+The I<dprofpp> command interprets profile data produced by a profiler, such
+as the Devel::DProf profiler.  Dprofpp will read the file F<tmon.out> and
+display the 15 subroutines which are using the most time.  By default
+the times for each subroutine are given exclusive of the times of their
+child subroutines.
+
+To profile a Perl script run the perl interpreter with the B<-d> switch.  So
+to profile script F<test.pl> with Devel::DProf use the following:
+
+	$ perl5 -d:DProf test.pl
+
+Then run dprofpp to analyze the profile.  The output of dprofpp depends
+on the flags to the program and the version of Perl you're using.
+
+	$ dprofpp -u
+	Total Elapsed Time =    1.67 Seconds
+		 User Time =    0.61 Seconds
+	Exclusive Times
+	%Time Seconds     #Calls sec/call Name
+	 52.4   0.320          2   0.1600 main::foo
+	 45.9   0.280        200   0.0014 main::bar
+	 0.00   0.000          1   0.0000 DynaLoader::import
+	 0.00   0.000          1   0.0000 main::baz
+
+The dprofpp tool can also run the profiler before analyzing the profile
+data.  The above two commands can be executed with one dprofpp command.
+
+	$ dprofpp -u -p test.pl
+
+Consult L<Devel::DProf/"PROFILE FORMAT"> for a description of the raw profile.
+
+=head1 OUTPUT
+
+Columns are:
+
+=over 4
+
+=item %Time
+
+Percentage of time spent in this routine.
+
+=item #Calls
+
+Number of calls to this routine.
+
+=item sec/call
+
+Average number of seconds per call to this routine.
+
+=item Name
+
+Name of routine.
+
+=item CumulS
+
+Time (in seconds) spent in this routine and routines called from it.
+
+=item ExclSec
+
+Time (in seconds) spent in this routine (not including those called
+from it).
+
+=item Csec/c
+
+Average time (in seconds) spent in each call of this routine
+(including those called from it).
+
+=back
+
+=head1 OPTIONS
+
+=over 5
+
+=item B<-a>
+
+Sort alphabetically by subroutine names.
+
+=item B<-d>
+
+Reverse whatever sort is used
+
+=item B<-A>
+
+Count timing for autoloaded subroutine as timing for C<*::AUTOLOAD>.
+Otherwise the time to autoload it is counted as time of the subroutine
+itself (there is no way to separate autoload time from run time).
+
+This is going to be irrelevant with newer Perls.  They will inform
+C<Devel::DProf> I<when> the C<AUTOLOAD> switches to actual subroutine,
+so a separate statistics for C<AUTOLOAD> will be collected no matter
+whether this option is set.
+
+=item B<-R>
+
+Count anonymous subroutines defined in the same package separately.
+
+=item B<-E>
+
+(default)  Display all subroutine times exclusive of child subroutine times.
+
+=item B<-F>
+
+Force the generation of fake exit timestamps if dprofpp reports that the
+profile is garbled.  This is only useful if dprofpp determines that the
+profile is garbled due to missing exit timestamps.  You're on your own if
+you do this.  Consult the BUGS section.
+
+=item B<-I>
+
+Display all subroutine times inclusive of child subroutine times.
+
+=item B<-l>
+
+Sort by number of calls to the subroutines.  This may help identify
+candidates for inlining.
+
+=item B<-O cnt>
+
+Show only I<cnt> subroutines.  The default is 15.
+
+=item B<-p script>
+
+Tells dprofpp that it should profile the given script and then interpret its
+profile data.  See B<-Q>.
+
+=item B<-Q>
+
+Used with B<-p> to tell dprofpp to quit after profiling the script, without
+interpreting the data.
+
+=item B<-q>
+
+Do not display column headers.
+
+=item B<-r>
+
+Display elapsed real times rather than user+system times.
+
+=item B<-s>
+
+Display system times rather than user+system times.
+
+=item B<-T>
+
+Display subroutine call tree to stdout.  Subroutine statistics are
+not displayed.
+
+=item B<-t>
+
+Display subroutine call tree to stdout.  Subroutine statistics are not
+displayed.  When a function is called multiple consecutive times at the same
+calling level then it is displayed once with a repeat count.
+
+=item B<-S>
+
+Display I<merged> subroutine call tree to stdout.  Statistics are
+displayed for each branch of the tree.  
+
+When a function is called multiple (I<not necessarily consecutive>)
+times in the same branch then all these calls go into one branch of
+the next level.  A repeat count is output together with combined
+inclusive, exclusive and kids time.
+
+Branches are sorted with regard to inclusive time.
+
+=item B<-U>
+
+Do not sort.  Display in the order found in the raw profile.
+
+=item B<-u>
+
+Display user times rather than user+system times.
+
+=item B<-V>
+
+Print dprofpp's version number and exit.  If a raw profile is found then its
+XS_VERSION variable will be displayed, too.
+
+=item B<-v>
+
+Sort by average time spent in subroutines during each call.  This may help
+identify candidates for inlining. 
+
+=item B<-z>
+
+(default) Sort by amount of user+system time used.  The first few lines
+should show you which subroutines are using the most time.
+
+=item B<-g> C<subroutine>
+
+Ignore subroutines except C<subroutine> and whatever is called from it.
+
+=item B<-G> <regexp>
+
+Aggregate "Group" all calls matching the pattern together.
+For example this can be used to group all calls of a set of packages
+
+  -G "(package1::)|(package2::)|(package3::)"
+
+or to group subroutines by name:
+
+  -G "getNum"
+
+=item B<-P>
+
+Used with -G to aggregate "Pull" together all calls that did not match -G.
+
+=item B<-f> <regexp>
+
+Filter all calls matching the pattern.
+
+=item B<-h>
+
+Display brief help and exit.
+
+=item B<-H>
+
+Display long help and exit.
+
+=back
+
+=head1 ENVIRONMENT
+
+The environment variable B<DPROFPP_OPTS> can be set to a string containing
+options for dprofpp.  You might use this if you prefer B<-I> over B<-E> or
+if you want B<-F> on all the time.
+
+This was added fairly lazily, so there are some undesirable side effects.
+Options on the commandline should override options in DPROFPP_OPTS--but
+don't count on that in this version.
+
+=head1 BUGS
+
+Applications which call _exit() or exec() from within a subroutine
+will leave an incomplete profile.  See the B<-F> option.
+
+Any bugs in Devel::DProf, or any profiler generating the profile data, could
+be visible here.  See L<Devel::DProf/BUGS>.
+
+Mail bug reports and feature requests to the perl5-porters mailing list at
+F<E<lt>perl5-porters@perl.orgE<gt>>.  Bug reports should include the
+output of the B<-V> option.
+
+=head1 FILES
+
+	dprofpp		- profile processor
+	tmon.out	- raw profile
+
+=head1 SEE ALSO
+
+L<perl>, L<Devel::DProf>, times(2)
+
+=cut
+
+sub shortusage {
+    print <<'EOF';
+dprofpp [options] [profile]
+
+    -A          Count autoloaded to *AUTOLOAD
+    -a          Sort by alphabetic name of subroutines.
+    -d          Reverse sort
+    -E          Sub times are reported exclusive of child times. (default)
+    -f          Filter all calls mathcing the pattern.
+    -G          Group all calls matching the pattern together.
+    -g subr     Count only those who are SUBR or called from SUBR
+    -H          Display long manual page.
+    -h          Display this short usage message.
+    -I          Sub times are reported inclusive of child times.
+    -l          Sort by number of calls to subroutines.
+    -O cnt      Specifies maximum number of subroutines to display.
+    -P          Used with -G to pull all other calls together.
+    -p script   Specifies name of script to be profiled.
+    -Q          Used with -p to indicate the dprofpp should quit
+                after profiling the script, without interpreting the data.
+    -q          Do not print column headers.
+    -R          Count anonyms separately even if from the same package
+    -r          Use real elapsed time rather than user+system time.
+    -S          Create statistics for all the depths
+    -s          Use system time rather than user+system time.
+    -T          Show call tree.
+    -t          Show call tree, compressed.
+    -U          Do not sort subroutines.
+    -u          Use user time rather than user+system time.
+    -V          Print dprofpp's version.
+    -v          Sort by average amount of time spent in subroutines.
+    -z          Sort by user+system time spent in subroutines. (default)
+EOF
+}
+
+use Getopt::Std 'getopts';
+use Config '%Config';
+
+Setup: {
+	my $options = 'O:g:G:Pf:dlzaAvuTtqrRsUFEIp:QVShH';
+
+	$Monfile = 'tmon.out';
+	if( exists $ENV{DPROFPP_OPTS} ){
+		my @tmpargv = @ARGV;
+		@ARGV = split( ' ', $ENV{DPROFPP_OPTS} );
+		getopts( $options );
+		if( @ARGV ){
+			# there was a filename.
+			$Monfile = shift;
+		}
+		@ARGV = @tmpargv;
+	}
+
+	getopts( $options ) or die "Try 'dprofpp -h' for help.\n";
+	if( @ARGV ){
+		# there was a filename, it overrides any earlier name.
+		$Monfile = shift;
+	}
+
+        if ( defined $opt_h ) {
+                shortusage();
+                exit;
+        }
+        if ( defined $opt_H ) {
+                require Pod::Usage;
+                Pod::Usage::pod2usage( {-verbose => 2, -input => $0 } );
+                exit;
+        }
+
+	if( defined $opt_V ){
+		my $fh = 'main::fh';
+		print "$0 version: $VERSION\n";
+		open( $fh, "<$Monfile" ) && do {
+			local $XS_VERSION = 'early';
+			header($fh);
+			close( $fh );
+			print "XS_VERSION: $XS_VERSION\n";
+		};
+		exit(0);
+	}
+	$cnt = $opt_O || 15;
+	$sort = 'by_time';
+	$sort = 'by_ctime' if defined $opt_I;
+	$sort = 'by_calls' if defined $opt_l;
+	$sort = 'by_alpha' if defined $opt_a;
+	$sort = 'by_avgcpu' if defined $opt_v;
+	
+	if(defined $opt_d){
+		$sort = "r".$sort;
+	}
+	$incl_excl = 'Exclusive';
+	$incl_excl = 'Inclusive' if defined $opt_I;
+	$whichtime = 'User+System';
+	$whichtime = 'System' if defined $opt_s;
+	$whichtime = 'Real' if defined $opt_r;
+	$whichtime = 'User' if defined $opt_u;
+
+	if( defined $opt_p ){
+		my $prof = 'DProf';
+		my $startperl = $Config{'startperl'};
+
+		$startperl =~ s/^#!//; # remove shebang
+		run_profiler( $opt_p, $prof, $startperl );
+		$Monfile = 'tmon.out';  # because that's where it is
+		exit(0) if defined $opt_Q;
+	}
+	elsif( defined $opt_Q ){
+		die "-Q is meaningful only when used with -p\n";
+	}
+}
+
+Main: {
+	my $monout = $Monfile;
+	my $fh = 'main::fh';
+	local $names = {};
+	local $times = {};   # times in hz
+	local $ctimes = {};  # Cumulative times in hz
+	local $calls = {};
+	local $persecs = {}; # times in seconds
+	local $idkeys = [];
+	local $runtime; # runtime in seconds
+	my @a = ();
+	my $a;
+	local $rrun_utime = 0;	# user time in hz
+	local $rrun_stime = 0;	# system time in hz
+	local $rrun_rtime = 0;	# elapsed run time in hz
+	local $rrun_ustime = 0;	# user+system time in hz
+	local $hz = 0;
+	local $deep_times = {count => 0 , kids => {}, incl_time => 0};
+	local $time_precision = 2;
+	local $overhead = 0;
+
+	open( $fh, "<$monout" ) || die "Unable to open $monout\n";
+
+	header($fh);
+
+	$rrun_ustime = $rrun_utime + $rrun_stime;
+
+	$~ = 'STAT';
+	if( ! $opt_q ){
+		$^ = 'CSTAT_top';
+	}
+
+	parsestack( $fh, $names, $calls, $times, $ctimes, $idkeys );
+
+	#filter calls
+	if( $opt_f ){
+		for(my $i = 0;$i < @$idkeys - 2;){
+			$key = $$idkeys[$i];
+			if($key =~ /$opt_f/){
+				splice(@$idkeys, $i, 1);
+				$runtime -= $$times{$key};
+				next;
+			}
+			$i++;
+		}
+	}
+
+	if( $opt_G ){
+		group($names, $calls, $times, $ctimes, $idkeys );
+	}
+
+	settime( \$runtime, $hz ) unless $opt_g;
+
+	exit(0) if $opt_T || $opt_t;
+
+	if( $opt_v ){
+		percalc( $calls, ($opt_I ? $ctimes : $times), $persecs, $idkeys );
+	}
+	if( ! $opt_U ){
+		@a = sort $sort @$idkeys;
+		$a = \@a;
+	}
+	else {
+		$a = $idkeys;
+	}
+	display( $runtime, $hz, $names, $calls, $times, $ctimes, $cnt, $a,
+		 $deep_times);
+}
+
+sub group{
+	my ($names, $calls, $times, $ctimes, $idkeys ) = @_;
+		print "Option G Grouping: [$opt_G]\n";
+		# create entries to store grouping
+		$$names{$opt_G} = $opt_G;
+		$$calls{$opt_G} = 0;
+		$$times{$opt_G} = 0;
+		$$ctimes{$opt_G} = 0;
+		$$idkeys[@$idkeys] = $opt_G;
+		# Sum calls for the grouping
+
+		my $other = "other";
+		if($opt_P){
+			$$names{$other} = $other;
+			$$calls{$other} = 0;
+			$$times{$other} = 0;
+			$$ctimes{$other} = 0;
+			$$idkeys[@$idkeys] = $other;
+		}
+
+		for(my $i = 0;$i < @$idkeys - 2;){
+			$key = $$idkeys[$i];
+			if($key =~ /$opt_G/){
+				$$calls{$opt_G} += $$calls{$key};
+				$$times{$opt_G} += $$times{$key};
+				$$ctimes{$opt_G} += $$ctimes{$key};
+				splice(@$idkeys, $i, 1);
+				next;
+			}else{
+				if($opt_P){
+					$$calls{$other} += $$calls{$key};
+					$$times{$other} += $$times{$key};
+					$$ctimes{$other} += $$ctimes{$key};
+					splice(@$idkeys, $i, 1);
+					next;
+				}
+			}
+			$i++;
+		}
+		print "Grouping [$opt_G] Calls: [$$calls{$opt_G}]\n".
+			  "Grouping [$opt_G] Times: [$$times{$opt_G}]\n".
+			  "Grouping [$opt_G] IncTimes: [$$ctimes{$opt_G}]\n";
+}
+
+# Sets $runtime to user, system, real, or user+system time.  The
+# result is given in seconds.
+#
+sub settime {
+  my( $runtime, $hz ) = @_;
+
+  $hz ||= 1;
+  
+  if( $opt_r ){
+    $$runtime = ($rrun_rtime - $overhead)/$hz;
+  }
+  elsif( $opt_s ){
+    $$runtime = ($rrun_stime - $overhead)/$hz;
+  }
+  elsif( $opt_u ){
+    $$runtime = ($rrun_utime - $overhead)/$hz;
+  }
+  else{
+    $$runtime = ($rrun_ustime - $overhead)/$hz;
+  }
+  $$runtime = 0 unless $$runtime > 0;
+}
+
+sub exclusives_in_tree {
+  my( $deep_times ) = @_;
+  my $kids_time = 0;
+  my $kid;
+  # When summing, take into account non-rounded-up kids time.
+  for $kid (keys %{$deep_times->{kids}}) {
+    $kids_time += $deep_times->{kids}{$kid}{incl_time};
+  }
+  $kids_time = 0 unless $kids_time >= 0;
+  $deep_times->{excl_time} = $deep_times->{incl_time} - $kids_time;
+  $deep_times->{excl_time} = 0 unless $deep_times->{excl_time} >= 0;
+  for $kid (keys %{$deep_times->{kids}}) {
+    exclusives_in_tree($deep_times->{kids}{$kid});
+  }
+  $deep_times->{incl_time} = 0 unless $deep_times->{incl_time} >= 0;
+  $deep_times->{kids_time} = $kids_time;
+}
+
+sub kids_by_incl { $kids{$b}{incl_time} <=> $kids{$a}{excl_time} 
+		   or $a cmp $b }
+
+sub display_tree {
+  my( $deep_times, $name, $level ) = @_;
+  exclusives_in_tree($deep_times);
+  
+  my $kid;
+
+  my $time;
+  if (%{$deep_times->{kids}}) {
+    $time = sprintf '%.*fs = (%.*f + %.*f)', 
+      $time_precision, $deep_times->{incl_time}/$hz,
+        $time_precision, $deep_times->{excl_time}/$hz,
+          $time_precision, $deep_times->{kids_time}/$hz;
+  } else {
+    $time = sprintf '%.*f', $time_precision, $deep_times->{incl_time}/$hz;
+  }
+  print ' ' x (2*$level), "$name x $deep_times->{count}  \t${time}s\n"
+    if $deep_times->{count};
+
+  for $kid (sort kids_by_incl %{$deep_times->{kids}}) {
+    display_tree( $deep_times->{kids}{$kid}, $kid, $level + 1 );
+  }  
+}
+
+# Report the times in seconds.
+sub display {
+	my( $runtime, $hz, $names, $calls, $times, $ctimes, $cnt, 
+	    $idkeys, $deep_times ) = @_;
+	my( $x, $key, $s, $cs );
+	#format: $ncalls, $name, $secs, $percall, $pcnt
+
+	if ($opt_S) {
+	  display_tree( $deep_times, 'toplevel', -1 )
+	} else {
+	  for( $x = 0; $x < @$idkeys; ++$x ){
+	    $key = $idkeys->[$x];
+	    $ncalls = $calls->{$key};
+	    $name = $names->{$key};
+	    $s = $times->{$key}/$hz;
+	    $secs = sprintf("%.3f", $s );
+	    $cs = $ctimes->{$key}/$hz;
+	    $csecs = sprintf("%.3f", $cs );
+	    $percall = sprintf("%.4f", $s/$ncalls );
+	    $cpercall = sprintf("%.4f", $cs/$ncalls );
+	    $pcnt = sprintf("%.2f",
+			    $runtime? ((($opt_I ? $csecs : $secs) / $runtime) * 100.0): 0 );
+	    write;
+	    $pcnt = $secs = $ncalls = $percall = "";
+	    write while( length $name );
+	    last unless --$cnt;
+	  }	  
+	}
+}
+
+sub move_keys {
+  my ($source, $dest) = @_;
+
+  for my $kid_name (keys %$source) {
+    my $source_kid = delete $source->{$kid_name};
+
+    if (my $dest_kid = $dest->{$kid_name}) {
+      $dest_kid->{count} += $source_kid->{count};
+      $dest_kid->{incl_time} += $source_kid->{incl_time};
+      move_keys($source_kid->{kids},$dest_kid->{kids});
+    } else {
+      $dest->{$kid_name} = $source_kid;
+    }
+  }
+}
+
+sub add_to_tree {
+  my ($curdeep_times, $name, $t) = @_;
+  if ($name ne $curdeep_times->[-1]{name} and $opt_A) {
+    $name = $curdeep_times->[-1]{name};
+  }
+  die "Shorted?!" unless @$curdeep_times >= 2;
+  my $entry = $curdeep_times->[-2]{kids}{$name} ||= {
+    count => 0,
+    kids => {}, 
+    incl_time => 0,
+  };
+  # Now transfer to the new node (could not do earlier, since name can change)
+  $entry->{count}++;
+  $entry->{incl_time} += $t - $curdeep_times->[-1]{enter_stamp};
+  # Merge the kids?
+  move_keys($curdeep_times->[-1]->{kids},$entry->{kids});
+  pop @$curdeep_times;
+}
+
+
+sub parsestack {
+	my( $fh, $names, $calls, $times, $ctimes, $idkeys ) = @_;
+	my( $dir, $name );
+	my( $t, $syst, $realt, $usert );
+	my( $x, $z, $c, $id, $pack );
+	my @stack = ();
+	my @tstack = ();
+	my %outer;
+	my $tab = 3;
+	my $in = 0;
+
+	# remember last call depth and function name
+	my $l_in = $in;
+	my $l_name = '';
+	my $repcnt = 0;
+	my $repstr = '';
+	my $dprof_stamp;
+	my %cv_hash;
+	my $in_level = not defined $opt_g; # Level deep in report grouping
+	my $curdeep_times = [$deep_times];
+
+	my $over_per_call;
+	if   ( $opt_u )	{	$over_per_call = $over_utime		}
+	elsif( $opt_s )	{	$over_per_call = $over_stime		}
+	elsif( $opt_r )	{	$over_per_call = $over_rtime		}
+	else		{	$over_per_call = $over_utime + $over_stime }
+	$over_per_call /= 2*$over_tests; # distribute over entry and exit
+
+	while(<$fh>){
+		next if /^#/;
+		last if /^PART/;
+
+		chop;
+		if (/^&/) {
+		  ($dir, $id, $pack, $name) = split;
+		  if ($opt_R and ($name =~ /(?:::)?(__ANON__|END)$/)) {
+		    $name .= "($id)";
+		  }
+		  $cv_hash{$id} = "$pack\::$name";
+		  next;
+		}
+		($dir, $usert, $syst, $realt, $name) = split;
+
+		my $ot = $t;
+		if ( $dir eq '/' ) {
+		  $syst = $stack[-1][0] if scalar @stack;
+		  $usert = '&';
+		  $dir = '-';
+		  #warn("Inserted exit for $stack[-1][0].\n")
+		}
+		if (defined $realt) { # '+ times nam' '- times nam' or '@ incr'
+		  if   ( $opt_u )	{	$t = $usert		}
+		  elsif( $opt_s )	{	$t = $syst		}
+		  elsif( $opt_r )	{	$t = $realt		}
+		  else			{	$t = $usert + $syst	}
+		  $t += $ot, next if $dir eq '@'; # Increments there
+		} else {
+		  # "- id" or "- & name"
+		  $name = defined $syst ? $syst : $cv_hash{$usert};
+		}
+
+		next unless $in_level or $name eq $opt_g;
+		if ( $dir eq '-' or $dir eq '*' ) {
+		  	my $ename = $dir eq '*' ? $stack[-1][0]  : $name;
+			$overhead += $over_per_call;
+		  	if ($name eq "Devel::DProf::write") {
+			  $overhead += $t - $dprof_stamp;
+			  next;
+		  	} elsif (defined $opt_g and $ename eq $opt_g) {
+			  $in_level--;
+			}
+			add_to_tree($curdeep_times, $ename,
+				    $t - $overhead) if $opt_S;
+			exitstamp( \@stack, \@tstack,
+				   $t - $overhead,
+				   $times, $ctimes, $name, \$in, $tab,
+				   $curdeep_times, \%outer );
+		} 
+		next unless $in_level or $name eq $opt_g;
+		if( $dir eq '+' or $dir eq '*' ){
+		  	if ($name eq "Devel::DProf::write") {
+			  $dprof_stamp = $t;
+			  next;
+		  	} elsif (defined $opt_g and $name eq $opt_g) {
+			  $in_level++;
+		  	}
+			$overhead += $over_per_call;
+			if( $opt_T ){
+				print ' ' x $in, "$name\n";
+				$in += $tab;
+			}
+			elsif( $opt_t ){
+				# suppress output on same function if the
+				# same calling level is called.
+				if ($l_in == $in and $l_name eq $name) {
+					$repcnt++;
+				} else {
+					$repstr = ' ('.++$repcnt.'x)'
+						 if $repcnt;
+					print ' ' x $l_in, "$l_name$repstr\n"
+						if $l_name ne '';
+					$repstr = '';
+					$repcnt = 0;
+					$l_in = $in;
+					$l_name = $name;
+				}
+				$in += $tab;
+			}
+			if( ! defined $names->{$name} ){
+				$names->{$name} = $name;
+				$times->{$name} = 0;
+				$ctimes->{$name} = 0;
+				push( @$idkeys, $name );
+			}
+			$calls->{$name}++;
+                        $outer{$name}++;
+			push @$curdeep_times, { kids => {}, 
+						name => $name, 
+						enter_stamp => $t - $overhead,
+					      } if $opt_S;
+			$x = [ $name, $t - $overhead ];
+			push( @stack, $x );
+
+			# my children will put their time here
+			push( @tstack, 0 );
+		} elsif ($dir ne '-'){
+		    die "Bad profile: $_";
+	        }
+	}
+	if( $opt_t ){
+		$repstr = ' ('.++$repcnt.'x)' if $repcnt;
+		print ' ' x $l_in, "$l_name$repstr\n";
+	}
+
+        while (my ($key, $count) = each %outer) {
+            next unless $count;
+            warn "$key has $count unstacked calls in outer\n";
+        }
+
+	if( @stack ){
+		if( ! $opt_F ){
+			warn "Garbled profile is missing some exit time stamps:\n";
+			foreach $x (@stack) {
+				print $x->[0],"\n";
+			}
+			die "Try rerunning dprofpp with -F.\n";
+			# I don't want -F to be default behavior--yet
+			#  9/18/95 dmr
+		}
+		else{
+			warn( "Faking " . scalar( @stack ) . " exit timestamp(s).\n");
+			foreach $x ( reverse @stack ){
+				$name = $x->[0];
+				exitstamp( \@stack, \@tstack, 
+					   $t - $overhead, $times, 
+					   $ctimes, $name, \$in, $tab, 
+					   $curdeep_times, \%outer );
+				add_to_tree($curdeep_times, $name,
+					    $t - $overhead)
+				  if $opt_S;
+			}
+		}
+	}
+	if (defined $opt_g) {
+	  $runtime = $ctimes->{$opt_g}/$hz;
+	  $runtime = 0 unless $runtime > 0;
+	}
+}
+
+sub exitstamp {
+	my($stack, $tstack, $t, $times, $ctimes, $name, $in, $tab, $deep, $outer) = @_;
+	my( $x, $c, $z );
+
+	$x = pop( @$stack );
+	if( ! defined $x ){
+		die "Garbled profile, missing an enter time stamp";
+	}
+	if( $x->[0] ne $name and $opt_G and ($name =~ /$opt_G/)){
+	  if ($x->[0] =~ /(?:::)?AUTOLOAD$/) {
+	    if ($opt_A) {
+	      $name = $x->[0];
+	    }
+	  } elsif ( $opt_F ) {
+	    warn( "Garbled profile, faking exit timestamp:\n\t$name => $x->[0].\n");
+	    $name = $x->[0];
+	  } else {
+	    foreach $z (@stack, $x) {
+	      print $z->[0],"\n";
+	    }
+	    die "Garbled profile, unexpected exit time stamp";
+	  }
+	}
+	if( $opt_T || $opt_t ){
+		$$in -= $tab;
+	}
+	# collect childtime
+	$c = pop( @$tstack );
+	# total time this func has been active
+	$z = $t - $x->[1];
+	$ctimes->{$name} += $z
+            unless --$outer->{$name};
+	$times->{$name} += $z - $c;
+	# pass my time to my parent
+	if( @$tstack ){
+		$c = pop( @$tstack );
+		push( @$tstack, $c + $z );
+	}
+}
+
+
+sub header {
+	my $fh = shift;
+	chop($_ = <$fh>);
+	if( ! /^#fOrTyTwO$/ ){
+		die "Not a perl profile";
+	}
+	while(<$fh>){
+		next if /^#/;
+		last if /^PART/;
+		eval;
+	}
+	$over_tests = 1 unless $over_tests;
+	$time_precision = length int ($hz - 1);	# log ;-)
+}
+
+
+# Report avg time-per-function in seconds
+sub percalc {
+	my( $calls, $times, $persecs, $idkeys ) = @_;
+	my( $x, $t, $n, $key );
+
+	for( $x = 0; $x < @$idkeys; ++$x ){
+		$key = $idkeys->[$x];
+		$n = $calls->{$key};
+		$t = $times->{$key} / $hz;
+		$persecs->{$key} = $t ? $t / $n : 0;
+	}
+}
+
+
+# Runs the given script with the given profiler and the given perl.
+sub run_profiler {
+	my $script = shift;
+	my $profiler = shift;
+	my $startperl = shift;
+	my @script_parts = split /\s+/, $script;
+
+	system $startperl, "-d:$profiler", @script_parts;
+	if( $? / 256 > 0 ){
+		my $cmd = join ' ', @script_parts;
+		die "Failed: $startperl -d:$profiler $cmd: $!";
+	}
+}
+
+
+sub by_time { $times->{$b} <=> $times->{$a} }
+sub by_ctime { $ctimes->{$b} <=> $ctimes->{$a} }
+sub by_calls { $calls->{$b} <=> $calls->{$a} }
+sub by_alpha { $names->{$a} cmp $names->{$b} }
+sub by_avgcpu { $persecs->{$b} <=> $persecs->{$a} }
+# Reversed
+sub rby_time { $times->{$a} <=> $times->{$b} }
+sub rby_ctime { $ctimes->{$a} <=> $ctimes->{$b} }
+sub rby_calls { $calls->{$a} <=> $calls->{$b} }
+sub rby_alpha { $names->{$b} cmp $names->{$a} }
+sub rby_avgcpu { $persecs->{$a} <=> $persecs->{$b} }
+
+
+format CSTAT_top =
+Total Elapsed Time = @>>>>>>> Seconds
+(($rrun_rtime - $overhead) / $hz)
+  @>>>>>>>>>> Time = @>>>>>>> Seconds
+$whichtime, $runtime
+@<<<<<<<< Times
+$incl_excl
+%Time ExclSec CumulS #Calls sec/call Csec/c  Name
+.
+
+BEGIN {
+    my $fmt = ' ^>>>   ^>>>> ^>>>>> ^>>>>>   ^>>>>> ^>>>>>  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<';
+    if (-t STDOUT and defined $stty and my ($cols) = `$stty -a` =~ /\bcolumns\s+(\d+)/)
+    {
+	$fmt .= '<' x ($cols - length $fmt) if $cols > 80;
+    }
+
+    eval "format STAT = \n$fmt" . '
+$pcnt, $secs, $csecs, $ncalls, $percall, $cpercall, $name
+.';
+}
+
+__END__
+:endofperl

Perl/bin/encode-base64

@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+use MIME::Base64 qw(encode_base64);
+
+my $buf = "";
+while (<>) {
+    $buf .= $_;
+    if (length($buf) >= 57) {
+	print encode_base64(substr($buf, 0, int(length($buf) / 57) * 57, ""));
+    }
+}
+
+print encode_base64($buf);

Perl/bin/encode-base64.bat

@@ -0,0 +1,29 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl
+#line 15
+
+use MIME::Base64 qw(encode_base64);
+
+my $buf = "";
+while (<>) {
+    $buf .= $_;
+    if (length($buf) >= 57) {
+	print encode_base64(substr($buf, 0, int(length($buf) / 57) * 57, ""));
+    }
+}
+
+print encode_base64($buf);
+
+__END__
+:endofperl

Perl/bin/encode-qp

@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+use MIME::QuotedPrint qw(encode_qp);
+
+while (<>) {
+    print encode_qp($_);
+}
+

Perl/bin/encode-qp.bat

@@ -0,0 +1,24 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl
+#line 15
+
+use MIME::QuotedPrint qw(encode_qp);
+
+while (<>) {
+    print encode_qp($_);
+}
+
+
+__END__
+:endofperl

Perl/bin/exetype.bat

@@ -0,0 +1,124 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl -w
+#line 15
+use strict;
+
+# All the IMAGE_* structures are defined in the WINNT.H file
+# of the Microsoft Platform SDK.
+
+my %subsys = (NATIVE    => 1,
+              WINDOWS   => 2,
+              CONSOLE   => 3,
+              POSIX     => 7,
+              WINDOWSCE => 9);
+
+unless (0 < @ARGV && @ARGV < 3) {
+    printf "Usage: $0 exefile [%s]\n", join '|', sort keys %subsys;
+    exit;
+}
+
+$ARGV[1] = uc $ARGV[1] if $ARGV[1];
+unless (@ARGV == 1 || defined $subsys{$ARGV[1]}) {
+    (my $subsys = join(', ', sort keys %subsys)) =~ s/, (\w+)$/ or $1/;
+    print "Invalid subsystem $ARGV[1], please use $subsys\n";
+    exit;
+}
+
+my ($record,$magic,$signature,$offset,$size);
+open EXE, "+< $ARGV[0]" or die "Cannot open $ARGV[0]: $!\n";
+binmode EXE;
+
+# read IMAGE_DOS_HEADER structure
+read EXE, $record, 64;
+($magic,$offset) = unpack "Sx58L", $record;
+
+die "$ARGV[0] is not an MSDOS executable file.\n"
+    unless $magic == 0x5a4d; # "MZ"
+
+# read signature, IMAGE_FILE_HEADER and first WORD of IMAGE_OPTIONAL_HEADER
+seek EXE, $offset, 0;
+read EXE, $record, 4+20+2;
+($signature,$size,$magic) = unpack "Lx16Sx2S", $record;
+
+die "PE header not found" unless $signature == 0x4550; # "PE\0\0"
+
+die "Optional header is neither in NT32 nor in NT64 format"
+    unless ($size == 224 && $magic == 0x10b) || # IMAGE_NT_OPTIONAL_HDR32_MAGIC
+           ($size == 240 && $magic == 0x20b);   # IMAGE_NT_OPTIONAL_HDR64_MAGIC
+
+# Offset 68 in the IMAGE_OPTIONAL_HEADER(32|64) is the 16 bit subsystem code
+seek EXE, $offset+4+20+68, 0;
+if (@ARGV == 1) {
+    read EXE, $record, 2;
+    my ($subsys) = unpack "S", $record;
+    $subsys = {reverse %subsys}->{$subsys} || "UNKNOWN($subsys)";
+    print "$ARGV[0] uses the $subsys subsystem.\n";
+}
+else {
+    print EXE pack "S", $subsys{$ARGV[1]};
+}
+close EXE;
+__END__
+
+=head1 NAME
+
+exetype - Change executable subsystem type between "Console" and "Windows"
+
+=head1 SYNOPSIS
+
+	C:\perl\bin> copy perl.exe guiperl.exe
+	C:\perl\bin> exetype guiperl.exe windows
+
+=head1 DESCRIPTION
+
+This program edits an executable file to indicate which subsystem the
+operating system must invoke for execution.
+
+You can specify any of the following subsystems:
+
+=over
+
+=item CONSOLE
+
+The CONSOLE subsystem handles a Win32 character-mode application that
+use a console supplied by the operating system.
+
+=item WINDOWS
+
+The WINDOWS subsystem handles an application that does not require a
+console and creates its own windows, if required.
+
+=item NATIVE
+
+The NATIVE subsystem handles a Windows NT device driver.
+
+=item WINDOWSCE
+
+The WINDOWSCE subsystem handles Windows CE consumer electronics
+applications.
+
+=item POSIX
+
+The POSIX subsystem handles a POSIX application in Windows NT.
+
+=back
+
+=head1 AUTHOR
+
+Jan Dubois <jand@activestate.com>
+
+=cut
+
+__END__
+:endofperl

Perl/bin/find2perl.bat

@@ -0,0 +1,909 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+      if $running_under_some_shell;
+(my $perlpath = <<'/../') =~ s/\s*\z//;
+C:\Perl\bin\perl.exe
+/../
+use strict;
+use vars qw/$statdone/;
+use File::Spec::Functions 'curdir';
+my $startperl = "#! $perlpath -w";
+
+#
+# Modified September 26, 1993 to provide proper handling of years after 1999
+#   Tom Link <tml+@pitt.edu>
+#   University of Pittsburgh
+#
+# Modified April 7, 1998 with nasty hacks to implement the troublesome -follow
+#  Billy Constantine <wdconsta@cs.adelaide.edu.au> <billy@smug.adelaide.edu.au>
+#  University of Adelaide, Adelaide, South Australia
+#
+# Modified 1999-06-10, 1999-07-07 to migrate to cleaner perl5 usage
+#   Ken Pizzini <ken@halcyon.com>
+#
+# Modified 2000-01-28 to use the 'follow' option of File::Find
+
+sub tab ();
+sub n ($$);
+sub fileglob_to_re ($);
+sub quote ($);
+
+my @roots = ();
+while ($ARGV[0] =~ /^[^-!(]/) {
+    push(@roots, shift);
+}
+@roots = (curdir()) unless @roots;
+for (@roots) { $_ = quote($_) }
+my $roots = join(', ', @roots);
+
+my $find = "find";
+my $indent_depth = 1;
+my $stat = 'lstat';
+my $decl = '';
+my $flushall = '';
+my $initfile = '';
+my $initnewer = '';
+my $out = '';
+my $declaresubs = "sub wanted;\n";
+my %init = ();
+my ($follow_in_effect,$Skip_And) = (0,0);
+my $print_needed = 1;
+
+while (@ARGV) {
+    $_ = shift;
+    s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
+    if ($_ eq '(') {
+        $out .= tab . "(\n";
+        $indent_depth++;
+        next;
+    } elsif ($_ eq ')') {
+        --$indent_depth;
+        $out .= tab . ")";
+    } elsif ($_ eq 'follow') {
+        $follow_in_effect= 1;
+        $stat = 'stat';
+        $Skip_And= 1;
+    } elsif ($_ eq '!') {
+        $out .= tab . "!";
+        next;
+    } elsif (/^(i)?name$/) {
+        $out .= tab . '/' . fileglob_to_re(shift) . "/s$1";
+    } elsif (/^(i)?path$/) {
+        $out .= tab . '$File::Find::name =~ /' . fileglob_to_re(shift) . "/s$1";
+    } elsif ($_ eq 'perm') {
+        my $onum = shift;
+        $onum =~ /^-?[0-7]+$/
+            || die "Malformed -perm argument: $onum\n";
+        $out .= tab;
+        if ($onum =~ s/^-//) {
+            $onum = sprintf("0%o", oct($onum) & 07777);
+            $out .= "((\$mode & $onum) == $onum)";
+        } else {
+            $onum =~ s/^0*/0/;
+            $out .= "((\$mode & 0777) == $onum)";
+        }
+    } elsif ($_ eq 'type') {
+        (my $filetest = shift) =~ tr/s/S/;
+        $out .= tab . "-$filetest _";
+    } elsif ($_ eq 'print') {
+        $out .= tab . 'print("$name\n")';
+	$print_needed = 0;
+    } elsif ($_ eq 'print0') {
+        $out .= tab . 'print("$name\0")';
+	$print_needed = 0;
+    } elsif ($_ eq 'fstype') {
+        my $type = shift;
+        $out .= tab;
+        if ($type eq 'nfs') {
+            $out .= '($dev < 0)';
+        } else {
+            $out .= '($dev >= 0)'; #XXX
+        }
+    } elsif ($_ eq 'user') {
+        my $uname = shift;
+        $out .= tab . "(\$uid == \$uid{'$uname'})";
+        $init{user} = 1;
+    } elsif ($_ eq 'group') {
+        my $gname = shift;
+        $out .= tab . "(\$gid == \$gid{'$gname'})";
+        $init{group} = 1;
+    } elsif ($_ eq 'nouser') {
+        $out .= tab . '!exists $uid{$uid}';
+        $init{user} = 1;
+    } elsif ($_ eq 'nogroup') {
+        $out .= tab . '!exists $gid{$gid}';
+        $init{group} = 1;
+    } elsif ($_ eq 'links') {
+        $out .= tab . n('$nlink', shift);
+    } elsif ($_ eq 'inum') {
+        $out .= tab . n('$ino', shift);
+    } elsif ($_ eq 'size') {
+        $_ = shift;
+        my $n = 'int(((-s _) + 511) / 512)';
+        if (s/c\z//) {
+            $n = 'int(-s _)';
+        } elsif (s/k\z//) {
+            $n = 'int(((-s _) + 1023) / 1024)';
+        }
+        $out .= tab . n($n, $_);
+    } elsif ($_ eq 'atime') {
+        $out .= tab . n('int(-A _)', shift);
+    } elsif ($_ eq 'mtime') {
+        $out .= tab . n('int(-M _)', shift);
+    } elsif ($_ eq 'ctime') {
+        $out .= tab . n('int(-C _)', shift);
+    } elsif ($_ eq 'exec') {
+        my @cmd = ();
+        while (@ARGV && $ARGV[0] ne ';')
+            { push(@cmd, shift) }
+        shift;
+        $out .= tab;
+        if ($cmd[0] =~m#^(?:(?:/usr)?/bin/)?rm$#
+                && $cmd[$#cmd] eq '{}'
+                && (@cmd == 2 || (@cmd == 3 && $cmd[1] eq '-f'))) {
+            if (@cmd == 2) {
+                $out .= '(unlink($_) || warn "$name: $!\n")';
+            } elsif (!@ARGV) {
+                $out .= 'unlink($_)';
+            } else {
+                $out .= '(unlink($_) || 1)';
+            }
+        } else {
+            for (@cmd)
+                { s/'/\\'/g }
+            { local $" = "','"; $out .= "doexec(0, '@cmd')"; }
+            $declaresubs .= "sub doexec (\$\@);\n";
+            $init{doexec} = 1;
+        }
+	$print_needed = 0;
+    } elsif ($_ eq 'ok') {
+        my @cmd = ();
+        while (@ARGV && $ARGV[0] ne ';')
+            { push(@cmd, shift) }
+        shift;
+        $out .= tab;
+        for (@cmd)
+            { s/'/\\'/g }
+        { local $" = "','"; $out .= "doexec(1, '@cmd')"; }
+        $declaresubs .= "sub doexec (\$\@);\n";
+        $init{doexec} = 1;
+	$print_needed = 0;
+    } elsif ($_ eq 'prune') {
+        $out .= tab . '($File::Find::prune = 1)';
+    } elsif ($_ eq 'xdev') {
+        $out .= tab . '!($File::Find::prune |= ($dev != $File::Find::topdev))'
+;
+    } elsif ($_ eq 'newer') {
+        my $file = shift;
+        my $newername = 'AGE_OF' . $file;
+        $newername =~ s/\W/_/g;
+        $newername = '$' . $newername;
+        $out .= tab . "(-M _ < $newername)";
+        $initnewer .= "my $newername = -M " . quote($file) . ";\n";
+    } elsif ($_ eq 'eval') {
+        my $prog = shift;
+        $prog =~ s/'/\\'/g;
+        $out .= tab . "eval {$prog}";
+	$print_needed = 0;
+    } elsif ($_ eq 'depth') {
+        $find = 'finddepth';
+        next;
+    } elsif ($_ eq 'ls') {
+        $out .= tab . "ls";
+        $declaresubs .= "sub ls ();\n";
+        $init{ls} = 1;
+	$print_needed = 0;
+    } elsif ($_ eq 'tar') {
+        die "-tar must have a filename argument\n" unless @ARGV;
+        my $file = shift;
+        my $fh = 'FH' . $file;
+        $fh =~ s/\W/_/g;
+        $out .= tab . "tar(*$fh, \$name)";
+        $flushall .= "tflushall;\n";
+        $declaresubs .= "sub tar;\nsub tflushall ();\n";
+        $initfile .= "open($fh, " . quote('> ' . $file) .
+                     qq{) || die "Can't open $fh: \$!\\n";\n};
+        $init{tar} = 1;
+    } elsif (/^(n?)cpio\z/) {
+        die "-$_ must have a filename argument\n" unless @ARGV;
+        my $file = shift;
+        my $fh = 'FH' . $file;
+        $fh =~ s/\W/_/g;
+        $out .= tab . "cpio(*$fh, \$name, '$1')";
+        $find = 'finddepth';
+        $flushall .= "cflushall;\n";
+        $declaresubs .= "sub cpio;\nsub cflushall ();\n";
+        $initfile .= "open($fh, " . quote('> ' . $file) .
+                     qq{) || die "Can't open $fh: \$!\\n";\n};
+        $init{cpio} = 1;
+    } else {
+        die "Unrecognized switch: -$_\n";
+    }
+
+    if (@ARGV) {
+        if ($ARGV[0] eq '-o') {
+            { local($statdone) = 1; $out .= "\n" . tab . "||\n"; }
+            $statdone = 0 if $indent_depth == 1 && exists $init{delayedstat};
+            $init{saw_or} = 1;
+            shift;
+        } else {
+            $out .= " &&" unless $Skip_And || $ARGV[0] eq ')';
+            $out .= "\n";
+            shift if $ARGV[0] eq '-a';
+        }
+    }
+}
+
+if ($print_needed) {
+    my $t = tab;
+    if ($t !~ /&&\s*$/) { $t .= '&& ' }
+    $out .= "\n" . $t . 'print("$name\n")';
+}
+
+
+print <<"END";
+$startperl
+    eval 'exec $perlpath -S \$0 \${1+"\$@"}'
+        if 0; #\$running_under_some_shell
+
+use strict;
+use File::Find ();
+
+# Set the variable \$File::Find::dont_use_nlink if you're using AFS,
+# since AFS cheats.
+
+# for the convenience of &wanted calls, including -eval statements:
+use vars qw/*name *dir *prune/;
+*name   = *File::Find::name;
+*dir    = *File::Find::dir;
+*prune  = *File::Find::prune;
+
+$declaresubs
+
+END
+
+if (exists $init{doexec}) {
+    print <<'END';
+use Cwd ();
+my $cwd = Cwd::cwd();
+
+END
+}  
+
+if (exists $init{ls}) {
+    print <<'END';
+my @rwx = qw(--- --x -w- -wx r-- r-x rw- rwx);
+my @moname = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
+
+END
+}
+
+if (exists $init{user} || exists $init{ls} || exists $init{tar}) {
+    print "my (%uid, %user);\n";
+    print "while (my (\$name, \$pw, \$uid) = getpwent) {\n";
+    print '    $uid{$name} = $uid{$uid} = $uid;', "\n"
+        if exists $init{user};
+    print '    $user{$uid} = $name unless exists $user{$uid};', "\n"
+        if exists $init{ls} || exists $init{tar};
+    print "}\n\n";
+}
+
+if (exists $init{group} || exists $init{ls} || exists $init{tar}) {
+    print "my (%gid, %group);\n";
+    print "while (my (\$name, \$pw, \$gid) = getgrent) {\n";
+    print '    $gid{$name} = $gid{$gid} = $gid;', "\n"
+        if exists $init{group};
+    print '    $group{$gid} = $name unless exists $group{$gid};', "\n"
+        if exists $init{ls} || exists $init{tar};
+    print "}\n\n";
+}
+
+print $initnewer, "\n" if $initnewer ne '';
+print $initfile, "\n" if $initfile ne '';
+$flushall .= "exit;\n";
+if (exists $init{declarestat}) {
+    $out = <<'END' . $out;
+    my ($dev,$ino,$mode,$nlink,$uid,$gid);
+
+END
+}
+
+if ( $follow_in_effect ) {
+$out =~ s/lstat\(\$_\)/lstat(_)/;
+print <<"END";
+$decl
+# Traverse desired filesystems
+File::Find::$find( {wanted => \\&wanted, follow => 1}, $roots);
+$flushall
+
+sub wanted {
+$out;
+}
+
+END
+} else {
+print <<"END";
+$decl
+# Traverse desired filesystems
+File::Find::$find({wanted => \\&wanted}, $roots);
+$flushall
+
+sub wanted {
+$out;
+}
+
+END
+}
+
+if (exists $init{doexec}) {
+    print <<'END';
+
+sub doexec ($@) {
+    my $ok = shift;
+    my @command = @_; # copy so we don't try to s/// aliases to constants
+    for my $word (@command)
+        { $word =~ s#{}#$name#g }
+    if ($ok) {
+        my $old = select(STDOUT);
+        $| = 1;
+        print "@command";
+        select($old);
+        return 0 unless <STDIN> =~ /^y/;
+    }
+    chdir $cwd; #sigh
+    system @command;
+    chdir $File::Find::dir;
+    return !$?;
+}
+
+END
+}
+
+if (exists $init{ls}) {
+    print <<'INTRO', <<"SUB", <<'END';
+
+sub sizemm {
+    my $rdev = shift;
+    sprintf("%3d, %3d", ($rdev >> 8) & 0xff, $rdev & 0xff);
+}
+
+sub ls () {
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+INTRO
+        \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
+SUB
+    my $pname = $name;
+
+    $blocks
+        or $blocks = int(($size + 1023) / 1024);
+
+    my $perms = $rwx[$mode & 7];
+    $mode >>= 3;
+    $perms = $rwx[$mode & 7] . $perms;
+    $mode >>= 3;
+    $perms = $rwx[$mode & 7] . $perms;
+    substr($perms, 2, 1) =~ tr/-x/Ss/ if -u _;
+    substr($perms, 5, 1) =~ tr/-x/Ss/ if -g _;
+    substr($perms, 8, 1) =~ tr/-x/Tt/ if -k _;
+    if    (-f _) { $perms = '-' . $perms; }
+    elsif (-d _) { $perms = 'd' . $perms; }
+    elsif (-l _) { $perms = 'l' . $perms; $pname .= ' -> ' . readlink($_); }
+    elsif (-c _) { $perms = 'c' . $perms; $size = sizemm($rdev); }
+    elsif (-b _) { $perms = 'b' . $perms; $size = sizemm($rdev); }
+    elsif (-p _) { $perms = 'p' . $perms; }
+    elsif (-S _) { $perms = 's' . $perms; }
+    else         { $perms = '?' . $perms; }
+
+    my $user = $user{$uid} || $uid;
+    my $group = $group{$gid} || $gid;
+
+    my ($sec,$min,$hour,$mday,$mon,$timeyear) = localtime($mtime);
+    if (-M _ > 365.25 / 2) {
+        $timeyear += 1900;
+    } else {
+        $timeyear = sprintf("%02d:%02d", $hour, $min);
+    }
+
+    printf "%5lu %4ld %-10s %3d %-8s %-8s %8s %s %2d %5s %s\n",
+            $ino,
+                 $blocks,
+                      $perms,
+                            $nlink,
+                                $user,
+                                     $group,
+                                          $size,
+                                              $moname[$mon],
+                                                 $mday,
+                                                     $timeyear,
+                                                         $pname;
+    1;
+}
+
+END
+}
+
+
+if (exists $init{cpio} || exists $init{tar}) {
+print <<'END';
+
+my %blocks = ();
+
+sub flush {
+    my ($fh, $varref, $blksz) = @_;
+
+    while (length($$varref) >= $blksz) {
+        no strict qw/refs/;
+        syswrite($fh, $$varref, $blksz);
+        substr($$varref, 0, $blksz) = '';
+        ++$blocks{$fh};
+    }
+}
+
+END
+}
+
+
+if (exists $init{cpio}) {
+    print <<'INTRO', <<"SUB", <<'END';
+
+my %cpout = ();
+my %nc = ();
+
+sub cpio {
+    my ($fh, $fname, $nc) = @_;
+    my $text = '';
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+        $atime,$mtime,$ctime,$blksize,$blocks);
+    local (*IN);
+
+    if ( ! defined $fname ) {
+        $fname = 'TRAILER!!!';
+        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+          $atime,$mtime,$ctime,$blksize,$blocks) = (0) x 13;
+    } else {
+        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+INTRO
+          \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
+SUB
+        if (-f _) {
+            open(IN, "./$_\0") || do {
+                warn "Couldn't open $fname: $!\n";
+                return;
+            }
+        } else {
+            $text = readlink($_);
+            $size = 0 unless defined $text;
+        }
+    }
+
+    $fname =~ s#^\./##;
+    $nc{$fh} = $nc;
+    if ($nc eq 'n') {
+        $cpout{$fh} .=
+          sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
+            070707,
+            $dev & 0777777,
+            $ino & 0777777,
+            $mode & 0777777,
+            $uid & 0777777,
+            $gid & 0777777,
+            $nlink & 0777777,
+            $rdev & 0177777,
+            $mtime,
+            length($fname)+1,
+            $size,
+            $fname);
+    } else {
+        $cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
+        $cpout{$fh} .= pack("SSSSSSSSLSLa*",
+            070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
+            length($fname)+1, $size,
+            $fname . (length($fname) & 1 ? "\0" : "\0\0"));
+    }
+
+    if ($text ne '') {
+        $cpout{$fh} .= $text;
+    } elsif ($size) {
+        my $l;
+        flush($fh, \$cpout{$fh}, 5120)
+            while ($l = length($cpout{$fh})) >= 5120;
+        while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
+            flush($fh, \$cpout{$fh}, 5120);
+            $l = length($cpout{$fh});
+        }
+        close IN;
+    }
+}
+
+sub cflushall () {
+    for my $fh (keys %cpout) {
+        cpio($fh, undef, $nc{$fh});
+        $cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
+        flush($fh, \$cpout{$fh}, 5120);
+        print $blocks{$fh} * 10, " blocks\n";
+    }
+}
+
+END
+}
+
+if (exists $init{tar}) {
+    print <<'INTRO', <<"SUB", <<'END';
+
+my %tarout = ();
+my %linkseen = ();
+
+sub tar {
+    my ($fh, $fname) = @_;
+    my $prefix = '';
+    my $typeflag = '0';
+    my $linkname;
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+INTRO
+        \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
+SUB
+    local (*IN);
+
+    if ($nlink > 1) {
+        if ($linkname = $linkseen{$fh, $dev, $ino}) {
+            if (length($linkname) > 100) {
+                warn "$0: omitting file with linkname ",
+                     "too long for tar output: $linkname\n";
+                return;
+            }
+            $typeflag = '1';
+            $size = 0;
+        } else {
+            $linkseen{$fh, $dev, $ino} = $fname;
+        }
+    }
+    if ($typeflag eq '0') {
+        if (-f _) {
+            open(IN, "./$_\0") || do {
+                warn "Couldn't open $fname: $!\n";
+                return;
+            }
+        } else {
+            $linkname = readlink($_);
+            if (defined $linkname) { $typeflag = '2' }
+            elsif (-c _) { $typeflag = '3' }
+            elsif (-b _) { $typeflag = '4' }
+            elsif (-d _) { $typeflag = '5' }
+            elsif (-p _) { $typeflag = '6' }
+        }
+    }
+
+    if (length($fname) > 100) {
+        ($prefix, $fname) = ($fname =~ m#\A(.*?)/(.{,100})\Z(?!\n)#);
+        if (!defined($fname) || length($prefix) > 155) {
+            warn "$0: omitting file with name too long for tar output: ",
+                 $fname, "\n";
+            return;
+        }
+    }
+
+    $size = 0 if $typeflag ne '0';
+    my $header = pack("a100a8a8a8a12a12a8a1a100a6a2a32a32a8a8a155",
+                        $fname,
+                        sprintf("%7o ", $mode &    0777),
+                        sprintf("%7o ", $uid  & 0777777),
+                        sprintf("%7o ", $gid  & 0777777),
+                        sprintf("%11o ", $size),
+                        sprintf("%11o ", $mtime),
+                        ' 'x8,
+                        $typeflag,
+                        defined $linkname ? $linkname : '',
+                        "ustar\0",
+                        "00",
+                        $user{$uid},
+                        $group{$gid},
+                        ($rdev >> 8) & 0xff,
+                        $rdev & 0xff,
+                        $prefix,
+                     );
+    substr($header, 148, 8) = sprintf("%7o ", unpack("%16C*", $header));
+    my $l = length($header) % 512;
+    $tarout{$fh} .= $header;
+    $tarout{$fh} .= "\0" x (512 - $l) if $l;
+
+    if ($size) {
+        flush($fh, \$tarout{$fh}, 10240)
+            while ($l = length($tarout{$fh})) >= 10240;
+        while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
+            my $slop = length($tarout{$fh}) % 512;
+            $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
+            flush($fh, \$tarout{$fh}, 10240);
+            $l = length($tarout{$fh});
+        }
+        close IN;
+    }
+}
+
+sub tflushall () {
+    my $len;
+    for my $fh (keys %tarout) {
+        $len = 10240 - length($tarout{$fh});
+        $len += 10240 if $len < 1024;
+        $tarout{$fh} .= "\0" x $len;
+        flush($fh, \$tarout{$fh}, 10240);
+    }
+}
+
+END
+}
+
+exit;
+
+############################################################################
+
+sub tab () {
+    my $tabstring;
+
+    $tabstring = "\t" x ($indent_depth/2) . ' ' x ($indent_depth%2 * 4);
+    if (!$statdone) {
+        if ($_ =~ /^(?:name|print|prune|exec|ok|\(|\))/) {
+            $init{delayedstat} = 1;
+        } else {
+            my $statcall = '(($dev,$ino,$mode,$nlink,$uid,$gid) = '
+                         . $stat . '($_))';
+            if (exists $init{saw_or}) {
+                $tabstring .= "(\$nlink || $statcall) &&\n" . $tabstring;
+            } else {
+                $tabstring .= "$statcall &&\n" . $tabstring;
+            }
+            $statdone = 1;
+            $init{declarestat} = 1;
+        }
+    }
+    $tabstring =~ s/^\s+/ / if $out =~ /!$/;
+    $tabstring;
+}
+
+sub fileglob_to_re ($) {
+    my $x = shift;
+    $x =~ s#([./^\$()+])#\\$1#g;
+    $x =~ s#([?*])#.$1#g;
+    "^$x\\z";
+}
+
+sub n ($$) {
+    my ($pre, $n) = @_;
+    $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
+    $n =~ s/ 0*(\d)/ $1/;
+    "($pre $n)";
+}
+
+sub quote ($) {
+    my $string = shift;
+    $string =~ s/\\/\\\\/g;
+    $string =~ s/'/\\'/g;
+    "'$string'";
+}
+
+__END__
+
+=head1 NAME
+
+find2perl - translate find command lines to Perl code
+
+=head1 SYNOPSIS
+
+	find2perl [paths] [predicates] | perl
+
+=head1 DESCRIPTION
+
+find2perl is a little translator to convert find command lines to
+equivalent Perl code.  The resulting code is typically faster than
+running find itself.
+
+"paths" are a set of paths where find2perl will start its searches and
+"predicates" are taken from the following list.
+
+=over 4
+
+=item C<! PREDICATE>
+
+Negate the sense of the following predicate.  The C<!> must be passed as
+a distinct argument, so it may need to be surrounded by whitespace and/or
+quoted from interpretation by the shell using a backslash (just as with
+using C<find(1)>).
+
+=item C<( PREDICATES )>
+
+Group the given PREDICATES.  The parentheses must be passed as distinct
+arguments, so they may need to be surrounded by whitespace and/or
+quoted from interpretation by the shell using a backslash (just as with
+using C<find(1)>).
+
+=item C<PREDICATE1 PREDICATE2>
+
+True if _both_ PREDICATE1 and PREDICATE2 are true; PREDICATE2 is not
+evaluated if PREDICATE1 is false.
+
+=item C<PREDICATE1 -o PREDICATE2>
+
+True if either one of PREDICATE1 or PREDICATE2 is true; PREDICATE2 is
+not evaluated if PREDICATE1 is true.
+
+=item C<-follow>
+
+Follow (dereference) symlinks.  The checking of file attributes depends
+on the position of the C<-follow> option. If it precedes the file
+check option, an C<stat> is done which means the file check applies to the
+file the symbolic link is pointing to. If C<-follow> option follows the
+file check option, this now applies to the symbolic link itself, i.e.
+an C<lstat> is done.
+
+=item C<-depth>
+
+Change directory traversal algorithm from breadth-first to depth-first.
+
+=item C<-prune>
+
+Do not descend into the directory currently matched.
+
+=item C<-xdev>
+
+Do not traverse mount points (prunes search at mount-point directories).
+
+=item C<-name GLOB>
+
+File name matches specified GLOB wildcard pattern.  GLOB may need to be
+quoted to avoid interpretation by the shell (just as with using
+C<find(1)>).
+
+=item C<-iname GLOB>
+
+Like C<-name>, but the match is case insensitive.
+
+=item C<-path GLOB>
+
+Path name matches specified GLOB wildcard pattern.
+
+=item C<-ipath GLOB>
+
+Like C<-path>, but the match is case insensitive.
+
+=item C<-perm PERM>
+
+Low-order 9 bits of permission match octal value PERM.
+
+=item C<-perm -PERM>
+
+The bits specified in PERM are all set in file's permissions.
+
+=item C<-type X>
+
+The file's type matches perl's C<-X> operator.
+
+=item C<-fstype TYPE>
+
+Filesystem of current path is of type TYPE (only NFS/non-NFS distinction
+is implemented).
+
+=item C<-user USER>
+
+True if USER is owner of file.
+
+=item C<-group GROUP>
+
+True if file's group is GROUP.
+
+=item C<-nouser>
+
+True if file's owner is not in password database.
+
+=item C<-nogroup>
+
+True if file's group is not in group database.
+
+=item C<-inum INUM>
+
+True file's inode number is INUM.
+
+=item C<-links N>
+
+True if (hard) link count of file matches N (see below).
+
+=item C<-size N>
+
+True if file's size matches N (see below) N is normally counted in
+512-byte blocks, but a suffix of "c" specifies that size should be
+counted in characters (bytes) and a suffix of "k" specifes that
+size should be counted in 1024-byte blocks.
+
+=item C<-atime N>
+
+True if last-access time of file matches N (measured in days) (see
+below).
+
+=item C<-ctime N>
+
+True if last-changed time of file's inode matches N (measured in days,
+see below).
+
+=item C<-mtime N>
+
+True if last-modified time of file matches N (measured in days, see below).
+
+=item C<-newer FILE>
+
+True if last-modified time of file matches N.
+
+=item C<-print>
+
+Print out path of file (always true). If none of C<-exec>, C<-ls>,
+C<-print0>, or C<-ok> is specified, then C<-print> will be added
+implicitly.
+
+=item C<-print0>
+
+Like -print, but terminates with \0 instead of \n.
+
+=item C<-exec OPTIONS ;>
+
+exec() the arguments in OPTIONS in a subprocess; any occurrence of {} in
+OPTIONS will first be substituted with the path of the current
+file.  Note that the command "rm" has been special-cased to use perl's
+unlink() function instead (as an optimization).  The C<;> must be passed as
+a distinct argument, so it may need to be surrounded by whitespace and/or
+quoted from interpretation by the shell using a backslash (just as with
+using C<find(1)>).
+
+=item C<-ok OPTIONS ;>
+
+Like -exec, but first prompts user; if user's response does not begin
+with a y, skip the exec.  The C<;> must be passed as
+a distinct argument, so it may need to be surrounded by whitespace and/or
+quoted from interpretation by the shell using a backslash (just as with
+using C<find(1)>).
+
+=item C<-eval EXPR>
+
+Has the perl script eval() the EXPR.  
+
+=item C<-ls>
+
+Simulates C<-exec ls -dils {} ;>
+
+=item C<-tar FILE>
+
+Adds current output to tar-format FILE.
+
+=item C<-cpio FILE>
+
+Adds current output to old-style cpio-format FILE.
+
+=item C<-ncpio FILE>
+
+Adds current output to "new"-style cpio-format FILE.
+
+=back
+
+Predicates which take a numeric argument N can come in three forms:
+
+   * N is prefixed with a +: match values greater than N
+   * N is prefixed with a -: match values less than N
+   * N is not prefixed with either + or -: match only values equal to N
+
+=head1 SEE ALSO
+
+find
+
+=cut
+
+__END__
+:endofperl

Perl/bin/gedi

@@ -0,0 +1,313 @@
+#!/usr/local/bin/perl -w
+
+###############################################################################
+# Copyright (c) 1999  Greg London
+# All rights reserved.
+# This program is free software.
+# You can redistribute it and/or modify it under the same terms as Perl itself.
+###############################################################################
+
+###############################################################################
+# This is a perl application, called gedi, implementing a text editor.
+# gedi is short for Greg's EDItor. The "g" being pronounced like a "j".
+###############################################################################
+
+
+require 5;
+use locale;
+use strict;
+
+use Tk;
+use Tk::widgets qw(TextEdit);
+use File::Basename;
+
+###########################################
+# check command line parameter.
+# if none, start with file called 'NewFile'
+# if -help, print help
+# if filename, open file or die
+# note, wildcard automatically gets handled by perl interpreter,
+#	so that @ARGV contains list of matches.
+###########################################
+my $argcount = @ARGV;
+my ($global_filename) = @ARGV;
+
+if	($argcount>1)
+	{
+	print "\n";
+	print "ERROR: too many files specified. \n";
+	die "\n";
+	}
+
+if ($argcount == 0)
+	{$global_filename = 'NoName';}
+
+if (
+	($global_filename eq 'help') ||
+	($global_filename eq '-help') ||
+	($global_filename eq '-h') ||
+	($global_filename eq '-?')
+    )
+	{
+	print "\n";
+	print "$0 expects one command line argument: \n";
+	print " the name of the file to edit \n";
+	die "\n";
+	}
+
+
+# want FileSelect to use the last used directory as the starting directory
+# store directory in $global_directory.
+my $global_directory = dirname($global_filename);
+
+##############################################
+##############################################
+## input parameters have been filtered.
+## set up three frames to put everything into.
+## menu_frame, text_frame, counter_frame
+##############################################
+##############################################
+my $top = MainWindow->new();
+
+# my $menu_frame = $top->Frame->pack(-anchor=>'nw');
+my $text_frame = $top->Frame->pack
+	(-anchor=>'nw', -expand=>'yes', -fill => 'both'); # autosizing
+my $counter_frame = $top->Frame->pack(-anchor=>'nw');
+
+##############################################
+##############################################
+## now set up text window with contents.
+##############################################
+##############################################
+
+## autosizing is set up such that when the outside window is
+## resized, the text box adjusts to fill everything else in.
+## the text frame and the text window in the frame are both
+## set up for autosizing.
+
+my $textwindow = $text_frame->Scrolled(
+	'TextEdit',
+	exportselection => 'true',  # 'sel' tag is associated with selections
+	# initial height, if it isnt 1, then autosizing fails
+	# once window shrinks below height
+	# and the line counters go off the screen.
+	# seems to be a problem with the Tk::pack command;
+	height => 1,
+	-background => 'white',
+	-wrap=> 'none',
+	-setgrid => 'true', # use this for autosizing
+	-scrollbars =>'se')
+	-> pack(-expand => 'yes' , -fill => 'both');	# autosizing
+
+#$textwindow->FileName($global_filename);
+
+
+$top->protocol('WM_DELETE_WINDOW'=>
+ sub{$textwindow->ConfirmExit;}
+ );
+
+$SIG{INT} = sub {$textwindow->ConfirmExit;};
+
+##############################################
+##############################################
+## set up current line number display
+##############################################
+##############################################
+my $current_line_label = $counter_frame
+	-> Label(-text=>'line: 1')
+	-> grid(-row=>1,-column=>1, -sticky=>'nw' );
+
+my $total_line_label = $counter_frame
+	-> Label(-text=>'total lines: 1')
+	-> grid(-row=>2,-column=>1, -sticky=>'nw' );
+
+my $current_column_label = $counter_frame
+	-> Label(-text=>'column: 0')
+	-> grid(-row=>3,-column=>1, -sticky=>'nw' );
+
+my $insert_overstrike_mode_label = $counter_frame
+	-> Label(-text=>' ')
+	-> grid(-row=>5,-column=>1, -sticky=>'nw' );
+
+sub update_indicators
+{
+	my ($line,$column)= split(/\./,$textwindow->index('insert'));
+	$current_line_label->configure (-text=> "line: $line");
+	$current_column_label->configure (-text=> "column: $column");
+
+	my ($last_line,$last_col) = split(/\./,$textwindow->index('end'));
+	$total_line_label->configure (-text=> "total lines: $last_line");
+
+	my $mode = $textwindow->OverstrikeMode;
+	my $overstrke_insert='Insert Mode';
+	if ($mode)
+		{$overstrke_insert='Overstrike Mode';}
+	$insert_overstrike_mode_label->configure
+		(-text=> "$overstrke_insert");
+
+	my $filename = $textwindow->FileName;
+	$filename = 'NoName' unless(defined($filename));
+	my $edit_flag='';
+	if($textwindow->numberChanges)
+ 		{$edit_flag='edited';}
+	$top->configure(-title => "Gedi  $edit_flag $filename");
+	$textwindow->idletasks;
+
+}
+
+$textwindow->SetGUICallbacks (
+ [
+  \&update_indicators,
+  sub{$textwindow->HighlightAllPairsBracketingCursor}
+ ]
+);
+
+
+##############################################
+##############################################
+# call back functions
+##############################################
+##############################################
+
+########################################################################
+my $about_pop_up_reference;
+sub about_pop_up
+{
+	my $name = ref($about_pop_up_reference);
+	if (defined($about_pop_up_reference))
+		{
+		$about_pop_up_reference->raise;
+		$about_pop_up_reference->focus;
+		}
+	else
+		{
+		my $pop = $top->Toplevel();
+		$pop->title("About");
+
+		$pop->Label(text=>"Gedi (Gregs EDItor)")->pack();
+		$pop->Label(text=>"Ver. 1.0")->pack();
+		$pop->Label(text=>"Copyright 1999")->pack();
+		$pop->Label(text=>"Greg London")->pack();
+		$pop->Label(text=>"All Rights Reserved.")->pack();
+		$pop->Label(text=>"This program is free software.")->pack();
+		$pop->Label(text=>"You can redistribute it and/or")->pack();
+		$pop->Label(text=>"modify it under the same terms")->pack();
+		$pop->Label(text=>"as Perl itself.")->pack();
+		$pop->Label(text=>"Special Thanks to")->pack();
+		$pop->Label(text=>"Nick Ing-Simmons.")->pack();
+
+		my $button_ok = $pop->Button(text=>'OK',
+			command => sub {$pop->destroy();
+			$about_pop_up_reference = undef;
+			} )
+			->pack();
+		$pop->resizable('no','no');
+		$about_pop_up_reference = $pop;
+		}
+}
+
+##############################################
+##############################################
+## now set up menu bar
+##############################################
+##############################################
+
+my $menu = $textwindow->menu;
+$top->configure(-menu => $menu);
+
+##############################################
+# help menu
+##############################################
+my $help_menu = $menu->cascade(-label=>'~Help', -tearoff => 0, -menuitems => [
+         [Command => 'A~bout', -command => \&about_pop_up]
+         ]);
+
+##############################################
+# debug menu
+##############################################
+
+if (0)
+	{
+	my $debug_menu = $menu->cascade(-label=>'debug', -underline=>0);
+
+
+	$debug_menu->command(-label => 'Tag names', -underline=> 0 ,
+		-command =>
+		sub{
+		my @tags = $textwindow->tagNames();
+		print " @tags\n";
+
+		foreach my $tag (@tags)
+			{
+			my @ranges = $textwindow->tagRanges($tag);
+			print "tag: $tag  ranges: @ranges \n";
+			}
+
+		print "\n\n\n";
+		my @marks = $textwindow->markNames;
+		print " @marks \n";
+		foreach my $mark (@marks)
+			{
+			my $mark_location = $textwindow->index($mark);
+			print "$mark is at $mark_location\n";
+			}
+
+
+		print "\n\n\n";
+		my @dump = $textwindow->dump ( '-tag', '1.0', '465.0' );
+		print "@dump \n";
+
+		print "\n\n\n";
+		print "showing tops children:";
+		my @children = $top->children();
+		print "@children\n";
+
+		foreach my $child (@children)
+			{
+			my $junk = ref($child);
+			print "ref of $child is $junk \n";
+			}
+
+		my $overstrike = $textwindow->OverstrikeMode;
+		print "Overstrike is $overstrike \n";
+
+		$textwindow->dump_array($textwindow);
+		});
+	}
+
+##############################################
+# set the window to a normal size and set the minimum size
+$top->minsize(30,1);
+$top->geometry("80x24");
+
+#############################################################################
+#############################################################################
+#############################################################################
+#############################################################################
+
+
+
+
+##############################################
+## this line for debug
+## $top->bind('<Key>', [sub{print "ARGS: @_\n";}, Ev('k'), Ev('K') ]  );
+
+##########################################
+## fill the text window with initial file.
+
+if ($argcount)
+	{
+	if (-e $global_filename) # if it doesn't exist, make it empty
+		{
+		# it may be a big file, draw the window, and then load it
+		# so that we know something is happening.
+		$top->update;
+		$textwindow->Load($global_filename);
+		}
+	}
+
+
+##############################################
+$textwindow->CallNextGUICallback;
+
+MainLoop();

Perl/bin/gedi.bat

@@ -0,0 +1,329 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/local/bin/perl -w
+#line 15
+
+###############################################################################
+# Copyright (c) 1999  Greg London
+# All rights reserved.
+# This program is free software.
+# You can redistribute it and/or modify it under the same terms as Perl itself.
+###############################################################################
+
+###############################################################################
+# This is a perl application, called gedi, implementing a text editor.
+# gedi is short for Greg's EDItor. The "g" being pronounced like a "j".
+###############################################################################
+
+
+require 5;
+use locale;
+use strict;
+
+use Tk;
+use Tk::widgets qw(TextEdit);
+use File::Basename;
+
+###########################################
+# check command line parameter.
+# if none, start with file called 'NewFile'
+# if -help, print help
+# if filename, open file or die
+# note, wildcard automatically gets handled by perl interpreter,
+#	so that @ARGV contains list of matches.
+###########################################
+my $argcount = @ARGV;
+my ($global_filename) = @ARGV;
+
+if	($argcount>1)
+	{
+	print "\n";
+	print "ERROR: too many files specified. \n";
+	die "\n";
+	}
+
+if ($argcount == 0)
+	{$global_filename = 'NoName';}
+
+if (
+	($global_filename eq 'help') ||
+	($global_filename eq '-help') ||
+	($global_filename eq '-h') ||
+	($global_filename eq '-?')
+    )
+	{
+	print "\n";
+	print "$0 expects one command line argument: \n";
+	print " the name of the file to edit \n";
+	die "\n";
+	}
+
+
+# want FileSelect to use the last used directory as the starting directory
+# store directory in $global_directory.
+my $global_directory = dirname($global_filename);
+
+##############################################
+##############################################
+## input parameters have been filtered.
+## set up three frames to put everything into.
+## menu_frame, text_frame, counter_frame
+##############################################
+##############################################
+my $top = MainWindow->new();
+
+# my $menu_frame = $top->Frame->pack(-anchor=>'nw');
+my $text_frame = $top->Frame->pack
+	(-anchor=>'nw', -expand=>'yes', -fill => 'both'); # autosizing
+my $counter_frame = $top->Frame->pack(-anchor=>'nw');
+
+##############################################
+##############################################
+## now set up text window with contents.
+##############################################
+##############################################
+
+## autosizing is set up such that when the outside window is
+## resized, the text box adjusts to fill everything else in.
+## the text frame and the text window in the frame are both
+## set up for autosizing.
+
+my $textwindow = $text_frame->Scrolled(
+	'TextEdit',
+	exportselection => 'true',  # 'sel' tag is associated with selections
+	# initial height, if it isnt 1, then autosizing fails
+	# once window shrinks below height
+	# and the line counters go off the screen.
+	# seems to be a problem with the Tk::pack command;
+	height => 1,
+	-background => 'white',
+	-wrap=> 'none',
+	-setgrid => 'true', # use this for autosizing
+	-scrollbars =>'se')
+	-> pack(-expand => 'yes' , -fill => 'both');	# autosizing
+
+#$textwindow->FileName($global_filename);
+
+
+$top->protocol('WM_DELETE_WINDOW'=>
+ sub{$textwindow->ConfirmExit;}
+ );
+
+$SIG{INT} = sub {$textwindow->ConfirmExit;};
+
+##############################################
+##############################################
+## set up current line number display
+##############################################
+##############################################
+my $current_line_label = $counter_frame
+	-> Label(-text=>'line: 1')
+	-> grid(-row=>1,-column=>1, -sticky=>'nw' );
+
+my $total_line_label = $counter_frame
+	-> Label(-text=>'total lines: 1')
+	-> grid(-row=>2,-column=>1, -sticky=>'nw' );
+
+my $current_column_label = $counter_frame
+	-> Label(-text=>'column: 0')
+	-> grid(-row=>3,-column=>1, -sticky=>'nw' );
+
+my $insert_overstrike_mode_label = $counter_frame
+	-> Label(-text=>' ')
+	-> grid(-row=>5,-column=>1, -sticky=>'nw' );
+
+sub update_indicators
+{
+	my ($line,$column)= split(/\./,$textwindow->index('insert'));
+	$current_line_label->configure (-text=> "line: $line");
+	$current_column_label->configure (-text=> "column: $column");
+
+	my ($last_line,$last_col) = split(/\./,$textwindow->index('end'));
+	$total_line_label->configure (-text=> "total lines: $last_line");
+
+	my $mode = $textwindow->OverstrikeMode;
+	my $overstrke_insert='Insert Mode';
+	if ($mode)
+		{$overstrke_insert='Overstrike Mode';}
+	$insert_overstrike_mode_label->configure
+		(-text=> "$overstrke_insert");
+
+	my $filename = $textwindow->FileName;
+	$filename = 'NoName' unless(defined($filename));
+	my $edit_flag='';
+	if($textwindow->numberChanges)
+ 		{$edit_flag='edited';}
+	$top->configure(-title => "Gedi  $edit_flag $filename");
+	$textwindow->idletasks;
+
+}
+
+$textwindow->SetGUICallbacks (
+ [
+  \&update_indicators,
+  sub{$textwindow->HighlightAllPairsBracketingCursor}
+ ]
+);
+
+
+##############################################
+##############################################
+# call back functions
+##############################################
+##############################################
+
+########################################################################
+my $about_pop_up_reference;
+sub about_pop_up
+{
+	my $name = ref($about_pop_up_reference);
+	if (defined($about_pop_up_reference))
+		{
+		$about_pop_up_reference->raise;
+		$about_pop_up_reference->focus;
+		}
+	else
+		{
+		my $pop = $top->Toplevel();
+		$pop->title("About");
+
+		$pop->Label(text=>"Gedi (Gregs EDItor)")->pack();
+		$pop->Label(text=>"Ver. 1.0")->pack();
+		$pop->Label(text=>"Copyright 1999")->pack();
+		$pop->Label(text=>"Greg London")->pack();
+		$pop->Label(text=>"All Rights Reserved.")->pack();
+		$pop->Label(text=>"This program is free software.")->pack();
+		$pop->Label(text=>"You can redistribute it and/or")->pack();
+		$pop->Label(text=>"modify it under the same terms")->pack();
+		$pop->Label(text=>"as Perl itself.")->pack();
+		$pop->Label(text=>"Special Thanks to")->pack();
+		$pop->Label(text=>"Nick Ing-Simmons.")->pack();
+
+		my $button_ok = $pop->Button(text=>'OK',
+			command => sub {$pop->destroy();
+			$about_pop_up_reference = undef;
+			} )
+			->pack();
+		$pop->resizable('no','no');
+		$about_pop_up_reference = $pop;
+		}
+}
+
+##############################################
+##############################################
+## now set up menu bar
+##############################################
+##############################################
+
+my $menu = $textwindow->menu;
+$top->configure(-menu => $menu);
+
+##############################################
+# help menu
+##############################################
+my $help_menu = $menu->cascade(-label=>'~Help', -tearoff => 0, -menuitems => [
+         [Command => 'A~bout', -command => \&about_pop_up]
+         ]);
+
+##############################################
+# debug menu
+##############################################
+
+if (0)
+	{
+	my $debug_menu = $menu->cascade(-label=>'debug', -underline=>0);
+
+
+	$debug_menu->command(-label => 'Tag names', -underline=> 0 ,
+		-command =>
+		sub{
+		my @tags = $textwindow->tagNames();
+		print " @tags\n";
+
+		foreach my $tag (@tags)
+			{
+			my @ranges = $textwindow->tagRanges($tag);
+			print "tag: $tag  ranges: @ranges \n";
+			}
+
+		print "\n\n\n";
+		my @marks = $textwindow->markNames;
+		print " @marks \n";
+		foreach my $mark (@marks)
+			{
+			my $mark_location = $textwindow->index($mark);
+			print "$mark is at $mark_location\n";
+			}
+
+
+		print "\n\n\n";
+		my @dump = $textwindow->dump ( '-tag', '1.0', '465.0' );
+		print "@dump \n";
+
+		print "\n\n\n";
+		print "showing tops children:";
+		my @children = $top->children();
+		print "@children\n";
+
+		foreach my $child (@children)
+			{
+			my $junk = ref($child);
+			print "ref of $child is $junk \n";
+			}
+
+		my $overstrike = $textwindow->OverstrikeMode;
+		print "Overstrike is $overstrike \n";
+
+		$textwindow->dump_array($textwindow);
+		});
+	}
+
+##############################################
+# set the window to a normal size and set the minimum size
+$top->minsize(30,1);
+$top->geometry("80x24");
+
+#############################################################################
+#############################################################################
+#############################################################################
+#############################################################################
+
+
+
+
+##############################################
+## this line for debug
+## $top->bind('<Key>', [sub{print "ARGS: @_\n";}, Ev('k'), Ev('K') ]  );
+
+##########################################
+## fill the text window with initial file.
+
+if ($argcount)
+	{
+	if (-e $global_filename) # if it doesn't exist, make it empty
+		{
+		# it may be a big file, draw the window, and then load it
+		# so that we know something is happening.
+		$top->update;
+		$textwindow->Load($global_filename);
+		}
+	}
+
+
+##############################################
+$textwindow->CallNextGUICallback;
+
+MainLoop();
+
+__END__
+:endofperl

Perl/bin/h2ph.bat

@@ -0,0 +1,941 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+	if $running_under_some_shell;
+
+use strict;
+
+use Config;
+use File::Path qw(mkpath);
+use Getopt::Std;
+
+# Make sure read permissions for all are set:
+if (defined umask && (umask() & 0444)) {
+    umask (umask() & ~0444);
+}
+
+getopts('Dd:rlhaQe');
+use vars qw($opt_D $opt_d $opt_r $opt_l $opt_h $opt_a $opt_Q $opt_e);
+die "-r and -a options are mutually exclusive\n" if ($opt_r and $opt_a);
+my @inc_dirs = inc_dirs() if $opt_a;
+
+my $Exit = 0;
+
+my $Dest_dir = $opt_d || $Config{installsitearch};
+die "Destination directory $Dest_dir doesn't exist or isn't a directory\n"
+    unless -d $Dest_dir;
+
+my @isatype = qw(
+	char	uchar	u_char
+	short	ushort	u_short
+	int	uint	u_int
+	long	ulong	u_long
+	FILE	key_t	caddr_t
+	float	double	size_t
+);
+
+my %isatype;
+@isatype{@isatype} = (1) x @isatype;
+my $inif = 0;
+my %Is_converted;
+my %bad_file = ();
+
+@ARGV = ('-') unless @ARGV;
+
+build_preamble_if_necessary();
+
+sub reindent($) {
+    my($text) = shift;
+    $text =~ s/\n/\n    /g;
+    $text =~ s/        /\t/g;
+    $text;
+}
+
+my ($t, $tab, %curargs, $new, $eval_index, $dir, $name, $args, $outfile);
+my ($incl, $incl_type, $next);
+while (defined (my $file = next_file())) {
+    if (-l $file and -d $file) {
+        link_if_possible($file) if ($opt_l);
+        next;
+    }
+
+    # Recover from header files with unbalanced cpp directives
+    $t = '';
+    $tab = 0;
+
+    # $eval_index goes into ``#line'' directives, to help locate syntax errors:
+    $eval_index = 1;
+
+    if ($file eq '-') {
+	open(IN, "-");
+	open(OUT, ">-");
+    } else {
+	($outfile = $file) =~ s/\.h$/.ph/ || next;
+	print "$file -> $outfile\n" unless $opt_Q;
+	if ($file =~ m|^(.*)/|) {
+	    $dir = $1;
+	    mkpath "$Dest_dir/$dir";
+	}
+
+	if ($opt_a) { # automagic mode:  locate header file in @inc_dirs
+	    foreach (@inc_dirs) {
+		chdir $_;
+		last if -f $file;
+	    }
+	}
+
+	open(IN,"$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next);
+	open(OUT,">$Dest_dir/$outfile") || die "Can't create $outfile: $!\n";
+    }
+
+    print OUT
+        "require '_h2ph_pre.ph';\n\n",
+        "no warnings 'redefine';\n\n";
+
+    while (defined (local $_ = next_line($file))) {
+	if (s/^\s*\#\s*//) {
+	    if (s/^define\s+(\w+)//) {
+		$name = $1;
+		$new = '';
+		s/\s+$//;
+		s/\(\w+\s*\(\*\)\s*\(\w*\)\)\s*(-?\d+)/$1/; # (int (*)(foo_t))0
+		if (s/^\(([\w,\s]*)\)//) {
+		    $args = $1;
+		    my $proto = '() ';
+		    if ($args ne '') {
+			$proto = '';
+			foreach my $arg (split(/,\s*/,$args)) {
+			    $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
+			    $curargs{$arg} = 1;
+			}
+			$args =~ s/\b(\w)/\$$1/g;
+			$args = "my($args) = \@_;\n$t    ";
+		    }
+		    s/^\s+//;
+		    expr();
+		    $new =~ s/(["\\])/\\$1/g;       #"]);
+		  EMIT:
+		    $new = reindent($new);
+		    $args = reindent($args);
+		    if ($t ne '') {
+			$new =~ s/(['\\])/\\$1/g;   #']);
+			if ($opt_h) {
+			    print OUT $t,
+                            "eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name $proto\{\n$t    ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
+                            $eval_index++;
+			} else {
+			    print OUT $t,
+                            "eval 'sub $name $proto\{\n$t    ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
+			}
+		    } else {
+                      print OUT "unless(defined(\&$name)) {\n    sub $name $proto\{\n\t${args}eval q($new);\n    }\n}\n";
+		    }
+		    %curargs = ();
+		} else {
+		    s/^\s+//;
+		    expr();
+		    $new = 1 if $new eq '';
+		    $new = reindent($new);
+		    $args = reindent($args);
+		    if ($t ne '') {
+			$new =~ s/(['\\])/\\$1/g;        #']);
+
+			if ($opt_h) {
+			    print OUT $t,"eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name () {",$new,";}' unless defined(\&$name);\n";
+			    $eval_index++;
+			} else {
+			    print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n";
+			}
+		    } else {
+		    	# Shunt around such directives as `#define FOO FOO':
+		    	next if " \&$name" eq $new;
+
+                      print OUT $t,"unless(defined(\&$name)) {\n    sub $name () {\t",$new,";}\n}\n";
+		    }
+		}
+	    } elsif (/^(include|import|include_next)\s*[<\"](.*)[>\"]/) {
+                $incl_type = $1;
+                $incl = $2;
+                if (($incl_type eq 'include_next') ||
+                    ($opt_e && exists($bad_file{$incl}))) {
+                    $incl =~ s/\.h$/.ph/;
+		print OUT ($t,
+			   "eval {\n");
+                $tab += 4;
+                $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+                    print OUT ($t, "my(\@REM);\n");
+                    if ($incl_type eq 'include_next') {
+		print OUT ($t,
+			   "my(\%INCD) = map { \$INC{\$_} => 1 } ",
+			           "(grep { \$_ eq \"$incl\" } ",
+                                   "keys(\%INC));\n");
+		print OUT ($t,
+			           "\@REM = map { \"\$_/$incl\" } ",
+			   "(grep { not exists(\$INCD{\"\$_/$incl\"})",
+			           " and -f \"\$_/$incl\" } \@INC);\n");
+                    } else {
+                        print OUT ($t,
+                                   "\@REM = map { \"\$_/$incl\" } ",
+                                   "(grep {-r \"\$_/$incl\" } \@INC);\n");
+                    }
+		print OUT ($t,
+			   "require \"\$REM[0]\" if \@REM;\n");
+                $tab -= 4;
+                $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+                print OUT ($t,
+			   "};\n");
+		print OUT ($t,
+			   "warn(\$\@) if \$\@;\n");
+                } else {
+                    $incl =~ s/\.h$/.ph/;
+		    print OUT $t,"require '$incl';\n";
+                }
+	    } elsif (/^ifdef\s+(\w+)/) {
+		print OUT $t,"if(defined(&$1)) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    } elsif (/^ifndef\s+(\w+)/) {
+		print OUT $t,"unless(defined(&$1)) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    } elsif (s/^if\s+//) {
+		$new = '';
+		$inif = 1;
+		expr();
+		$inif = 0;
+		print OUT $t,"if($new) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    } elsif (s/^elif\s+//) {
+		$new = '';
+		$inif = 1;
+		expr();
+		$inif = 0;
+		$tab -= 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+		print OUT $t,"}\n elsif($new) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    } elsif (/^else/) {
+		$tab -= 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+		print OUT $t,"} else {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    } elsif (/^endif/) {
+		$tab -= 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+		print OUT $t,"}\n";
+	    } elsif(/^undef\s+(\w+)/) {
+		print OUT $t, "undef(&$1) if defined(&$1);\n";
+	    } elsif(/^error\s+(".*")/) {
+		print OUT $t, "die($1);\n";
+	    } elsif(/^error\s+(.*)/) {
+		print OUT $t, "die(\"", quotemeta($1), "\");\n";
+	    } elsif(/^warning\s+(.*)/) {
+		print OUT $t, "warn(\"", quotemeta($1), "\");\n";
+	    } elsif(/^ident\s+(.*)/) {
+		print OUT $t, "# $1\n";
+	    }
+	} elsif (/^\s*(typedef\s*)?enum\s*(\s+[a-zA-Z_]\w*\s*)?/) { # { for vi
+	    until(/\{[^}]*\}.*;/ || /;/) {
+		last unless defined ($next = next_line($file));
+		chomp $next;
+		# drop "#define FOO FOO" in enums
+		$next =~ s/^\s*#\s*define\s+(\w+)\s+\1\s*$//;
+		# #defines in enums (aliases)
+		$next =~ s/^\s*#\s*define\s+(\w+)\s+(\w+)\s*$/$1 = $2,/;
+		$_ .= $next;
+		print OUT "# $next\n" if $opt_D;
+	    }
+	    s/#\s*if.*?#\s*endif//g; # drop #ifdefs
+	    s@/\*.*?\*/@@g;
+	    s/\s+/ /g;
+	    next unless /^\s?(typedef\s?)?enum\s?([a-zA-Z_]\w*)?\s?\{(.*)\}\s?([a-zA-Z_]\w*)?\s?;/;
+	    (my $enum_subs = $3) =~ s/\s//g;
+	    my @enum_subs = split(/,/, $enum_subs);
+	    my $enum_val = -1;
+	    foreach my $enum (@enum_subs) {
+		my ($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/;
+		$enum_name or next;
+		$enum_value =~ s/^=//;
+		$enum_val = (length($enum_value) ? $enum_value : $enum_val + 1);
+		if ($opt_h) {
+		    print OUT ($t,
+			       "eval(\"\\n#line $eval_index $outfile\\n",
+			       "sub $enum_name () \{ $enum_val; \}\") ",
+			       "unless defined(\&$enum_name);\n");
+		    ++ $eval_index;
+		} else {
+		    print OUT ($t,
+			       "eval(\"sub $enum_name () \{ $enum_val; \}\") ",
+			       "unless defined(\&$enum_name);\n");
+		}
+	    }
+	} elsif (/^(?:__extension__\s+)?(?:extern|static)\s+(?:__)?inline(?:__)?\s+/
+	    and !/;\s*$/ and !/{\s*}\s*$/)
+	{ # { for vi
+	    # This is a hack to parse the inline functions in the glibc headers.
+	    # Warning: massive kludge ahead. We suppose inline functions
+	    # are mainly constructed like macros.
+	    while (1) {
+		last unless defined ($next = next_line($file));
+		chomp $next;
+		undef $_, last if $next =~ /__THROW\s*;/
+			       or $next =~ /^(__extension__|extern|static)\b/;
+		$_ .= " $next";
+		print OUT "# $next\n" if $opt_D;
+		last if $next =~ /^}|^{.*}\s*$/;
+	    }
+	    next if not defined; # because it's only a prototype
+	    s/\b(__extension__|extern|static|(?:__)?inline(?:__)?)\b//g;
+	    # violently drop #ifdefs
+	    s/#\s*if.*?#\s*endif//g
+		and print OUT "# some #ifdef were dropped here -- fill in the blanks\n";
+	    if (s/^(?:\w|\s|\*)*\s(\w+)\s*//) {
+		$name = $1;
+	    } else {
+		warn "name not found"; next; # shouldn't occur...
+	    }
+	    my @args;
+	    if (s/^\(([^()]*)\)\s*(\w+\s*)*//) {
+		for my $arg (split /,/, $1) {
+		    if ($arg =~ /(\w+)\s*$/) {
+			$curargs{$1} = 1;
+			push @args, $1;
+		    }
+		}
+	    }
+	    $args = (
+		@args
+		? "my(" . (join ',', map "\$$_", @args) . ") = \@_;\n$t    "
+		: ""
+	    );
+	    my $proto = @args ? '' : '() ';
+	    $new = '';
+	    s/\breturn\b//g; # "return" doesn't occur in macros usually...
+	    expr();
+	    # try to find and perlify local C variables
+	    our @local_variables = (); # needs to be a our(): (?{...}) bug workaround
+	    {
+		use re "eval";
+		my $typelist = join '|', keys %isatype;
+		$new =~ s['
+		  (?:(?:__)?const(?:__)?\s+)?
+		  (?:(?:un)?signed\s+)?
+		  (?:long\s+)?
+		  (?:$typelist)\s+
+		  (\w+)
+		  (?{ push @local_variables, $1 })
+		  ']
+		 [my \$$1]gx;
+		$new =~ s['
+		  (?:(?:__)?const(?:__)?\s+)?
+		  (?:(?:un)?signed\s+)?
+		  (?:long\s+)?
+		  (?:$typelist)\s+
+		  ' \s+ &(\w+) \s* ;
+		  (?{ push @local_variables, $1 })
+		  ]
+		 [my \$$1;]gx;
+	     }
+	    $new =~ s/&$_\b/\$$_/g for @local_variables;
+	    $new =~ s/(["\\])/\\$1/g;       #"]);
+	    # now that's almost like a macro (we hope)
+	    goto EMIT;
+	}
+    }
+    $Is_converted{$file} = 1;
+    if ($opt_e && exists($bad_file{$file})) {
+        unlink($Dest_dir . '/' . $outfile);
+        $next = '';
+    } else {
+        print OUT "1;\n";
+	queue_includes_from($file) if $opt_a;
+    }
+}
+
+if ($opt_e && (scalar(keys %bad_file) > 0)) {
+    warn "Was unable to convert the following files:\n";
+    warn "\t" . join("\n\t",sort(keys %bad_file)) . "\n";
+}
+
+exit $Exit;
+
+sub expr {
+    $new = '"(assembly code)"' and return if /\b__asm__\b/; # freak out.
+    my $joined_args;
+    if(keys(%curargs)) {
+	$joined_args = join('|', keys(%curargs));
+    }
+    while ($_ ne '') {
+	s/^\&\&// && do { $new .= " &&"; next;}; # handle && operator
+	s/^\&([\(a-z\)]+)/$1/i;	# hack for things that take the address of
+	s/^(\s+)//		&& do {$new .= ' '; next;};
+	s/^0X([0-9A-F]+)[UL]*//i
+	    && do {my $hex = $1;
+		   $hex =~ s/^0+//;
+		   if (length $hex > 8 && !$Config{use64bitint}) {
+		       # Croak if nv_preserves_uv_bits < 64 ?
+		       $new .=         hex(substr($hex, -8)) +
+			       2**32 * hex(substr($hex,  0, -8));
+		       # The above will produce "errorneus" code
+		       # if the hex constant was e.g. inside UINT64_C
+		       # macro, but then again, h2ph is an approximation.
+		   } else {
+		       $new .= lc("0x$hex");
+		   }
+		   next;};
+	s/^(-?\d+\.\d+E[-+]?\d+)[FL]?//i	&& do {$new .= $1; next;};
+	s/^(\d+)\s*[LU]*//i	&& do {$new .= $1; next;};
+	s/^("(\\"|[^"])*")//	&& do {$new .= $1; next;};
+	s/^'((\\"|[^"])*)'//	&& do {
+	    if ($curargs{$1}) {
+		$new .= "ord('\$$1')";
+	    } else {
+		$new .= "ord('$1')";
+	    }
+	    next;
+	};
+        # replace "sizeof(foo)" with "{foo}"
+        # also, remove * (C dereference operator) to avoid perl syntax
+        # problems.  Where the %sizeof array comes from is anyone's
+        # guess (c2ph?), but this at least avoids fatal syntax errors.
+        # Behavior is undefined if sizeof() delimiters are unbalanced.
+        # This code was modified to able to handle constructs like this:
+        #   sizeof(*(p)), which appear in the HP-UX 10.01 header files.
+        s/^sizeof\s*\(// && do {
+            $new .= '$sizeof';
+            my $lvl = 1;  # already saw one open paren
+            # tack { on the front, and skip it in the loop
+            $_ = "{" . "$_";
+            my $index = 1;
+            # find balanced closing paren
+            while ($index <= length($_) && $lvl > 0) {
+                $lvl++ if substr($_, $index, 1) eq "(";
+                $lvl-- if substr($_, $index, 1) eq ")";
+                $index++;
+            }
+            # tack } on the end, replacing )
+            substr($_, $index - 1, 1) = "}";
+            # remove pesky * operators within the sizeof argument
+            substr($_, 0, $index - 1) =~ s/\*//g;
+            next;
+        };
+	# Eliminate typedefs
+	/\(([\w\s]+)[\*\s]*\)\s*[\w\(]/ && do {
+	    my $doit = 1;
+	    foreach (split /\s+/, $1) {  # Make sure all the words are types,
+	        unless($isatype{$_} or $_ eq 'struct' or $_ eq 'union'){
+		    $doit = 0;
+		    last;
+		}
+	    }
+	    if( $doit ){
+		s/\([\w\s]+[\*\s]*\)// && next;      # then eliminate them.
+	    }
+	};
+	# struct/union member, including arrays:
+	s/^([_A-Z]\w*(\[[^\]]+\])?((\.|->)[_A-Z]\w*(\[[^\]]+\])?)+)//i && do {
+	    my $id = $1;
+	    $id =~ s/(\.|(->))([^\.\-]*)/->\{$3\}/g;
+	    $id =~ s/\b([^\$])($joined_args)/$1\$$2/g if length($joined_args);
+	    while($id =~ /\[\s*([^\$\&\d\]]+)\]/) {
+		my($index) = $1;
+		$index =~ s/\s//g;
+		if(exists($curargs{$index})) {
+		    $index = "\$$index";
+		} else {
+		    $index = "&$index";
+		}
+		$id =~ s/\[\s*([^\$\&\d\]]+)\]/[$index]/;
+	    }
+	    $new .= " (\$$id)";
+	};
+	s/^([_a-zA-Z]\w*)//	&& do {
+	    my $id = $1;
+	    if ($id eq 'struct' || $id eq 'union') {
+		s/^\s+(\w+)//;
+		$id .= ' ' . $1;
+		$isatype{$id} = 1;
+	    } elsif ($id =~ /^((un)?signed)|(long)|(short)$/) {
+		while (s/^\s+(\w+)//) { $id .= ' ' . $1; }
+		$isatype{$id} = 1;
+	    }
+	    if ($curargs{$id}) {
+		$new .= "\$$id";
+		$new .= '->' if /^[\[\{]/;
+	    } elsif ($id eq 'defined') {
+		$new .= 'defined';
+	    } elsif (/^\s*\(/) {
+		s/^\s*\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;	# cheat
+		$new .= " &$id";
+	    } elsif ($isatype{$id}) {
+		if ($new =~ /{\s*$/) {
+		    $new .= "'$id'";
+		} elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
+		    $new =~ s/\(\s*$//;
+		    s/^[\s*]*\)//;
+		} else {
+		    $new .= q(').$id.q(');
+		}
+	    } else {
+		if ($inif && $new !~ /defined\s*\($/) {
+		    $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
+		} elsif (/^\[/) {
+		    $new .= " \$$id";
+		} else {
+		    $new .= ' &' . $id;
+		}
+	    }
+	    next;
+	};
+	s/^(.)// && do { if ($1 ne '#') { $new .= $1; } next;};
+    }
+}
+
+
+sub next_line
+{
+    my $file = shift;
+    my ($in, $out);
+    my $pre_sub_tri_graphs = 1;
+
+    READ: while (not eof IN) {
+        $in  .= <IN>;
+        chomp $in;
+        next unless length $in;
+
+        while (length $in) {
+            if ($pre_sub_tri_graphs) {
+                # Preprocess all tri-graphs
+                # including things stuck in quoted string constants.
+                $in =~ s/\?\?=/#/g;                         # | ??=|  #|
+                $in =~ s/\?\?\!/|/g;                        # | ??!|  ||
+                $in =~ s/\?\?'/^/g;                         # | ??'|  ^|
+                $in =~ s/\?\?\(/[/g;                        # | ??(|  [|
+                $in =~ s/\?\?\)/]/g;                        # | ??)|  ]|
+                $in =~ s/\?\?\-/~/g;                        # | ??-|  ~|
+                $in =~ s/\?\?\//\\/g;                       # | ??/|  \|
+                $in =~ s/\?\?</{/g;                         # | ??<|  {|
+                $in =~ s/\?\?>/}/g;                         # | ??>|  }|
+            }
+	    if ($in =~ /^\#ifdef __LANGUAGE_PASCAL__/) {
+		# Tru64 disassembler.h evilness: mixed C and Pascal.
+		while (<IN>) {
+		    last if /^\#endif/;
+		}
+		$in = "";
+		next READ;
+	    }
+	    if ($in =~ /^extern inline / && # Inlined assembler.
+		$^O eq 'linux' && $file =~ m!(?:^|/)asm/[^/]+\.h$!) {
+		while (<IN>) {
+		    last if /^}/;
+		}
+		$in = "";
+		next READ;
+	    }
+            if ($in =~ s/\\$//) {                           # \-newline
+                $out    .= ' ';
+                next READ;
+            } elsif ($in =~ s/^([^"'\\\/]+)//) {            # Passthrough
+                $out    .= $1;
+            } elsif ($in =~ s/^(\\.)//) {                   # \...
+                $out    .= $1;
+            } elsif ($in =~ /^'/) {                         # '...
+                if ($in =~ s/^('(\\.|[^'\\])*')//) {
+                    $out    .= $1;
+                } else {
+                    next READ;
+                }
+            } elsif ($in =~ /^"/) {                         # "...
+                if ($in =~ s/^("(\\.|[^"\\])*")//) {
+                    $out    .= $1;
+                } else {
+                    next READ;
+                }
+            } elsif ($in =~ s/^\/\/.*//) {                  # //...
+                # fall through
+            } elsif ($in =~ m/^\/\*/) {                     # /*...
+                # C comment removal adapted from perlfaq6:
+                if ($in =~ s/^\/\*[^*]*\*+([^\/*][^*]*\*+)*\///) {
+                    $out    .= ' ';
+                } else {                                    # Incomplete /* */
+                    next READ;
+                }
+            } elsif ($in =~ s/^(\/)//) {                    # /...
+                $out    .= $1;
+            } elsif ($in =~ s/^([^\'\"\\\/]+)//) {
+                $out    .= $1;
+            } elsif ($^O eq 'linux' &&
+                     $file =~ m!(?:^|/)linux/byteorder/pdp_endian\.h$! &&
+                     $in   =~ s!\'T KNOW!!) {
+                $out    =~ s!I DON$!I_DO_NOT_KNOW!;
+            } else {
+                if ($opt_e) {
+                    warn "Cannot parse $file:\n$in\n";
+                    $bad_file{$file} = 1;
+                    $in = '';
+                    $out = undef;
+                    last READ;
+                } else {
+		die "Cannot parse:\n$in\n";
+                }
+            }
+        }
+
+        last READ if $out =~ /\S/;
+    }
+
+    return $out;
+}
+
+
+# Handle recursive subdirectories without getting a grotesquely big stack.
+# Could this be implemented using File::Find?
+sub next_file
+{
+    my $file;
+
+    while (@ARGV) {
+        $file = shift @ARGV;
+
+        if ($file eq '-' or -f $file or -l $file) {
+            return $file;
+        } elsif (-d $file) {
+            if ($opt_r) {
+                expand_glob($file);
+            } else {
+                print STDERR "Skipping directory `$file'\n";
+            }
+        } elsif ($opt_a) {
+            return $file;
+        } else {
+            print STDERR "Skipping `$file':  not a file or directory\n";
+        }
+    }
+
+    return undef;
+}
+
+
+# Put all the files in $directory into @ARGV for processing.
+sub expand_glob
+{
+    my ($directory)  = @_;
+
+    $directory =~ s:/$::;
+
+    opendir DIR, $directory;
+        foreach (readdir DIR) {
+            next if ($_ eq '.' or $_ eq '..');
+
+            # expand_glob() is going to be called until $ARGV[0] isn't a
+            # directory; so push directories, and unshift everything else.
+            if (-d "$directory/$_") { push    @ARGV, "$directory/$_" }
+            else                    { unshift @ARGV, "$directory/$_" }
+        }
+    closedir DIR;
+}
+
+
+# Given $file, a symbolic link to a directory in the C include directory,
+# make an equivalent symbolic link in $Dest_dir, if we can figure out how.
+# Otherwise, just duplicate the file or directory.
+sub link_if_possible
+{
+    my ($dirlink)  = @_;
+    my $target  = eval 'readlink($dirlink)';
+
+    if ($target =~ m:^\.\./: or $target =~ m:^/:) {
+        # The target of a parent or absolute link could leave the $Dest_dir
+        # hierarchy, so let's put all of the contents of $dirlink (actually,
+        # the contents of $target) into @ARGV; as a side effect down the
+        # line, $dirlink will get created as an _actual_ directory.
+        expand_glob($dirlink);
+    } else {
+        if (-l "$Dest_dir/$dirlink") {
+            unlink "$Dest_dir/$dirlink" or
+                print STDERR "Could not remove link $Dest_dir/$dirlink:  $!\n";
+        }
+
+        if (eval 'symlink($target, "$Dest_dir/$dirlink")') {
+            print "Linking $target -> $Dest_dir/$dirlink\n";
+
+            # Make sure that the link _links_ to something:
+            if (! -e "$Dest_dir/$target") {
+                mkpath("$Dest_dir/$target", 0755) or
+                    print STDERR "Could not create $Dest_dir/$target/\n";
+            }
+        } else {
+            print STDERR "Could not symlink $target -> $Dest_dir/$dirlink:  $!\n";
+        }
+    }
+}
+
+
+# Push all #included files in $file onto our stack, except for STDIN
+# and files we've already processed.
+sub queue_includes_from
+{
+    my ($file)    = @_;
+    my $line;
+
+    return if ($file eq "-");
+
+    open HEADER, $file or return;
+        while (defined($line = <HEADER>)) {
+            while (/\\$/) { # Handle continuation lines
+                chop $line;
+                $line .= <HEADER>;
+            }
+
+            if ($line =~ /^#\s*include\s+<(.*?)>/) {
+                push(@ARGV, $1) unless $Is_converted{$1};
+            }
+        }
+    close HEADER;
+}
+
+
+# Determine include directories; $Config{usrinc} should be enough for (all
+# non-GCC?) C compilers, but gcc uses an additional include directory.
+sub inc_dirs
+{
+    my $from_gcc    = `LC_ALL=C $Config{cc} -v 2>&1`;
+    if( !( $from_gcc =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s ) )
+    { # gcc-4+ :
+       $from_gcc   = `LC_ALL=C $Config{cc} -print-search-dirs 2>&1`;
+       if ( !($from_gcc =~ s/^install:\s*([^\s]+[^\s\/])([\s\/]*).*$/$1\/include/s) )
+       {
+           $from_gcc = '';
+       };
+    };
+    length($from_gcc) ? ($from_gcc, $Config{usrinc}) : ($Config{usrinc});
+}
+
+
+# Create "_h2ph_pre.ph", if it doesn't exist or was built by a different
+# version of h2ph.
+sub build_preamble_if_necessary
+{
+    # Increment $VERSION every time this function is modified:
+    my $VERSION     = 2;
+    my $preamble    = "$Dest_dir/_h2ph_pre.ph";
+
+    # Can we skip building the preamble file?
+    if (-r $preamble) {
+        # Extract version number from first line of preamble:
+        open  PREAMBLE, $preamble or die "Cannot open $preamble:  $!";
+            my $line = <PREAMBLE>;
+            $line =~ /(\b\d+\b)/;
+        close PREAMBLE            or die "Cannot close $preamble:  $!";
+
+        # Don't build preamble if a compatible preamble exists:
+        return if $1 == $VERSION;
+    }
+
+    my (%define) = _extract_cc_defines();
+
+    open  PREAMBLE, ">$preamble" or die "Cannot open $preamble:  $!";
+        print PREAMBLE "# This file was created by h2ph version $VERSION\n";
+
+        foreach (sort keys %define) {
+            if ($opt_D) {
+                print PREAMBLE "# $_=$define{$_}\n";
+            }
+
+            if ($define{$_} =~ /^(\d+)U?L{0,2}$/i) {
+                print PREAMBLE
+                    "unless (defined &$_) { sub $_() { $1 } }\n\n";
+            } elsif ($define{$_} =~ /^\w+$/) {
+                print PREAMBLE
+                    "unless (defined &$_) { sub $_() { &$define{$_} } }\n\n";
+            } else {
+                print PREAMBLE
+                    "unless (defined &$_) { sub $_() { \"",
+                    quotemeta($define{$_}), "\" } }\n\n";
+            }
+        }
+    close PREAMBLE               or die "Cannot close $preamble:  $!";
+}
+
+
+# %Config contains information on macros that are pre-defined by the
+# system's compiler.  We need this information to make the .ph files
+# function with perl as the .h files do with cc.
+sub _extract_cc_defines
+{
+    my %define;
+    my $allsymbols  = join " ",
+        @Config{'ccsymbols', 'cppsymbols', 'cppccsymbols'};
+
+    # Split compiler pre-definitions into `key=value' pairs:
+    foreach (split /\s+/, $allsymbols) {
+        /(.+?)=(.+)/ and $define{$1} = $2;
+
+        if ($opt_D) {
+            print STDERR "$_:  $1 -> $2\n";
+        }
+    }
+
+    return %define;
+}
+
+
+1;
+
+##############################################################################
+__END__
+
+=head1 NAME
+
+h2ph - convert .h C header files to .ph Perl header files
+
+=head1 SYNOPSIS
+
+B<h2ph [-d destination directory] [-r | -a] [-l] [headerfiles]>
+
+=head1 DESCRIPTION
+
+I<h2ph>
+converts any C header files specified to the corresponding Perl header file
+format.
+It is most easily run while in /usr/include:
+
+	cd /usr/include; h2ph * sys/*
+
+or
+
+	cd /usr/include; h2ph * sys/* arpa/* netinet/*
+
+or
+
+	cd /usr/include; h2ph -r -l .
+
+The output files are placed in the hierarchy rooted at Perl's
+architecture dependent library directory.  You can specify a different
+hierarchy with a B<-d> switch.
+
+If run with no arguments, filters standard input to standard output.
+
+=head1 OPTIONS
+
+=over 4
+
+=item -d destination_dir
+
+Put the resulting B<.ph> files beneath B<destination_dir>, instead of
+beneath the default Perl library location (C<$Config{'installsitsearch'}>).
+
+=item -r
+
+Run recursively; if any of B<headerfiles> are directories, then run I<h2ph>
+on all files in those directories (and their subdirectories, etc.).  B<-r>
+and B<-a> are mutually exclusive.
+
+=item -a
+
+Run automagically; convert B<headerfiles>, as well as any B<.h> files
+which they include.  This option will search for B<.h> files in all
+directories which your C compiler ordinarily uses.  B<-a> and B<-r> are
+mutually exclusive.
+
+=item -l
+
+Symbolic links will be replicated in the destination directory.  If B<-l>
+is not specified, then links are skipped over.
+
+=item -h
+
+Put ``hints'' in the .ph files which will help in locating problems with
+I<h2ph>.  In those cases when you B<require> a B<.ph> file containing syntax
+errors, instead of the cryptic
+
+	[ some error condition ] at (eval mmm) line nnn
+
+you will see the slightly more helpful
+
+	[ some error condition ] at filename.ph line nnn
+
+However, the B<.ph> files almost double in size when built using B<-h>.
+
+=item -D
+
+Include the code from the B<.h> file as a comment in the B<.ph> file.
+This is primarily used for debugging I<h2ph>.
+
+=item -Q
+
+``Quiet'' mode; don't print out the names of the files being converted.
+
+=back
+
+=head1 ENVIRONMENT
+
+No environment variables are used.
+
+=head1 FILES
+
+ /usr/include/*.h
+ /usr/include/sys/*.h
+
+etc.
+
+=head1 AUTHOR
+
+Larry Wall
+
+=head1 SEE ALSO
+
+perl(1)
+
+=head1 DIAGNOSTICS
+
+The usual warnings if it can't read or write the files involved.
+
+=head1 BUGS
+
+Doesn't construct the %sizeof array for you.
+
+It doesn't handle all C constructs, but it does attempt to isolate
+definitions inside evals so that you can get at the definitions
+that it can translate.
+
+It's only intended as a rough tool.
+You may need to dicker with the files produced.
+
+You have to run this program by hand; it's not run as part of the Perl
+installation.
+
+Doesn't handle complicated expressions built piecemeal, a la:
+
+    enum {
+        FIRST_VALUE,
+        SECOND_VALUE,
+    #ifdef ABC
+        THIRD_VALUE
+    #endif
+    };
+
+Doesn't necessarily locate all of your C compiler's internally-defined
+symbols.
+
+=cut
+
+
+__END__
+:endofperl

Perl/bin/instmodsh.bat

@@ -0,0 +1,211 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+	if $running_under_some_shell;
+#!/usr/bin/perl -w
+
+use strict;
+use IO::File;
+use ExtUtils::Packlist;
+use ExtUtils::Installed;
+
+use vars qw($Inst @Modules);
+
+
+=head1 NAME
+
+instmodsh - A shell to examine installed modules
+
+=head1 SYNOPSIS
+
+    instmodsh
+
+=head1 DESCRIPTION
+
+A little interface to ExtUtils::Installed to examine installed modules,
+validate your packlists and even create a tarball from an installed module.
+
+=head1 SEE ALSO
+
+ExtUtils::Installed
+
+=cut
+
+
+my $Module_Help = <<EOF;
+Available commands are:
+   f [all|prog|doc]   - List installed files of a given type
+   d [all|prog|doc]   - List the directories used by a module
+   v                  - Validate the .packlist - check for missing files
+   t <tarfile>        - Create a tar archive of the module
+   h                  - Display module help
+   q                  - Quit the module
+EOF
+
+my %Module_Commands = (
+                       f => \&list_installed,
+                       d => \&list_directories,
+                       v => \&validate_packlist,
+                       t => \&create_archive,
+                       h => \&module_help,
+                      );
+
+sub do_module($) {
+    my ($module) = @_;
+
+    print($Module_Help);
+    MODULE_CMD: while (1) {
+        print("$module cmd? ");
+
+        my $reply = <STDIN>; chomp($reply);
+        my($cmd) = $reply =~ /^(\w)\b/;
+
+        last if $cmd eq 'q';
+
+        if( $Module_Commands{$cmd} ) {
+            $Module_Commands{$cmd}->($reply, $module);
+        }
+        elsif( $cmd eq 'q' ) {
+            last MODULE_CMD;
+        }
+        else {
+            module_help();
+        }
+    }
+}
+
+
+sub list_installed {
+    my($reply, $module) = @_;
+
+    my $class = (split(' ', $reply))[1];
+    $class = 'all' unless $class;
+
+    my @files;
+    if (eval { @files = $Inst->files($module, $class); }) {
+        print("$class files in $module are:\n   ",
+              join("\n   ", @files), "\n");
+    }
+    else { 
+        print($@); 
+    }
+};
+
+
+sub list_directories {
+    my($reply, $module) = @_;
+
+    my $class = (split(' ', $reply))[1];
+    $class = 'all' unless $class;
+
+    my @dirs;
+    if (eval { @dirs = $Inst->directories($module, $class); }) {
+        print("$class directories in $module are:\n   ",
+              join("\n   ", @dirs), "\n");
+    }
+    else { 
+        print($@); 
+    }
+}
+
+
+sub create_archive {
+    my($reply, $module) = @_;
+
+    my $file = (split(' ', $reply))[1];
+
+    if( !(defined $file and length $file) ) {
+        print "No tar file specified\n";
+    }
+    elsif( eval { require Archive::Tar } ) {
+        Archive::Tar->create_archive($file, 0, $Inst->files($module));
+    }
+    else {
+        my($first, @rest) = $Inst->files($module);
+        system('tar', 'cvf', $file, $first);
+        for my $f (@rest) {
+            system('tar', 'rvf', $file, $f);
+        }
+        print "Can't use tar\n" if $?;
+    }
+}
+
+
+sub validate_packlist {
+    my($reply, $module) = @_;
+
+    if (my @missing = $Inst->validate($module)) {
+        print("Files missing from $module are:\n   ",
+              join("\n   ", @missing), "\n");
+    }
+    else {
+        print("$module has no missing files\n");
+    }
+}
+
+sub module_help {
+    print $Module_Help;
+}
+
+
+
+##############################################################################
+
+sub toplevel()
+{
+my $help = <<EOF;
+Available commands are:
+   l            - List all installed modules
+   m <module>   - Select a module
+   q            - Quit the program
+EOF
+print($help);
+while (1)
+   {
+   print("cmd? ");
+   my $reply = <STDIN>; chomp($reply);
+   CASE:
+      {
+      $reply eq 'l' and do
+         {
+         print("Installed modules are:\n   ", join("\n   ", @Modules), "\n");
+         last CASE;
+         };
+      $reply =~ /^m\s+/ and do
+         {
+         do_module((split(' ', $reply))[1]);
+         last CASE;
+         };
+      $reply eq 'q' and do
+         {
+         exit(0);
+         };
+      # Default
+         print($help);
+      }
+   }
+}
+
+
+###############################################################################
+
+$Inst = ExtUtils::Installed->new();
+@Modules = $Inst->modules();
+toplevel();
+
+###############################################################################
+
+__END__
+:endofperl

Perl/bin/libnetcfg.bat

@@ -0,0 +1,737 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+	if $running_under_some_shell;
+
+=head1 NAME
+
+libnetcfg - configure libnet
+
+=head1 DESCRIPTION
+
+The libnetcfg utility can be used to configure the libnet.
+Starting from perl 5.8 libnet is part of the standard Perl
+distribution, but the libnetcfg can be used for any libnet
+installation.
+
+=head1 USAGE
+
+Without arguments libnetcfg displays the current configuration.
+
+    $ libnetcfg
+    # old config ./libnet.cfg
+    daytime_hosts        ntp1.none.such
+    ftp_int_passive      0
+    ftp_testhost         ftp.funet.fi
+    inet_domain          none.such
+    nntp_hosts           nntp.none.such
+    ph_hosts             
+    pop3_hosts           pop.none.such
+    smtp_hosts           smtp.none.such
+    snpp_hosts           
+    test_exist           1
+    test_hosts           1
+    time_hosts           ntp.none.such
+    # libnetcfg -h for help
+    $ 
+
+It tells where the old configuration file was found (if found).
+
+The C<-h> option will show a usage message.
+
+To change the configuration you will need to use either the C<-c> or
+the C<-d> options.
+
+The default name of the old configuration file is by default
+"libnet.cfg", unless otherwise specified using the -i option,
+C<-i oldfile>, and it is searched first from the current directory,
+and then from your module path.
+
+The default name of the new configuration file is "libnet.cfg", and by
+default it is written to the current directory, unless otherwise
+specified using the -o option, C<-o newfile>.
+
+=head1 SEE ALSO
+
+L<Net::Config>, L<Net::libnetFAQ>
+
+=head1 AUTHORS
+
+Graham Barr, the original Configure script of libnet.
+
+Jarkko Hietaniemi, conversion into libnetcfg for inclusion into Perl 5.8.
+
+=cut
+
+# $Id: Configure,v 1.8 1997/03/04 09:22:32 gbarr Exp $
+
+use strict;
+use IO::File;
+use Getopt::Std;
+use ExtUtils::MakeMaker qw(prompt);
+use File::Spec;
+
+use vars qw($opt_d $opt_c $opt_h $opt_o $opt_i);
+
+##
+##
+##
+
+my %cfg = ();
+my @cfg = ();
+
+my($libnet_cfg_in,$libnet_cfg_out,$msg,$ans,$def,$have_old);
+
+##
+##
+##
+
+sub valid_host
+{
+ my $h = shift;
+
+ defined($h) && (($cfg{'test_exist'} == 0) || gethostbyname($h));
+}
+
+##
+##
+##
+
+sub test_hostnames (\@)
+{
+ my $hlist = shift;
+ my @h = ();
+ my $host;
+ my $err = 0;
+
+ foreach $host (@$hlist)
+  {
+   if(valid_host($host))
+    {
+     push(@h, $host);
+     next;
+    }
+   warn "Bad hostname: '$host'\n";
+   $err++;
+  }
+ @$hlist = @h;
+ $err ? join(" ",@h) : undef;
+}
+
+##
+##
+##
+
+sub Prompt
+{
+ my($prompt,$def) = @_;
+
+ $def = "" unless defined $def;
+
+ chomp($prompt);
+
+ if($opt_d)
+  {
+   print $prompt,," [",$def,"]\n";
+   return $def;
+  }
+ prompt($prompt,$def);
+}
+
+##
+##
+##
+
+sub get_host_list
+{
+ my($prompt,$def) = @_;
+
+ $def = join(" ",@$def) if ref($def);
+
+ my @hosts;
+
+ do
+  {
+   my $ans = Prompt($prompt,$def);
+
+   $ans =~ s/(\A\s+|\s+\Z)//g;
+
+   @hosts = split(/\s+/, $ans);
+  }
+ while(@hosts && defined($def = test_hostnames(@hosts)));
+
+ \@hosts;
+}
+
+##
+##
+##
+
+sub get_hostname
+{
+ my($prompt,$def) = @_;
+
+ my $host;
+
+ while(1)
+  {
+   my $ans = Prompt($prompt,$def);
+   $host = ($ans =~ /(\S*)/)[0];
+   last
+	if(!length($host) || valid_host($host));
+
+   $def =""
+	if $def eq $host;
+
+   print <<"EDQ";
+
+*** ERROR:
+    Hostname `$host' does not seem to exist, please enter again
+    or a single space to clear any default
+
+EDQ
+  }
+
+ length $host
+	? $host
+	: undef;
+}
+
+##
+##
+##
+
+sub get_bool ($$)
+{
+ my($prompt,$def) = @_;
+
+ chomp($prompt);
+
+ my $val = Prompt($prompt,$def ? "yes" : "no");
+
+ $val =~ /^y/i ? 1 : 0;
+}
+
+##
+##
+##
+
+sub get_netmask ($$)
+{
+ my($prompt,$def) = @_;
+
+ chomp($prompt);
+
+ my %list;
+ @list{@$def} = ();
+
+MASK:
+ while(1) {
+   my $bad = 0;
+   my $ans = Prompt($prompt) or last;
+
+   if($ans eq '*') {
+     %list = ();
+     next;
+   }
+
+   if($ans eq '=') {
+     print "\n",( %list ? join("\n", sort keys %list) : 'none'),"\n\n";
+     next;
+   }
+
+   unless ($ans =~ m{^\s*(?:(-?\s*)(\d+(?:\.\d+){0,3})/(\d+))}) {
+     warn "Bad netmask '$ans'\n";
+     next;
+   }
+
+   my($remove,$bits,@ip) = ($1,$3,split(/\./, $2),0,0,0);
+   if ( $ip[0] < 1 || $bits < 1 || $bits > 32) {
+     warn "Bad netmask '$ans'\n";
+     next MASK;
+   }
+   foreach my $byte (@ip) {
+     if ( $byte > 255 ) {
+       warn "Bad netmask '$ans'\n";
+       next MASK;
+     }
+   } 
+
+   my $mask = sprintf("%d.%d.%d.%d/%d",@ip[0..3],$bits); 
+
+   if ($remove) {
+     delete $list{$mask};
+   }
+   else {
+     $list{$mask} = 1;
+   }
+
+  }
+
+ [ keys %list ];
+}
+
+##
+##
+##
+
+sub default_hostname
+{
+ my $host;
+ my @host;
+
+ foreach $host (@_)
+  {
+   if(defined($host) && valid_host($host))
+    {
+     return $host
+	unless wantarray;
+     push(@host,$host);
+    }
+  }
+
+ return wantarray ? @host : undef;
+}
+
+##
+##
+##
+
+getopts('dcho:i:');
+
+$libnet_cfg_in = "libnet.cfg"
+	unless(defined($libnet_cfg_in  = $opt_i));
+
+$libnet_cfg_out = "libnet.cfg"
+	unless(defined($libnet_cfg_out = $opt_o));
+
+my %oldcfg = ();
+
+$Net::Config::CONFIGURE = 1; # Suppress load of user overrides
+if( -f $libnet_cfg_in )
+ {
+  %oldcfg = ( %{ do $libnet_cfg_in } );
+ }
+elsif (eval { require Net::Config }) 
+ {
+  $have_old = 1;
+  %oldcfg = %Net::Config::NetConfig;
+ }
+
+map { $cfg{lc $_} = $cfg{$_}; delete $cfg{$_} if /[A-Z]/ } keys %cfg;
+
+#---------------------------------------------------------------------------
+
+if ($opt_h) {
+ print <<EOU;
+$0: Usage: $0 [-c] [-d] [-i oldconfigile] [-o newconfigfile] [-h]
+Without options, the old configuration is shown.
+
+   -c change the configuration
+   -d use defaults from the old config (implies -c, non-interactive)
+   -i use a specific file as the old config file
+   -o use a specific file as the new config file
+   -h show this help
+
+The default name of the old configuration file is by default
+"libnet.cfg", unless otherwise specified using the -i option,
+C<-i oldfile>, and it is searched first from the current directory,
+and then from your module path.
+
+The default name of the new configuration file is "libnet.cfg", and by
+default it is written to the current directory, unless otherwise
+specified using the -o option.
+
+EOU
+ exit(0);
+}
+
+#---------------------------------------------------------------------------
+
+{
+   my $oldcfgfile;
+   my @inc;
+   push @inc, $ENV{PERL5LIB} if exists $ENV{PERL5LIB};
+   push @inc, $ENV{PERLLIB}  if exists $ENV{PERLLIB};
+   push @inc, @INC;
+   for (@inc) {
+    my $trycfgfile = File::Spec->catfile($_, $libnet_cfg_in);
+    if (-f $trycfgfile && -r $trycfgfile) {
+     $oldcfgfile = $trycfgfile;
+     last;
+    }
+   }
+   print "# old config $oldcfgfile\n" if defined $oldcfgfile;
+   for (sort keys %oldcfg) {
+	printf "%-20s %s\n", $_,
+               ref $oldcfg{$_} ? @{$oldcfg{$_}} : $oldcfg{$_};
+   }
+   unless ($opt_c || $opt_d) {
+    print "# $0 -h for help\n";
+    exit(0);
+   }
+}
+
+#---------------------------------------------------------------------------
+
+$oldcfg{'test_exist'} = 1 unless exists $oldcfg{'test_exist'};
+$oldcfg{'test_hosts'} = 1 unless exists $oldcfg{'test_hosts'};
+
+#---------------------------------------------------------------------------
+
+if($have_old && !$opt_d)
+ {
+  $msg = <<EDQ;
+
+Ah, I see you already have installed libnet before.
+
+Do you want to modify/update your configuration (y|n) ?
+EDQ
+
+ $opt_d = 1
+	unless get_bool($msg,0);
+ }
+
+#---------------------------------------------------------------------------
+
+$msg = <<EDQ;
+
+This script will prompt you to enter hostnames that can be used as
+defaults for some of the modules in the libnet distribution.
+
+To ensure that you do not enter an invalid hostname, I can perform a
+lookup on each hostname you enter. If your internet connection is via
+a dialup line then you may not want me to perform these lookups, as
+it will require you to be on-line.
+
+Do you want me to perform hostname lookups (y|n) ?
+EDQ
+
+$cfg{'test_exist'} = get_bool($msg, $oldcfg{'test_exist'});
+
+print <<EDQ unless $cfg{'test_exist'};
+
+*** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
+
+OK I will not check if the hostnames you give are valid
+so be very cafeful
+
+*** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
+EDQ
+
+
+#---------------------------------------------------------------------------
+
+print <<EDQ;
+
+The following questions all require a list of host names, separated
+with spaces. If you do not have a host available for any of the
+services, then enter a single space, followed by <CR>. To accept the
+default, hit <CR>
+
+EDQ
+
+$msg = 'Enter a list of available NNTP hosts :';
+
+$def = $oldcfg{'nntp_hosts'} ||
+	[ default_hostname($ENV{NNTPSERVER},$ENV{NEWSHOST},'news') ];
+
+$cfg{'nntp_hosts'} = get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = 'Enter a list of available SMTP hosts :';
+
+$def = $oldcfg{'smtp_hosts'} ||
+	[ default_hostname(split(/:/,$ENV{SMTPHOSTS} || ""), 'mailhost') ];
+
+$cfg{'smtp_hosts'} = get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = 'Enter a list of available POP3 hosts :';
+
+$def = $oldcfg{'pop3_hosts'} || [];
+
+$cfg{'pop3_hosts'} = get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = 'Enter a list of available SNPP hosts :';
+
+$def = $oldcfg{'snpp_hosts'} || [];
+
+$cfg{'snpp_hosts'} = get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = 'Enter a list of available PH Hosts   :'  ;
+
+$def = $oldcfg{'ph_hosts'} ||
+	[ default_hostname('dirserv') ];
+
+$cfg{'ph_hosts'}   =  get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = 'Enter a list of available TIME Hosts   :'  ;
+
+$def = $oldcfg{'time_hosts'} || [];
+
+$cfg{'time_hosts'} = get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = 'Enter a list of available DAYTIME Hosts   :'  ;
+
+$def = $oldcfg{'daytime_hosts'} || $oldcfg{'time_hosts'};
+
+$cfg{'daytime_hosts'} = get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = <<EDQ;
+
+Do you have a firewall/ftp proxy  between your machine and the internet 
+
+If you use a SOCKS firewall answer no
+
+(y|n) ?
+EDQ
+
+if(get_bool($msg,0)) {
+
+  $msg = <<'EDQ';
+What series of FTP commands do you need to send to your
+firewall to connect to an external host.
+
+user/pass     => external user & password
+fwuser/fwpass => firewall user & password
+
+0) None
+1) -----------------------
+     USER user@remote.host
+     PASS pass
+2) -----------------------
+     USER fwuser
+     PASS fwpass
+     USER user@remote.host
+     PASS pass
+3) -----------------------
+     USER fwuser
+     PASS fwpass
+     SITE remote.site
+     USER user
+     PASS pass
+4) -----------------------
+     USER fwuser
+     PASS fwpass
+     OPEN remote.site
+     USER user
+     PASS pass
+5) -----------------------
+     USER user@fwuser@remote.site
+     PASS pass@fwpass
+6) -----------------------
+     USER fwuser@remote.site
+     PASS fwpass
+     USER user
+     PASS pass
+7) -----------------------
+     USER user@remote.host
+     PASS pass
+     AUTH fwuser
+     RESP fwpass
+
+Choice:
+EDQ
+ $def = exists $oldcfg{'ftp_firewall_type'}  ? $oldcfg{'ftp_firewall_type'} : 1;
+ $ans = Prompt($msg,$def);
+ $cfg{'ftp_firewall_type'} = 0+$ans;
+ $def = $oldcfg{'ftp_firewall'} || $ENV{FTP_FIREWALL};
+
+ $cfg{'ftp_firewall'} = get_hostname("FTP proxy hostname :", $def);
+}
+else {
+ delete $cfg{'ftp_firewall'};
+}
+
+
+#---------------------------------------------------------------------------
+
+if (defined $cfg{'ftp_firewall'})
+ {
+  print <<EDQ;
+
+By default Net::FTP assumes that it only needs to use a firewall if it
+cannot resolve the name of the host given. This only works if your DNS
+system is setup to only resolve internal hostnames. If this is not the
+case and your DNS will resolve external hostnames, then another method
+is needed. Net::Config can do this if you provide the netmasks that
+describe your internal network. Each netmask should be entered in the
+form x.x.x.x/y, for example 127.0.0.0/8 or 214.8.16.32/24
+
+EDQ
+$def = [];
+if(ref($oldcfg{'local_netmask'}))
+ {
+  $def = $oldcfg{'local_netmask'};
+   print "Your current netmasks are :\n\n\t",
+	join("\n\t",@{$def}),"\n\n";
+ }
+
+print "
+Enter one netmask at each prompt, prefix with a - to remove a netmask
+from the list, enter a '*' to clear the whole list, an '=' to show the
+current list and an empty line to continue with Configure.
+
+";
+
+  my $mask = get_netmask("netmask :",$def);
+  $cfg{'local_netmask'} = $mask if ref($mask) && @$mask;
+ }
+
+#---------------------------------------------------------------------------
+
+###$msg =<<EDQ;
+###
+###SOCKS is a commonly used firewall protocol. If you use SOCKS firewalls
+###then enter a list of hostames
+###
+###Enter a list of available SOCKS hosts :
+###EDQ
+###
+###$def = $cfg{'socks_hosts'} ||
+###	[ default_hostname($ENV{SOCKS5_SERVER},
+###			   $ENV{SOCKS_SERVER},
+###			   $ENV{SOCKS4_SERVER}) ];
+###
+###$cfg{'socks_hosts'}   =  get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+print <<EDQ;
+
+Normally when FTP needs a data connection the client tells the server
+a port to connect to, and the server initiates a connection to the client.
+
+Some setups, in particular firewall setups, can/do not work using this
+protocol. In these situations the client must make the connection to the
+server, this is called a passive transfer.
+EDQ
+
+if (defined $cfg{'ftp_firewall'}) {
+  $msg = "\nShould all FTP connections via a firewall/proxy be passive (y|n) ?";
+
+  $def = $oldcfg{'ftp_ext_passive'} || 0;
+
+  $cfg{'ftp_ext_passive'} = get_bool($msg,$def);
+
+  $msg = "\nShould all other FTP connections be passive (y|n) ?";
+
+}
+else {
+  $msg = "\nShould all FTP connections be passive (y|n) ?";
+}
+
+$def = $oldcfg{'ftp_int_passive'} || 0;
+
+$cfg{'ftp_int_passive'} = get_bool($msg,$def);
+
+
+#---------------------------------------------------------------------------
+
+$def = $oldcfg{'inet_domain'} || $ENV{LOCALDOMAIN};
+
+$ans = Prompt("\nWhat is your local internet domain name :",$def);
+
+$cfg{'inet_domain'} = ($ans =~ /(\S+)/)[0];
+
+#---------------------------------------------------------------------------
+
+$msg = <<EDQ;
+
+If you specified some default hosts above, it is possible for me to
+do some basic tests when you run `make test'
+
+This will cause `make test' to be quite a bit slower and, if your
+internet connection is via dialup, will require you to be on-line
+unless the hosts are local.
+
+Do you want me to run these tests (y|n) ?
+EDQ
+
+$cfg{'test_hosts'} = get_bool($msg,$oldcfg{'test_hosts'});
+
+#---------------------------------------------------------------------------
+
+$msg = <<EDQ;
+
+To allow Net::FTP to be tested I will need a hostname. This host
+should allow anonymous access and have a /pub directory
+
+What host can I use :
+EDQ
+
+$cfg{'ftp_testhost'} = get_hostname($msg,$oldcfg{'ftp_testhost'})
+	if $cfg{'test_hosts'};
+
+
+print "\n";
+
+#---------------------------------------------------------------------------
+
+my $fh = IO::File->new($libnet_cfg_out, "w") or
+	die "Cannot create `$libnet_cfg_out': $!";
+
+print "Writing $libnet_cfg_out\n";
+
+print $fh "{\n";
+
+my $key;
+foreach $key (keys %cfg) {
+    my $val = $cfg{$key};
+    if(!defined($val)) {
+	$val = "undef";
+    }
+    elsif(ref($val)) {
+	$val = '[' . join(",",
+	    map {
+		my $v = "undef";
+		if(defined $_) {
+		    ($v = $_) =~ s/'/\'/sog;
+		    $v = "'" . $v . "'";
+		}
+		$v;
+	    } @$val ) . ']';
+    }
+    else {
+	$val =~ s/'/\'/sog;
+	$val = "'" . $val . "'" if $val =~ /\D/;
+    }
+    print $fh "\t'",$key,"' => ",$val,",\n";
+}
+
+print $fh "}\n";
+
+$fh->close;
+
+############################################################################
+############################################################################
+
+exit 0;
+
+__END__
+:endofperl

Perl/bin/lwp-download

@@ -0,0 +1,332 @@
+#!/usr/bin/perl -w
+
+# $Id: lwp-download,v 2.15 2004/12/11 14:02:59 gisle Exp $
+
+=head1 NAME
+
+lwp-download - Fetch large files from the web
+
+=head1 SYNOPSIS
+
+B<lwp-download> [B<-a>] <I<url>> [<I<local path>>]
+
+=head1 DESCRIPTION
+
+The B<lwp-download> program will save the file at I<url> to a local
+file.
+
+If I<local path> is not specified, then the current directory is
+assumed.
+
+If I<local path> is a directory, then the basename of the file to save
+is picked up from the Content-Disposition header or the URL of the
+response.  If the file already exists, then B<lwp-download> will
+prompt before it overwrites and will fail if its standard input is not
+a terminal.  This form of invocation will also fail is no acceptable
+filename can be derived from the sources mentioned above.
+
+If I<local path> is not a directory, then it is simply used as the
+path to save into.
+
+The I<lwp-download> program is implemented using the I<libwww-perl>
+library.  It is better suited to down load big files than the
+I<lwp-request> program because it does not store the file in memory.
+Another benefit is that it will keep you updated about its progress
+and that you don't have much options to worry about.
+
+Use the C<-a> option to save the file in text (ascii) mode.  Might
+make a difference on dosish systems.
+
+=head1 EXAMPLE
+
+Fetch the newest and greatest perl version:
+
+ $ lwp-download http://www.perl.com/CPAN/src/latest.tar.gz
+ Saving to 'latest.tar.gz'...
+ 11.4 MB received in 8 seconds (1.43 MB/sec)
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@aas.no>
+
+=cut
+
+#' get emacs out of quote mode
+
+use strict;
+
+use LWP::UserAgent ();
+use LWP::MediaTypes qw(guess_media_type media_suffix);
+use URI ();
+use HTTP::Date ();
+
+my $progname = $0;
+$progname =~ s,.*/,,;    # only basename left in progname
+$progname =~ s,.*\\,, if $^O eq "MSWin32";
+$progname =~ s/\.\w*$//; # strip extension if any
+
+#parse option
+use Getopt::Std;
+my %opt;
+unless (getopts('a', \%opt)) {
+    usage();
+}
+
+my $url = URI->new(shift || usage());
+my $argfile = shift;
+usage() if defined($argfile) && !length($argfile);
+my $version = q$Revision: 2.15 $;
+$version =~ s/[^\d.]//g;
+
+my $ua = LWP::UserAgent->new(
+   agent => "lwp-download/$version ",
+   keep_alive => 1,
+   env_proxy => 1,
+);
+
+my $file;      # name of file we download into
+my $length;    # total number of bytes to download
+my $flength;   # formatted length
+my $size = 0;  # number of bytes received
+my $start_t;   # start time of download
+my $last_dur;  # time of last callback
+
+my $shown = 0; # have we called the show() function yet
+
+$SIG{INT} = sub { die "Interrupted\n"; };
+
+$| = 1;  # autoflush
+
+my $res = $ua->request(HTTP::Request->new(GET => $url),
+  sub {
+      unless(defined $file) {
+	  my $res = $_[1];
+
+	  my $directory;
+	  if (defined $argfile && -d $argfile) {
+	      ($directory, $argfile) = ($argfile, undef);
+	  }
+
+	  unless (defined $argfile) {
+	      # must find a suitable name to use.  First thing
+	      # to do is to look for the "Content-Disposition"
+	      # header defined by RFC1806.  This is also supported
+	      # by Netscape
+	      my $cd = $res->header("Content-Disposition");
+	      if ($cd && $cd =~ /\bfilename\s*=\s*(\S+)/) {
+		  $file = $1;
+		  $file =~ s/;$//;
+		  $file =~ s/^([\"\'])(.*)\1$/$2/;
+		  $file =~ s,.*[\\/],,;  # basename
+	      }
+
+	      # if this fails we try to make something from the URL
+	      unless ($file) {
+		  my $req = $res->request;  # now always there
+		  my $rurl = $req ? $req->url : $url;
+
+		  $file = ($rurl->path_segments)[-1];
+		  if (!defined($file) || !length($file)) {
+		      $file = "index";
+		      my $suffix = media_suffix($res->content_type);
+		      $file .= ".$suffix" if $suffix;
+		  }
+		  elsif ($rurl->scheme eq 'ftp' ||
+			   $file =~ /\.t[bg]z$/   ||
+			   $file =~ /\.tar(\.(Z|gz|bz2?))?$/
+			  ) {
+		      # leave the filename as it was
+		  }
+		  else {
+		      my $ct = guess_media_type($file);
+		      unless ($ct eq $res->content_type) {
+			  # need a better suffix for this type
+			  my $suffix = media_suffix($res->content_type);
+			  $file .= ".$suffix" if $suffix;
+		      }
+		  }
+	      }
+
+	      # validate that we don't have a harmful filename now.  The server
+	      # might try to trick us into doing something bad.
+	      if (!length($file) ||
+                  $file =~ s/([^a-zA-Z0-9\.\-\+\~])/sprintf "\\x%02x", ord($1)/ge)
+              {
+		  die "Will not save <$url> as \"$file\".\nPlease override file name on the command line.\n";
+	      }
+
+	      if (defined $directory) {
+	          require File::Spec;
+	          $file = File::Spec->catfile($directory, $file);
+	      }
+
+	      # Check if the file is already present
+	      if (-l $file) {
+		  die "Will not save <$url> to link \"$file\".\nPlease override file name on the command line.\n";
+	      }
+	      elsif (-f _) {
+		  die "Will not save <$url> as \"$file\" without verification.\nEither run from terminal or override file name on the command line.\n"
+		      unless -t;
+		  $shown = 1;
+		  print "Overwrite $file? [y] ";
+		  my $ans = <STDIN>;
+		  unless (defined($ans) && $ans =~ /^y?\n/) {
+		      if (defined $ans) {
+			  print "Ok, aborting.\n";
+		      }
+		      else {
+			  print "\nAborting.\n";
+		      }
+		      exit 1;
+		  }
+		  $shown = 0;
+	      }
+	      elsif (-e _) {
+		  die "Will not save <$url> as \"$file\".  Path exists.\n";
+	      }
+	      else {
+		  print "Saving to '$file'...\n";
+	      }
+	  }
+	  else {
+	      $file = $argfile;
+	  }
+	  open(FILE, ">$file") || die "Can't open $file: $!\n";
+          binmode FILE unless $opt{a};
+	  $length = $res->content_length;
+	  $flength = fbytes($length) if defined $length;
+	  $start_t = time;
+	  $last_dur = 0;
+      }
+
+      print FILE $_[0] or die "Can't write to $file: $!\n";
+      $size += length($_[0]);
+
+      if (defined $length) {
+	  my $dur  = time - $start_t;
+	  if ($dur != $last_dur) {  # don't update too often
+	      $last_dur = $dur;
+	      my $perc = $size / $length;
+	      my $speed;
+	      $speed = fbytes($size/$dur) . "/sec" if $dur > 3;
+	      my $secs_left = fduration($dur/$perc - $dur);
+	      $perc = int($perc*100);
+	      my $show = "$perc% of $flength";
+	      $show .= " (at $speed, $secs_left remaining)" if $speed;
+	      show($show, 1);
+	  }
+      }
+      else {
+	  show( fbytes($size) . " received");
+      }
+  }
+);
+
+if (fileno(FILE)) {
+    close(FILE) || die "Can't write to $file: $!\n";
+
+    show("");  # clear text
+    print "\r";
+    print fbytes($size);
+    print " of ", fbytes($length) if defined($length) && $length != $size;
+    print " received";
+    my $dur = time - $start_t;
+    if ($dur) {
+	my $speed = fbytes($size/$dur) . "/sec";
+	print " in ", fduration($dur), " ($speed)";
+    }
+    print "\n";
+
+    if (my $mtime = $res->last_modified) {
+	utime time, $mtime, $file;
+    }
+
+    if ($res->header("X-Died") || !$res->is_success) {
+	if (my $died = $res->header("X-Died")) {
+	    print "$died\n";
+	}
+	if (-t) {
+	    print "Transfer aborted.  Delete $file? [n] ";
+	    my $ans = <STDIN>;
+	    if (defined($ans) && $ans =~ /^y\n/) {
+		unlink($file) && print "Deleted.\n";
+	    }
+	    elsif ($length > $size) {
+		print "Truncated file kept: ", fbytes($length - $size), " missing\n";
+	    }
+	    else {
+		print "File kept.\n";
+	    }
+            exit 1;
+	}
+	else {
+	    print "Transfer aborted, $file kept\n";
+	}
+    }
+    exit 0;
+}
+
+# Did not manage to create any file
+print "\n" if $shown;
+if (my $xdied = $res->header("X-Died")) {
+    print "$progname: Aborted\n$xdied\n";
+}
+else {
+    print "$progname: ", $res->status_line, "\n";
+}
+exit 1;
+
+
+sub fbytes
+{
+    my $n = int(shift);
+    if ($n >= 1024 * 1024) {
+	return sprintf "%.3g MB", $n / (1024.0 * 1024);
+    }
+    elsif ($n >= 1024) {
+	return sprintf "%.3g KB", $n / 1024.0;
+    }
+    else {
+	return "$n bytes";
+    }
+}
+
+sub fduration
+{
+    use integer;
+    my $secs = int(shift);
+    my $hours = $secs / (60*60);
+    $secs -= $hours * 60*60;
+    my $mins = $secs / 60;
+    $secs %= 60;
+    if ($hours) {
+	return "$hours hours $mins minutes";
+    }
+    elsif ($mins >= 2) {
+	return "$mins minutes";
+    }
+    else {
+	$secs += $mins * 60;
+	return "$secs seconds";
+    }
+}
+
+
+BEGIN {
+    my @ani = qw(- \ | /);
+    my $ani = 0;
+
+    sub show
+    {
+        my($mess, $show_ani) = @_;
+        print "\r$mess" . (" " x (75 - length $mess));
+	print $show_ani ? "$ani[$ani++]\b" : " ";
+        $ani %= @ani;
+        $shown++;
+    }
+}
+
+sub usage
+{
+    die "Usage: $progname [-a] <url> [<lpath>]\n";
+}

Perl/bin/lwp-download.bat

@@ -0,0 +1,348 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl -w
+#line 15
+
+# $Id: lwp-download,v 2.15 2004/12/11 14:02:59 gisle Exp $
+
+=head1 NAME
+
+lwp-download - Fetch large files from the web
+
+=head1 SYNOPSIS
+
+B<lwp-download> [B<-a>] <I<url>> [<I<local path>>]
+
+=head1 DESCRIPTION
+
+The B<lwp-download> program will save the file at I<url> to a local
+file.
+
+If I<local path> is not specified, then the current directory is
+assumed.
+
+If I<local path> is a directory, then the basename of the file to save
+is picked up from the Content-Disposition header or the URL of the
+response.  If the file already exists, then B<lwp-download> will
+prompt before it overwrites and will fail if its standard input is not
+a terminal.  This form of invocation will also fail is no acceptable
+filename can be derived from the sources mentioned above.
+
+If I<local path> is not a directory, then it is simply used as the
+path to save into.
+
+The I<lwp-download> program is implemented using the I<libwww-perl>
+library.  It is better suited to down load big files than the
+I<lwp-request> program because it does not store the file in memory.
+Another benefit is that it will keep you updated about its progress
+and that you don't have much options to worry about.
+
+Use the C<-a> option to save the file in text (ascii) mode.  Might
+make a difference on dosish systems.
+
+=head1 EXAMPLE
+
+Fetch the newest and greatest perl version:
+
+ $ lwp-download http://www.perl.com/CPAN/src/latest.tar.gz
+ Saving to 'latest.tar.gz'...
+ 11.4 MB received in 8 seconds (1.43 MB/sec)
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@aas.no>
+
+=cut
+
+#' get emacs out of quote mode
+
+use strict;
+
+use LWP::UserAgent ();
+use LWP::MediaTypes qw(guess_media_type media_suffix);
+use URI ();
+use HTTP::Date ();
+
+my $progname = $0;
+$progname =~ s,.*/,,;    # only basename left in progname
+$progname =~ s,.*\\,, if $^O eq "MSWin32";
+$progname =~ s/\.\w*$//; # strip extension if any
+
+#parse option
+use Getopt::Std;
+my %opt;
+unless (getopts('a', \%opt)) {
+    usage();
+}
+
+my $url = URI->new(shift || usage());
+my $argfile = shift;
+usage() if defined($argfile) && !length($argfile);
+my $version = q$Revision: 2.15 $;
+$version =~ s/[^\d.]//g;
+
+my $ua = LWP::UserAgent->new(
+   agent => "lwp-download/$version ",
+   keep_alive => 1,
+   env_proxy => 1,
+);
+
+my $file;      # name of file we download into
+my $length;    # total number of bytes to download
+my $flength;   # formatted length
+my $size = 0;  # number of bytes received
+my $start_t;   # start time of download
+my $last_dur;  # time of last callback
+
+my $shown = 0; # have we called the show() function yet
+
+$SIG{INT} = sub { die "Interrupted\n"; };
+
+$| = 1;  # autoflush
+
+my $res = $ua->request(HTTP::Request->new(GET => $url),
+  sub {
+      unless(defined $file) {
+	  my $res = $_[1];
+
+	  my $directory;
+	  if (defined $argfile && -d $argfile) {
+	      ($directory, $argfile) = ($argfile, undef);
+	  }
+
+	  unless (defined $argfile) {
+	      # must find a suitable name to use.  First thing
+	      # to do is to look for the "Content-Disposition"
+	      # header defined by RFC1806.  This is also supported
+	      # by Netscape
+	      my $cd = $res->header("Content-Disposition");
+	      if ($cd && $cd =~ /\bfilename\s*=\s*(\S+)/) {
+		  $file = $1;
+		  $file =~ s/;$//;
+		  $file =~ s/^([\"\'])(.*)\1$/$2/;
+		  $file =~ s,.*[\\/],,;  # basename
+	      }
+
+	      # if this fails we try to make something from the URL
+	      unless ($file) {
+		  my $req = $res->request;  # now always there
+		  my $rurl = $req ? $req->url : $url;
+
+		  $file = ($rurl->path_segments)[-1];
+		  if (!defined($file) || !length($file)) {
+		      $file = "index";
+		      my $suffix = media_suffix($res->content_type);
+		      $file .= ".$suffix" if $suffix;
+		  }
+		  elsif ($rurl->scheme eq 'ftp' ||
+			   $file =~ /\.t[bg]z$/   ||
+			   $file =~ /\.tar(\.(Z|gz|bz2?))?$/
+			  ) {
+		      # leave the filename as it was
+		  }
+		  else {
+		      my $ct = guess_media_type($file);
+		      unless ($ct eq $res->content_type) {
+			  # need a better suffix for this type
+			  my $suffix = media_suffix($res->content_type);
+			  $file .= ".$suffix" if $suffix;
+		      }
+		  }
+	      }
+
+	      # validate that we don't have a harmful filename now.  The server
+	      # might try to trick us into doing something bad.
+	      if (!length($file) ||
+                  $file =~ s/([^a-zA-Z0-9\.\-\+\~])/sprintf "\\x%02x", ord($1)/ge)
+              {
+		  die "Will not save <$url> as \"$file\".\nPlease override file name on the command line.\n";
+	      }
+
+	      if (defined $directory) {
+	          require File::Spec;
+	          $file = File::Spec->catfile($directory, $file);
+	      }
+
+	      # Check if the file is already present
+	      if (-l $file) {
+		  die "Will not save <$url> to link \"$file\".\nPlease override file name on the command line.\n";
+	      }
+	      elsif (-f _) {
+		  die "Will not save <$url> as \"$file\" without verification.\nEither run from terminal or override file name on the command line.\n"
+		      unless -t;
+		  $shown = 1;
+		  print "Overwrite $file? [y] ";
+		  my $ans = <STDIN>;
+		  unless (defined($ans) && $ans =~ /^y?\n/) {
+		      if (defined $ans) {
+			  print "Ok, aborting.\n";
+		      }
+		      else {
+			  print "\nAborting.\n";
+		      }
+		      exit 1;
+		  }
+		  $shown = 0;
+	      }
+	      elsif (-e _) {
+		  die "Will not save <$url> as \"$file\".  Path exists.\n";
+	      }
+	      else {
+		  print "Saving to '$file'...\n";
+	      }
+	  }
+	  else {
+	      $file = $argfile;
+	  }
+	  open(FILE, ">$file") || die "Can't open $file: $!\n";
+          binmode FILE unless $opt{a};
+	  $length = $res->content_length;
+	  $flength = fbytes($length) if defined $length;
+	  $start_t = time;
+	  $last_dur = 0;
+      }
+
+      print FILE $_[0] or die "Can't write to $file: $!\n";
+      $size += length($_[0]);
+
+      if (defined $length) {
+	  my $dur  = time - $start_t;
+	  if ($dur != $last_dur) {  # don't update too often
+	      $last_dur = $dur;
+	      my $perc = $size / $length;
+	      my $speed;
+	      $speed = fbytes($size/$dur) . "/sec" if $dur > 3;
+	      my $secs_left = fduration($dur/$perc - $dur);
+	      $perc = int($perc*100);
+	      my $show = "$perc% of $flength";
+	      $show .= " (at $speed, $secs_left remaining)" if $speed;
+	      show($show, 1);
+	  }
+      }
+      else {
+	  show( fbytes($size) . " received");
+      }
+  }
+);
+
+if (fileno(FILE)) {
+    close(FILE) || die "Can't write to $file: $!\n";
+
+    show("");  # clear text
+    print "\r";
+    print fbytes($size);
+    print " of ", fbytes($length) if defined($length) && $length != $size;
+    print " received";
+    my $dur = time - $start_t;
+    if ($dur) {
+	my $speed = fbytes($size/$dur) . "/sec";
+	print " in ", fduration($dur), " ($speed)";
+    }
+    print "\n";
+
+    if (my $mtime = $res->last_modified) {
+	utime time, $mtime, $file;
+    }
+
+    if ($res->header("X-Died") || !$res->is_success) {
+	if (my $died = $res->header("X-Died")) {
+	    print "$died\n";
+	}
+	if (-t) {
+	    print "Transfer aborted.  Delete $file? [n] ";
+	    my $ans = <STDIN>;
+	    if (defined($ans) && $ans =~ /^y\n/) {
+		unlink($file) && print "Deleted.\n";
+	    }
+	    elsif ($length > $size) {
+		print "Truncated file kept: ", fbytes($length - $size), " missing\n";
+	    }
+	    else {
+		print "File kept.\n";
+	    }
+            exit 1;
+	}
+	else {
+	    print "Transfer aborted, $file kept\n";
+	}
+    }
+    exit 0;
+}
+
+# Did not manage to create any file
+print "\n" if $shown;
+if (my $xdied = $res->header("X-Died")) {
+    print "$progname: Aborted\n$xdied\n";
+}
+else {
+    print "$progname: ", $res->status_line, "\n";
+}
+exit 1;
+
+
+sub fbytes
+{
+    my $n = int(shift);
+    if ($n >= 1024 * 1024) {
+	return sprintf "%.3g MB", $n / (1024.0 * 1024);
+    }
+    elsif ($n >= 1024) {
+	return sprintf "%.3g KB", $n / 1024.0;
+    }
+    else {
+	return "$n bytes";
+    }
+}
+
+sub fduration
+{
+    use integer;
+    my $secs = int(shift);
+    my $hours = $secs / (60*60);
+    $secs -= $hours * 60*60;
+    my $mins = $secs / 60;
+    $secs %= 60;
+    if ($hours) {
+	return "$hours hours $mins minutes";
+    }
+    elsif ($mins >= 2) {
+	return "$mins minutes";
+    }
+    else {
+	$secs += $mins * 60;
+	return "$secs seconds";
+    }
+}
+
+
+BEGIN {
+    my @ani = qw(- \ | /);
+    my $ani = 0;
+
+    sub show
+    {
+        my($mess, $show_ani) = @_;
+        print "\r$mess" . (" " x (75 - length $mess));
+	print $show_ani ? "$ani[$ani++]\b" : " ";
+        $ani %= @ani;
+        $shown++;
+    }
+}
+
+sub usage
+{
+    die "Usage: $progname [-a] <url> [<lpath>]\n";
+}
+
+__END__
+:endofperl

Perl/bin/lwp-mirror

@@ -0,0 +1,105 @@
+#!/usr/bin/perl -w
+
+# $Id: lwp-mirror,v 2.3 2004/04/10 11:19:33 gisle Exp $
+#
+# Simple mirror utility using LWP
+
+=head1 NAME
+
+lwp-mirror - Simple mirror utility
+
+=head1 SYNOPSIS
+
+ lwp-mirror [-v] [-t timeout] <url> <local file>
+
+=head1 DESCRIPTION
+
+This program can be used to mirror a document from a WWW server.  The
+document is only transfered if the remote copy is newer than the local
+copy.  If the local copy is newer nothing happens.
+
+Use the C<-v> option to print the version number of this program.
+
+The timeout value specified with the C<-t> option.  The timeout value
+is the time that the program will wait for response from the remote
+server before it fails.  The default unit for the timeout value is
+seconds.  You might append "m" or "h" to the timeout value to make it
+minutes or hours, respectively.
+
+Because this program is implemented using the LWP library, it only
+supports the protocols that LWP supports.
+
+=head1 SEE ALSO
+
+L<lwp-request>, L<LWP>
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@aas.no>
+
+=cut
+
+
+use LWP::Simple qw(mirror is_success status_message $ua);
+use Getopt::Std;
+
+$progname = $0;
+$progname =~ s,.*/,,;  # use basename only
+$progname =~ s/\.\w*$//; #strip extension if any
+
+$VERSION = sprintf("%d.%02d", q$Revision: 2.3 $ =~ /(\d+)\.(\d+)/);
+
+$opt_h = undef;  # print usage
+$opt_v = undef;  # print version
+$opt_t = undef;  # timeout
+
+unless (getopts("hvt:")) {
+    usage();
+}
+
+if ($opt_v) {
+    require LWP;
+    my $DISTNAME = 'libwww-perl-' . LWP::Version();
+    die <<"EOT";
+This is lwp-mirror version $VERSION ($DISTNAME)
+
+Copyright 1995-1999, Gisle Aas.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+EOT
+}
+
+$url  = shift or usage();
+$file = shift or usage();
+usage() if $opt_h or @ARGV;
+
+if (defined $opt_t) {
+    $opt_t =~ /^(\d+)([smh])?/;
+    die "$progname: Illegal timeout value!\n" unless defined $1;
+    $timeout = $1;
+    $timeout *= 60   if ($2 eq "m");
+    $timeout *= 3600 if ($2 eq "h");
+    $ua->timeout($timeout);
+}
+
+$rc = mirror($url, $file);
+
+if ($rc == 304) {
+    print STDERR "$progname: $file is up to date\n"
+}
+elsif (!is_success($rc)) {
+    print STDERR "$progname: $rc ", status_message($rc), "   ($url)\n";
+    exit 1;
+}
+exit;
+
+
+sub usage
+{
+    die <<"EOT";
+Usage: $progname [-options] <url> <file>
+    -v           print version number of program
+    -t <timeout> Set timeout value
+EOT
+}

Perl/bin/lwp-mirror.bat

@@ -0,0 +1,121 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl -w
+#line 15
+
+# $Id: lwp-mirror,v 2.3 2004/04/10 11:19:33 gisle Exp $
+#
+# Simple mirror utility using LWP
+
+=head1 NAME
+
+lwp-mirror - Simple mirror utility
+
+=head1 SYNOPSIS
+
+ lwp-mirror [-v] [-t timeout] <url> <local file>
+
+=head1 DESCRIPTION
+
+This program can be used to mirror a document from a WWW server.  The
+document is only transfered if the remote copy is newer than the local
+copy.  If the local copy is newer nothing happens.
+
+Use the C<-v> option to print the version number of this program.
+
+The timeout value specified with the C<-t> option.  The timeout value
+is the time that the program will wait for response from the remote
+server before it fails.  The default unit for the timeout value is
+seconds.  You might append "m" or "h" to the timeout value to make it
+minutes or hours, respectively.
+
+Because this program is implemented using the LWP library, it only
+supports the protocols that LWP supports.
+
+=head1 SEE ALSO
+
+L<lwp-request>, L<LWP>
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@aas.no>
+
+=cut
+
+
+use LWP::Simple qw(mirror is_success status_message $ua);
+use Getopt::Std;
+
+$progname = $0;
+$progname =~ s,.*/,,;  # use basename only
+$progname =~ s/\.\w*$//; #strip extension if any
+
+$VERSION = sprintf("%d.%02d", q$Revision: 2.3 $ =~ /(\d+)\.(\d+)/);
+
+$opt_h = undef;  # print usage
+$opt_v = undef;  # print version
+$opt_t = undef;  # timeout
+
+unless (getopts("hvt:")) {
+    usage();
+}
+
+if ($opt_v) {
+    require LWP;
+    my $DISTNAME = 'libwww-perl-' . LWP::Version();
+    die <<"EOT";
+This is lwp-mirror version $VERSION ($DISTNAME)
+
+Copyright 1995-1999, Gisle Aas.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+EOT
+}
+
+$url  = shift or usage();
+$file = shift or usage();
+usage() if $opt_h or @ARGV;
+
+if (defined $opt_t) {
+    $opt_t =~ /^(\d+)([smh])?/;
+    die "$progname: Illegal timeout value!\n" unless defined $1;
+    $timeout = $1;
+    $timeout *= 60   if ($2 eq "m");
+    $timeout *= 3600 if ($2 eq "h");
+    $ua->timeout($timeout);
+}
+
+$rc = mirror($url, $file);
+
+if ($rc == 304) {
+    print STDERR "$progname: $file is up to date\n"
+}
+elsif (!is_success($rc)) {
+    print STDERR "$progname: $rc ", status_message($rc), "   ($url)\n";
+    exit 1;
+}
+exit;
+
+
+sub usage
+{
+    die <<"EOT";
+Usage: $progname [-options] <url> <file>
+    -v           print version number of program
+    -t <timeout> Set timeout value
+EOT
+}
+
+__END__
+:endofperl

Perl/bin/lwp-request

@@ -0,0 +1,544 @@
+#!/usr/bin/perl -w
+
+# $Id: lwp-request,v 2.7 2005/12/06 12:16:28 gisle Exp $
+#
+# Simple user agent using LWP library.
+
+=head1 NAME
+
+lwp-request - Simple command line user agent
+
+=head1 SYNOPSIS
+
+ lwp-request [-aeEdvhx] [-m method] [-b <base URL>] [-t <timeout>]
+             [-i <if-modified-since>] [-c <content-type>] [-C <credentials>]
+             [-p <proxy-url>] [-o <format>] <url>...
+
+=head1 DESCRIPTION
+
+This program can be used to send requests to WWW servers and your
+local file system. The request content for POST and PUT
+methods is read from stdin.  The content of the response is printed on
+stdout.  Error messages are printed on stderr.  The program returns a
+status value indicating the number of URLs that failed.
+
+The options are:
+
+=over 4
+
+=item -m <method>
+
+Set which method to use for the request.  If this option is not used,
+then the method is derived from the name of the program.
+
+=item -f
+
+Force request through, even if the program believes that the method is
+illegal.  The server might reject the request eventually.
+
+=item -b <uri>
+
+This URI will be used as the base URI for resolving all relative URIs
+given as argument.
+
+=item -t <timeout>
+
+Set the timeout value for the requests.  The timeout is the amount of
+time that the program will wait for a response from the remote server
+before it fails.  The default unit for the timeout value is seconds.
+You might append "m" or "h" to the timeout value to make it minutes or
+hours, respectively.  The default timeout is '3m', i.e. 3 minutes.
+
+=item -i <time>
+
+Set the If-Modified-Since header in the request. If I<time> is the
+name of a file, use the modification timestamp for this file. If
+I<time> is not a file, it is parsed as a literal date. Take a look at
+L<HTTP::Date> for recognized formats.
+
+=item -c <content-type>
+
+Set the Content-Type for the request.  This option is only allowed for
+requests that take a content, i.e. POST and PUT.  You can
+force methods to take content by using the C<-f> option together with
+C<-c>.  The default Content-Type for POST is
+C<application/x-www-form-urlencoded>.  The default Content-type for
+the others is C<text/plain>.
+
+=item -p <proxy-url>
+
+Set the proxy to be used for the requests.  The program also loads
+proxy settings from the environment.  You can disable this with the
+C<-P> option.
+
+=item -H <header>
+
+Send this HTTP header with each request. You can specify several, e.g.:
+
+    lwp-request \
+	-H 'Referer: http://other.url/' \
+	-H 'Host: somehost' \
+	http://this.url/
+
+=item -C <username>:<password>
+
+Provide credentials for documents that are protected by Basic
+Authentication.  If the document is protected and you did not specify
+the username and password with this option, then you will be prompted
+to provide these values.
+
+=back
+
+The following options controls what is displayed by the program:
+
+=over 4
+
+=item -u
+
+Print request method and absolute URL as requests are made.
+
+=item -U
+
+Print request headers in addition to request method and absolute URL.
+
+=item -s
+
+Print response status code.  This option is always on for HEAD requests.
+
+=item -S
+
+Print response status chain. This shows redirect and authorization
+requests that are handled by the library.
+
+=item -e
+
+Print response headers.  This option is always on for HEAD requests.
+
+=item -d
+
+Do B<not> print the content of the response.
+
+=item -o <format>
+
+Process HTML content in various ways before printing it.  If the
+content type of the response is not HTML, then this option has no
+effect.  The legal format values are; I<text>, I<ps>, I<links>,
+I<html> and I<dump>.
+
+If you specify the I<text> format then the HTML will be formatted as
+plain latin1 text.  If you specify the I<ps> format then it will be
+formatted as Postscript.
+
+The I<links> format will output all links found in the HTML document.
+Relative links will be expanded to absolute ones.
+
+The I<html> format will reformat the HTML code and the I<dump> format
+will just dump the HTML syntax tree.
+
+Note that the C<HTML-Tree> distribution needs to be installed for this
+option to work.  In addition the C<HTML-Format> distribution needs to
+be installed for I<-o text> or I<-o ps> to work.
+
+=item -v
+
+Print the version number of the program and quit.
+
+=item -h
+
+Print usage message and quit.
+
+=item -x
+
+Extra debugging output.
+
+=item -a
+
+Set text(ascii) mode for content input and output.  If this option is not
+used, content input and output is done in binary mode.
+
+=back
+
+Because this program is implemented using the LWP library, it will
+only support the protocols that LWP supports.
+
+=head1 SEE ALSO
+
+L<lwp-mirror>, L<LWP>
+
+=head1 COPYRIGHT
+
+Copyright 1995-1999 Gisle Aas.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@aas.no>
+
+=cut
+
+$progname = $0;
+$progname =~ s,.*[\\/],,;  # use basename only
+$progname =~ s/\.\w*$//;   # strip extension, if any
+
+$VERSION = sprintf("%d.%02d", q$Revision: 2.7 $ =~ /(\d+)\.(\d+)/);
+
+
+require LWP;
+require LWP::Debug;
+
+use URI;
+use URI::Heuristic qw(uf_uri);
+
+use HTTP::Status qw(status_message);
+use HTTP::Date qw(time2str str2time);
+
+
+# This table lists the methods that are allowed.  It should really be
+# a superset for all methods supported for every scheme that may be
+# supported by the library.  Currently it might be a bit too HTTP
+# specific.  You might use the -f option to force a method through.
+#
+# "" = No content in request, "C" = Needs content in request
+#
+%allowed_methods = (
+    GET        => "",
+    HEAD       => "",
+    POST       => "C",
+    PUT        => "C",
+    DELETE     => "",
+    TRACE      => "",
+    OPTIONS    => "",
+);
+
+
+# We make our own specialization of LWP::UserAgent that asks for
+# user/password if document is protected.
+{
+    package RequestAgent;
+    @ISA = qw(LWP::UserAgent);
+
+    sub new
+    { 
+	my $self = LWP::UserAgent::new(@_);
+	$self->agent("lwp-request/$main::VERSION");
+	$self;
+    }
+
+    sub get_basic_credentials
+    {
+	my($self, $realm, $uri) = @_;
+	if ($main::options{'C'}) {
+	    return split(':', $main::options{'C'}, 2);
+	}
+	elsif (-t) {
+	    my $netloc = $uri->host_port;
+	    print "Enter username for $realm at $netloc: ";
+	    my $user = <STDIN>;
+	    chomp($user);
+	    return (undef, undef) unless length $user;
+	    print "Password: ";
+	    system("stty -echo");
+	    my $password = <STDIN>;
+	    system("stty echo");
+	    print "\n";  # because we disabled echo
+	    chomp($password);
+	    return ($user, $password);
+	}
+	else {
+	    return (undef, undef)
+	}
+    }
+}
+
+$method = uc(lc($progname) eq "lwp-request" ? "GET" : $progname);
+
+# Parse command line
+use Getopt::Long;
+
+my @getopt_args = (
+    'a', # content i/o in text(ascii) mode
+    'm=s', # set method
+    'f', # make request even if method is not in %allowed_methods
+    'b=s', # base url
+    't=s', # timeout
+    'i=s', # if-modified-since
+    'c=s', # content type for POST
+    'C=s', # credentials for basic authorization
+    'H=s@', # extra headers, form "Header: value string"
+    #
+    'u', # display method, URL and headers of request
+    'U', # display request headers also
+    's', # display status code
+    'S', # display whole chain of status codes
+    'e', # display response headers (default for HEAD)
+    'd', # don't display content
+    #
+    'h', # print usage
+    'v', # print version
+    #
+    'x', # extra debugging info
+    'p=s', # proxy URL
+    'P', # don't load proxy setting from environment
+    #
+    'o=s', # output format
+);
+
+Getopt::Long::config("noignorecase", "bundling");
+unless (GetOptions(\%options, @getopt_args)) {
+    usage();
+}
+if ($options{'v'}) {
+    require LWP;
+    my $DISTNAME = 'libwww-perl-' . LWP::Version();
+    die <<"EOT";
+This is lwp-request version $VERSION ($DISTNAME)
+
+Copyright 1995-1999, Gisle Aas.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+EOT
+}
+
+usage() if $options{'h'} || !@ARGV;
+
+LWP::Debug::level('+') if $options{'x'};
+
+# Create the user agent object
+$ua = RequestAgent->new;
+
+# Load proxy settings from *_proxy environment variables.
+$ua->env_proxy unless $options{'P'};
+
+$method = uc($options{'m'}) if defined $options{'m'};
+
+if ($options{'f'}) {
+    if ($options{'c'}) {
+        $allowed_methods{$method} = "C";  # force content
+    }
+    else {
+        $allowed_methods{$method} = "";
+    }
+}
+elsif (!defined $allowed_methods{$method}) {
+    die "$progname: $method is not an allowed method\n";
+}
+
+if ($method eq "HEAD") {
+    $options{'s'} = 1;
+    $options{'e'} = 1 unless $options{'d'};
+    $options{'d'} = 1;
+}
+
+if (defined $options{'t'}) {
+    $options{'t'} =~ /^(\d+)([smh])?/;
+    die "$progname: Illegal timeout value!\n" unless defined $1;
+    $timeout = $1;
+    if (defined $2) {
+        $timeout *= 60   if $2 eq "m";
+        $timeout *= 3600 if $2 eq "h";
+    }
+    $ua->timeout($timeout);
+}
+
+if (defined $options{'i'}) {
+    if (-e $options{'i'}) {
+        $time = (stat _)[9];
+    }
+    else {
+        $time = str2time($options{'i'});
+        die "$progname: Illegal time syntax for -i option\n"
+            unless defined $time;
+    }
+    $options{'i'} = time2str($time);
+}
+
+$content = undef;
+if ($allowed_methods{$method} eq "C") {
+    # This request needs some content
+    unless (defined $options{'c'}) {
+        # set default content type
+        $options{'c'} = ($method eq "POST") ?
+              "application/x-www-form-urlencoded"
+            : "text/plain";
+    }
+    else {
+        die "$progname: Illegal Content-type format\n"
+            unless $options{'c'} =~ m,^[\w\-]+/[\w\-]+(?:\s*;.*)?$,
+    }
+    print "Please enter content ($options{'c'}) to be ${method}ed:\n"
+        if -t;
+    binmode STDIN unless -t or $options{'a'};
+    $content = join("", <STDIN>);
+}
+else {
+    die "$progname: Can't set Content-type for $method requests\n"
+        if defined $options{'c'};
+}
+
+# Set up a request.  We will use the same request object for all URLs.
+$request = HTTP::Request->new($method);
+$request->header('If-Modified-Since', $options{'i'}) if defined $options{'i'};
+for my $user_header (@{ $options{'H'} || [] }) {
+    my ($header_name, $header_value) = split /:\s*/, $user_header, 2;
+    $request->header($header_name, $header_value);
+    $ua->agent($header_value) if lc($header_name) eq "user-agent"; # Ugh!
+}
+#$request->header('Accept', '*/*');
+if ($options{'c'}) { # will always be set for request that wants content
+    $request->header('Content-Type', $options{'c'});
+    $request->header('Content-Length', length $content);  # Not really needed
+    $request->content($content);
+}
+
+$errors = 0;
+
+# Ok, now we perform the requests, one URL at a time
+while ($url = shift) {
+    # Create the URL object, but protect us against bad URLs
+    eval {
+	if ($url =~ /^\w+:/ || $options{'b'}) {  # is there any scheme specification
+	    $url = URI->new($url, $options{'b'});
+	    $url = $url->abs($options{'b'}) if $options{'b'};
+	}
+	else {
+	    $url = uf_uri($url);
+        }
+    };
+    if ($@) {
+	$@ =~ s/ at .* line \d+.*//;
+	print STDERR $@;
+	$errors++;
+	next;
+    }
+
+    $ua->proxy($url->scheme, $options{'p'}) if $options{'p'};
+
+    # Send the request and get a response back from the server
+    $request->url($url);
+    $response = $ua->request($request);
+
+    if ($options{'u'} || $options{'U'}) {
+        my $url = $response->request->url->as_string;
+        print "$method $url\n";
+        print $response->request->headers_as_string, "\n" if $options{'U'};
+    }
+
+    if ($options{'S'}) {
+	printResponseChain($response);
+    }
+    elsif ($options{'s'}) {
+        print $response->status_line, "\n";
+    }
+
+    if ($options{'e'}) {
+        # Display headers
+        print $response->headers_as_string;
+        print "\n";  # separate headers and content
+    }
+
+    unless ($options{'d'}) {
+	if ($options{'o'} &&
+	    $response->content_type eq 'text/html') {
+	    eval {
+		require HTML::Parse;
+	    };
+	    if ($@) {
+		if ($@ =~ m,^Can't locate HTML/Parse.pm in \@INC,) {
+		    die "The HTML-Tree distribution need to be installed for the -o option to be used.\n";
+		}
+		else {
+		    die $@;
+		}
+	    }
+	    my $html = HTML::Parse::parse_html($response->content);
+	    {
+		$options{'o'} eq 'ps' && do {
+		    require HTML::FormatPS;
+		    my $f = HTML::FormatPS->new;
+		    print $f->format($html);
+		    last;
+		};
+		$options{'o'} eq 'text' && do {
+		    require HTML::FormatText;
+		    my $f = HTML::FormatText->new;
+		    print $f->format($html);
+		    last;
+		};
+		$options{'o'} eq 'html' && do {
+		    print $html->as_HTML;
+		    last;
+		};
+		$options{'o'} eq 'links' && do {
+		    my $base = $response->base;
+		    for ( @{ $html->extract_links } ) {
+			my($link, $elem) = @$_;
+			my $tag = uc $elem->tag;
+			$link = URI->new($link)->abs($base)->as_string;
+			print "$tag\t$link\n";
+		    }
+		    last;
+		};
+		$options{'o'} eq 'dump' && do {
+		    $html->dump;
+		    last;
+		};
+		# It is bad to not notice this before now :-(
+		die "Illegal -o option value ($options{'o'})\n";
+	    }
+	}
+	else {
+	    binmode STDOUT unless $options{'a'};
+	    print $response->content;
+	}
+    }
+
+    $errors++ unless $response->is_success;
+}
+
+exit $errors;
+
+
+sub printResponseChain
+{
+    my($response) = @_;
+    return unless defined $response;
+    printResponseChain($response->previous);
+    my $method = $response->request->method;
+    my $url = $response->request->url->as_string;
+    my $code = $response->code;
+    print "$method $url --> ", $response->status_line, "\n";
+}
+
+
+sub usage
+{
+    die <<"EOT";
+Usage: $progname [-options] <url>...
+    -m <method>   use method for the request (default is '$method')
+    -f            make request even if $progname believes method is illegal
+    -b <base>     Use the specified URL as base
+    -t <timeout>  Set timeout value
+    -i <time>     Set the If-Modified-Since header on the request
+    -c <conttype> use this content-type for POST, PUT, CHECKIN
+    -a            Use text mode for content I/O
+    -p <proxyurl> use this as a proxy
+    -P            don't load proxy settings from environment
+    -H <header>   send this HTTP header (you can specify several)
+
+    -u            Display method and URL before any response
+    -U            Display request headers (implies -u)
+    -s            Display response status code
+    -S            Display response status chain
+    -e            Display response headers
+    -d            Do not display content
+    -o <format>   Process HTML content in various ways
+
+    -v            Show program version
+    -h            Print this message
+
+    -x            Extra debugging output
+EOT
+}

Perl/bin/lwp-request.bat

@@ -0,0 +1,560 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl -w
+#line 15
+
+# $Id: lwp-request,v 2.7 2005/12/06 12:16:28 gisle Exp $
+#
+# Simple user agent using LWP library.
+
+=head1 NAME
+
+lwp-request - Simple command line user agent
+
+=head1 SYNOPSIS
+
+ lwp-request [-aeEdvhx] [-m method] [-b <base URL>] [-t <timeout>]
+             [-i <if-modified-since>] [-c <content-type>] [-C <credentials>]
+             [-p <proxy-url>] [-o <format>] <url>...
+
+=head1 DESCRIPTION
+
+This program can be used to send requests to WWW servers and your
+local file system. The request content for POST and PUT
+methods is read from stdin.  The content of the response is printed on
+stdout.  Error messages are printed on stderr.  The program returns a
+status value indicating the number of URLs that failed.
+
+The options are:
+
+=over 4
+
+=item -m <method>
+
+Set which method to use for the request.  If this option is not used,
+then the method is derived from the name of the program.
+
+=item -f
+
+Force request through, even if the program believes that the method is
+illegal.  The server might reject the request eventually.
+
+=item -b <uri>
+
+This URI will be used as the base URI for resolving all relative URIs
+given as argument.
+
+=item -t <timeout>
+
+Set the timeout value for the requests.  The timeout is the amount of
+time that the program will wait for a response from the remote server
+before it fails.  The default unit for the timeout value is seconds.
+You might append "m" or "h" to the timeout value to make it minutes or
+hours, respectively.  The default timeout is '3m', i.e. 3 minutes.
+
+=item -i <time>
+
+Set the If-Modified-Since header in the request. If I<time> is the
+name of a file, use the modification timestamp for this file. If
+I<time> is not a file, it is parsed as a literal date. Take a look at
+L<HTTP::Date> for recognized formats.
+
+=item -c <content-type>
+
+Set the Content-Type for the request.  This option is only allowed for
+requests that take a content, i.e. POST and PUT.  You can
+force methods to take content by using the C<-f> option together with
+C<-c>.  The default Content-Type for POST is
+C<application/x-www-form-urlencoded>.  The default Content-type for
+the others is C<text/plain>.
+
+=item -p <proxy-url>
+
+Set the proxy to be used for the requests.  The program also loads
+proxy settings from the environment.  You can disable this with the
+C<-P> option.
+
+=item -H <header>
+
+Send this HTTP header with each request. You can specify several, e.g.:
+
+    lwp-request \
+	-H 'Referer: http://other.url/' \
+	-H 'Host: somehost' \
+	http://this.url/
+
+=item -C <username>:<password>
+
+Provide credentials for documents that are protected by Basic
+Authentication.  If the document is protected and you did not specify
+the username and password with this option, then you will be prompted
+to provide these values.
+
+=back
+
+The following options controls what is displayed by the program:
+
+=over 4
+
+=item -u
+
+Print request method and absolute URL as requests are made.
+
+=item -U
+
+Print request headers in addition to request method and absolute URL.
+
+=item -s
+
+Print response status code.  This option is always on for HEAD requests.
+
+=item -S
+
+Print response status chain. This shows redirect and authorization
+requests that are handled by the library.
+
+=item -e
+
+Print response headers.  This option is always on for HEAD requests.
+
+=item -d
+
+Do B<not> print the content of the response.
+
+=item -o <format>
+
+Process HTML content in various ways before printing it.  If the
+content type of the response is not HTML, then this option has no
+effect.  The legal format values are; I<text>, I<ps>, I<links>,
+I<html> and I<dump>.
+
+If you specify the I<text> format then the HTML will be formatted as
+plain latin1 text.  If you specify the I<ps> format then it will be
+formatted as Postscript.
+
+The I<links> format will output all links found in the HTML document.
+Relative links will be expanded to absolute ones.
+
+The I<html> format will reformat the HTML code and the I<dump> format
+will just dump the HTML syntax tree.
+
+Note that the C<HTML-Tree> distribution needs to be installed for this
+option to work.  In addition the C<HTML-Format> distribution needs to
+be installed for I<-o text> or I<-o ps> to work.
+
+=item -v
+
+Print the version number of the program and quit.
+
+=item -h
+
+Print usage message and quit.
+
+=item -x
+
+Extra debugging output.
+
+=item -a
+
+Set text(ascii) mode for content input and output.  If this option is not
+used, content input and output is done in binary mode.
+
+=back
+
+Because this program is implemented using the LWP library, it will
+only support the protocols that LWP supports.
+
+=head1 SEE ALSO
+
+L<lwp-mirror>, L<LWP>
+
+=head1 COPYRIGHT
+
+Copyright 1995-1999 Gisle Aas.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@aas.no>
+
+=cut
+
+$progname = $0;
+$progname =~ s,.*[\\/],,;  # use basename only
+$progname =~ s/\.\w*$//;   # strip extension, if any
+
+$VERSION = sprintf("%d.%02d", q$Revision: 2.7 $ =~ /(\d+)\.(\d+)/);
+
+
+require LWP;
+require LWP::Debug;
+
+use URI;
+use URI::Heuristic qw(uf_uri);
+
+use HTTP::Status qw(status_message);
+use HTTP::Date qw(time2str str2time);
+
+
+# This table lists the methods that are allowed.  It should really be
+# a superset for all methods supported for every scheme that may be
+# supported by the library.  Currently it might be a bit too HTTP
+# specific.  You might use the -f option to force a method through.
+#
+# "" = No content in request, "C" = Needs content in request
+#
+%allowed_methods = (
+    GET        => "",
+    HEAD       => "",
+    POST       => "C",
+    PUT        => "C",
+    DELETE     => "",
+    TRACE      => "",
+    OPTIONS    => "",
+);
+
+
+# We make our own specialization of LWP::UserAgent that asks for
+# user/password if document is protected.
+{
+    package RequestAgent;
+    @ISA = qw(LWP::UserAgent);
+
+    sub new
+    { 
+	my $self = LWP::UserAgent::new(@_);
+	$self->agent("lwp-request/$main::VERSION");
+	$self;
+    }
+
+    sub get_basic_credentials
+    {
+	my($self, $realm, $uri) = @_;
+	if ($main::options{'C'}) {
+	    return split(':', $main::options{'C'}, 2);
+	}
+	elsif (-t) {
+	    my $netloc = $uri->host_port;
+	    print "Enter username for $realm at $netloc: ";
+	    my $user = <STDIN>;
+	    chomp($user);
+	    return (undef, undef) unless length $user;
+	    print "Password: ";
+	    system("stty -echo");
+	    my $password = <STDIN>;
+	    system("stty echo");
+	    print "\n";  # because we disabled echo
+	    chomp($password);
+	    return ($user, $password);
+	}
+	else {
+	    return (undef, undef)
+	}
+    }
+}
+
+$method = uc(lc($progname) eq "lwp-request" ? "GET" : $progname);
+
+# Parse command line
+use Getopt::Long;
+
+my @getopt_args = (
+    'a', # content i/o in text(ascii) mode
+    'm=s', # set method
+    'f', # make request even if method is not in %allowed_methods
+    'b=s', # base url
+    't=s', # timeout
+    'i=s', # if-modified-since
+    'c=s', # content type for POST
+    'C=s', # credentials for basic authorization
+    'H=s@', # extra headers, form "Header: value string"
+    #
+    'u', # display method, URL and headers of request
+    'U', # display request headers also
+    's', # display status code
+    'S', # display whole chain of status codes
+    'e', # display response headers (default for HEAD)
+    'd', # don't display content
+    #
+    'h', # print usage
+    'v', # print version
+    #
+    'x', # extra debugging info
+    'p=s', # proxy URL
+    'P', # don't load proxy setting from environment
+    #
+    'o=s', # output format
+);
+
+Getopt::Long::config("noignorecase", "bundling");
+unless (GetOptions(\%options, @getopt_args)) {
+    usage();
+}
+if ($options{'v'}) {
+    require LWP;
+    my $DISTNAME = 'libwww-perl-' . LWP::Version();
+    die <<"EOT";
+This is lwp-request version $VERSION ($DISTNAME)
+
+Copyright 1995-1999, Gisle Aas.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+EOT
+}
+
+usage() if $options{'h'} || !@ARGV;
+
+LWP::Debug::level('+') if $options{'x'};
+
+# Create the user agent object
+$ua = RequestAgent->new;
+
+# Load proxy settings from *_proxy environment variables.
+$ua->env_proxy unless $options{'P'};
+
+$method = uc($options{'m'}) if defined $options{'m'};
+
+if ($options{'f'}) {
+    if ($options{'c'}) {
+        $allowed_methods{$method} = "C";  # force content
+    }
+    else {
+        $allowed_methods{$method} = "";
+    }
+}
+elsif (!defined $allowed_methods{$method}) {
+    die "$progname: $method is not an allowed method\n";
+}
+
+if ($method eq "HEAD") {
+    $options{'s'} = 1;
+    $options{'e'} = 1 unless $options{'d'};
+    $options{'d'} = 1;
+}
+
+if (defined $options{'t'}) {
+    $options{'t'} =~ /^(\d+)([smh])?/;
+    die "$progname: Illegal timeout value!\n" unless defined $1;
+    $timeout = $1;
+    if (defined $2) {
+        $timeout *= 60   if $2 eq "m";
+        $timeout *= 3600 if $2 eq "h";
+    }
+    $ua->timeout($timeout);
+}
+
+if (defined $options{'i'}) {
+    if (-e $options{'i'}) {
+        $time = (stat _)[9];
+    }
+    else {
+        $time = str2time($options{'i'});
+        die "$progname: Illegal time syntax for -i option\n"
+            unless defined $time;
+    }
+    $options{'i'} = time2str($time);
+}
+
+$content = undef;
+if ($allowed_methods{$method} eq "C") {
+    # This request needs some content
+    unless (defined $options{'c'}) {
+        # set default content type
+        $options{'c'} = ($method eq "POST") ?
+              "application/x-www-form-urlencoded"
+            : "text/plain";
+    }
+    else {
+        die "$progname: Illegal Content-type format\n"
+            unless $options{'c'} =~ m,^[\w\-]+/[\w\-]+(?:\s*;.*)?$,
+    }
+    print "Please enter content ($options{'c'}) to be ${method}ed:\n"
+        if -t;
+    binmode STDIN unless -t or $options{'a'};
+    $content = join("", <STDIN>);
+}
+else {
+    die "$progname: Can't set Content-type for $method requests\n"
+        if defined $options{'c'};
+}
+
+# Set up a request.  We will use the same request object for all URLs.
+$request = HTTP::Request->new($method);
+$request->header('If-Modified-Since', $options{'i'}) if defined $options{'i'};
+for my $user_header (@{ $options{'H'} || [] }) {
+    my ($header_name, $header_value) = split /:\s*/, $user_header, 2;
+    $request->header($header_name, $header_value);
+    $ua->agent($header_value) if lc($header_name) eq "user-agent"; # Ugh!
+}
+#$request->header('Accept', '*/*');
+if ($options{'c'}) { # will always be set for request that wants content
+    $request->header('Content-Type', $options{'c'});
+    $request->header('Content-Length', length $content);  # Not really needed
+    $request->content($content);
+}
+
+$errors = 0;
+
+# Ok, now we perform the requests, one URL at a time
+while ($url = shift) {
+    # Create the URL object, but protect us against bad URLs
+    eval {
+	if ($url =~ /^\w+:/ || $options{'b'}) {  # is there any scheme specification
+	    $url = URI->new($url, $options{'b'});
+	    $url = $url->abs($options{'b'}) if $options{'b'};
+	}
+	else {
+	    $url = uf_uri($url);
+        }
+    };
+    if ($@) {
+	$@ =~ s/ at .* line \d+.*//;
+	print STDERR $@;
+	$errors++;
+	next;
+    }
+
+    $ua->proxy($url->scheme, $options{'p'}) if $options{'p'};
+
+    # Send the request and get a response back from the server
+    $request->url($url);
+    $response = $ua->request($request);
+
+    if ($options{'u'} || $options{'U'}) {
+        my $url = $response->request->url->as_string;
+        print "$method $url\n";
+        print $response->request->headers_as_string, "\n" if $options{'U'};
+    }
+
+    if ($options{'S'}) {
+	printResponseChain($response);
+    }
+    elsif ($options{'s'}) {
+        print $response->status_line, "\n";
+    }
+
+    if ($options{'e'}) {
+        # Display headers
+        print $response->headers_as_string;
+        print "\n";  # separate headers and content
+    }
+
+    unless ($options{'d'}) {
+	if ($options{'o'} &&
+	    $response->content_type eq 'text/html') {
+	    eval {
+		require HTML::Parse;
+	    };
+	    if ($@) {
+		if ($@ =~ m,^Can't locate HTML/Parse.pm in \@INC,) {
+		    die "The HTML-Tree distribution need to be installed for the -o option to be used.\n";
+		}
+		else {
+		    die $@;
+		}
+	    }
+	    my $html = HTML::Parse::parse_html($response->content);
+	    {
+		$options{'o'} eq 'ps' && do {
+		    require HTML::FormatPS;
+		    my $f = HTML::FormatPS->new;
+		    print $f->format($html);
+		    last;
+		};
+		$options{'o'} eq 'text' && do {
+		    require HTML::FormatText;
+		    my $f = HTML::FormatText->new;
+		    print $f->format($html);
+		    last;
+		};
+		$options{'o'} eq 'html' && do {
+		    print $html->as_HTML;
+		    last;
+		};
+		$options{'o'} eq 'links' && do {
+		    my $base = $response->base;
+		    for ( @{ $html->extract_links } ) {
+			my($link, $elem) = @$_;
+			my $tag = uc $elem->tag;
+			$link = URI->new($link)->abs($base)->as_string;
+			print "$tag\t$link\n";
+		    }
+		    last;
+		};
+		$options{'o'} eq 'dump' && do {
+		    $html->dump;
+		    last;
+		};
+		# It is bad to not notice this before now :-(
+		die "Illegal -o option value ($options{'o'})\n";
+	    }
+	}
+	else {
+	    binmode STDOUT unless $options{'a'};
+	    print $response->content;
+	}
+    }
+
+    $errors++ unless $response->is_success;
+}
+
+exit $errors;
+
+
+sub printResponseChain
+{
+    my($response) = @_;
+    return unless defined $response;
+    printResponseChain($response->previous);
+    my $method = $response->request->method;
+    my $url = $response->request->url->as_string;
+    my $code = $response->code;
+    print "$method $url --> ", $response->status_line, "\n";
+}
+
+
+sub usage
+{
+    die <<"EOT";
+Usage: $progname [-options] <url>...
+    -m <method>   use method for the request (default is '$method')
+    -f            make request even if $progname believes method is illegal
+    -b <base>     Use the specified URL as base
+    -t <timeout>  Set timeout value
+    -i <time>     Set the If-Modified-Since header on the request
+    -c <conttype> use this content-type for POST, PUT, CHECKIN
+    -a            Use text mode for content I/O
+    -p <proxyurl> use this as a proxy
+    -P            don't load proxy settings from environment
+    -H <header>   send this HTTP header (you can specify several)
+
+    -u            Display method and URL before any response
+    -U            Display request headers (implies -u)
+    -s            Display response status code
+    -S            Display response status chain
+    -e            Display response headers
+    -d            Do not display content
+    -o <format>   Process HTML content in various ways
+
+    -v            Show program version
+    -h            Print this message
+
+    -x            Extra debugging output
+EOT
+}
+
+__END__
+:endofperl

Perl/bin/lwp-rget

@@ -0,0 +1,607 @@
+#!/usr/bin/perl -w
+
+=head1 NAME
+
+lwp-rget - Retrieve web documents recursively
+
+=head1 SYNOPSIS
+
+ lwp-rget [--verbose] [--auth=USER:PASS] [--depth=N] [--hier] [--iis]
+	  [--keepext=mime/type[,mime/type]] [--limit=N] [--nospace]
+	  [--prefix=URL] [--referer=URL] [--sleep=N] [--tolower] <URL>
+ lwp-rget --version
+
+=head1 DESCRIPTION
+
+This program will retrieve a document and store it in a local file.  It
+will follow any links found in the document and store these documents
+as well, patching links so that they refer to these local copies.
+This process continues until there are no more unvisited links or the
+process is stopped by the one or more of the limits which can be
+controlled by the command line arguments.
+
+This program is useful if you want to make a local copy of a
+collection of documents or want to do web reading off-line.
+
+All documents are stored as plain files in the current directory. The
+file names chosen are derived from the last component of URL paths.
+
+The options are:
+
+=over 3
+
+=item --auth=USER:PASS<n>
+
+Set the authentication credentials to user "USER" and password "PASS" if
+any restricted parts of the web site are hit.  If there are restricted
+parts of the web site and authentication credentials are not available,
+those pages will not be downloaded.
+
+=item --depth=I<n>
+
+Limit the recursive level. Embedded images are always loaded, even if
+they fall outside the I<--depth>. This means that one can use
+I<--depth=0> in order to fetch a single document together with all
+inline graphics.
+
+The default depth is 5.
+
+=item --hier
+
+Download files into a hierarchy that mimics the web site structure.
+The default is to put all files in the current directory.
+
+=item --referer=I<URI>
+
+Set the value of the Referer header for the initial request.  The
+special value C<"NONE"> can be used to suppress the Referer header in
+any of subsequent requests.  The Referer header will always be suppressed
+in all normal C<http> requests if the referring page was transmitted over
+C<https> as recommended in RFC 2616.
+
+=item --iis
+
+Sends an "Accept: */*" on all URL requests as a workaround for a bug in
+IIS 2.0.  If no Accept MIME header is present, IIS 2.0 returns with a
+"406 No acceptable objects were found" error.  Also converts any back
+slashes (\\) in URLs to forward slashes (/).
+
+=item --keepext=I<mime/type[,mime/type]>
+
+Keeps the current extension for the list MIME types.  Useful when
+downloading text/plain documents that shouldn't all be translated to
+*.txt files.
+
+=item --limit=I<n>
+
+Limit the number of documents to get.  The default limit is 50.
+
+=item --nospace
+
+Changes spaces in all URLs to underscore characters (_).  Useful when
+downloading files from sites serving URLs with spaces in them.	Does not
+remove spaces from fragments, e.g., "file.html#somewhere in here".
+
+=item --prefix=I<url_prefix>
+
+Limit the links to follow. Only URLs that start the prefix string are
+followed.
+
+The default prefix is set as the "directory" of the initial URL to
+follow.	 For instance if we start lwp-rget with the URL
+C<http://www.sn.no/foo/bar.html>, then prefix will be set to
+C<http://www.sn.no/foo/>.
+
+Use C<--prefix=''> if you don't want the fetching to be limited by any
+prefix.
+
+=item --sleep=I<n>
+
+Sleep I<n> seconds before retrieving each document. This options allows
+you to go slowly, not loading the server you visiting too much.
+
+=item --tolower
+
+Translates all links to lowercase.  Useful when downloading files from
+IIS since it does not serve files in a case sensitive manner.
+
+=item --verbose
+
+Make more noise while running.
+
+=item --quiet
+
+Don't make any noise.
+
+=item --version
+
+Print program version number and quit.
+
+=item --help
+
+Print the usage message and quit.
+
+=back
+
+Before the program exits the name of the file, where the initial URL
+is stored, is printed on stdout.  All used filenames are also printed
+on stderr as they are loaded.  This printing can be suppressed with
+the I<--quiet> option.
+
+=head1 SEE ALSO
+
+L<lwp-request>, L<LWP>
+
+=head1 AUTHOR
+
+Gisle Aas <aas@sn.no>
+
+=cut
+
+use strict;
+
+use Getopt::Long    qw(GetOptions);
+use URI::URL	    qw(url);
+use LWP::MediaTypes qw(media_suffix);
+use HTML::Entities  ();
+
+use vars qw($VERSION);
+use vars qw($MAX_DEPTH $MAX_DOCS $PREFIX $REFERER $VERBOSE $QUIET $SLEEP $HIER $AUTH $IIS $TOLOWER $NOSPACE %KEEPEXT);
+
+my $progname = $0;
+$progname =~ s|.*/||;  # only basename left
+$progname =~ s/\.\w*$//; #strip extension if any
+
+$VERSION = sprintf("%d.%02d", q$Revision: 2.4 $ =~ /(\d+)\.(\d+)/);
+
+#$Getopt::Long::debug = 1;
+#$Getopt::Long::ignorecase = 0;
+
+# Defaults
+$MAX_DEPTH = 5;
+$MAX_DOCS  = 50;
+
+GetOptions('version'  => \&print_version,
+	   'help'     => \&usage,
+	   'depth=i'  => \$MAX_DEPTH,
+	   'limit=i'  => \$MAX_DOCS,
+	   'verbose!' => \$VERBOSE,
+	   'quiet!'   => \$QUIET,
+	   'sleep=i'  => \$SLEEP,
+	   'prefix:s' => \$PREFIX,
+	   'referer:s'=> \$REFERER,
+	   'hier'     => \$HIER,
+	   'auth=s'   => \$AUTH,
+	   'iis'      => \$IIS,
+	   'tolower'  => \$TOLOWER,
+	   'nospace'  => \$NOSPACE,
+	   'keepext=s' => \$KEEPEXT{'OPT'},
+	  ) || usage();
+
+sub print_version {
+    require LWP;
+    my $DISTNAME = 'libwww-perl-' . LWP::Version();
+    print <<"EOT";
+This is lwp-rget version $VERSION ($DISTNAME)
+
+Copyright 1996-1998, Gisle Aas.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+EOT
+    exit 0;
+}
+
+my $start_url = shift || usage();
+usage() if @ARGV;
+
+require LWP::UserAgent;
+my $ua = new LWP::UserAgent;
+$ua->agent("$progname/$VERSION " . $ua->agent);
+$ua->env_proxy;
+
+unless (defined $PREFIX) {
+    $PREFIX = url($start_url);	 # limit to URLs below this one
+    eval {
+	$PREFIX->eparams(undef);
+	$PREFIX->equery(undef);
+    };
+
+    $_ = $PREFIX->epath;
+    s|[^/]+$||;
+    $PREFIX->epath($_);
+    $PREFIX = $PREFIX->as_string;
+}
+
+%KEEPEXT = map { lc($_) => 1 } split(/\s*,\s*/, ($KEEPEXT{'OPT'}||0));
+
+my $SUPPRESS_REFERER;
+$SUPPRESS_REFERER++ if ($REFERER || "") eq "NONE";
+
+print <<"" if $VERBOSE;
+START	  = $start_url
+MAX_DEPTH = $MAX_DEPTH
+MAX_DOCS  = $MAX_DOCS
+PREFIX	  = $PREFIX
+
+my $no_docs = 0;
+my %seen = ();	   # mapping from URL => local_file
+
+my $filename = fetch($start_url, undef, $REFERER);
+print "$filename\n" unless $QUIET;
+
+sub fetch
+{
+    my($url, $type, $referer, $depth) = @_;
+
+    # Fix http://sitename.com/../blah/blah.html to
+    #	  http://sitename.com/blah/blah.html
+    $url = $url->as_string if (ref($url));
+    while ($url =~ s#(https?://[^/]+/)\.\.\/#$1#) {}
+
+    # Fix backslashes (\) in URL if $IIS defined
+    $url = fix_backslashes($url) if (defined $IIS);
+
+    $url = url($url);
+    $type  ||= 'a';
+    # Might be the background attribute
+    $type = 'img' if ($type eq 'body' || $type eq 'td');
+    $depth ||= 0;
+
+    # Print the URL before we start checking...
+    my $out = (" " x $depth) . $url . " ";
+    $out .= "." x (60 - length($out));
+    print STDERR $out . " " if $VERBOSE;
+
+    # Can't get mailto things
+    if ($url->scheme eq 'mailto') {
+	print STDERR "*skipping mailto*\n" if $VERBOSE;
+	return $url->as_string;
+    }
+
+    # The $plain_url is a URL without the fragment part
+    my $plain_url = $url->clone;
+    $plain_url->frag(undef);
+
+    # Check PREFIX, but not for <IMG ...> links
+    if ($type ne 'img' and  $url->as_string !~ /^\Q$PREFIX/o) {
+	print STDERR "*outsider*\n" if $VERBOSE;
+	return $url->as_string;
+    }
+
+    # Translate URL to lowercase if $TOLOWER defined
+    $plain_url = to_lower($plain_url) if (defined $TOLOWER);
+
+    # If we already have it, then there is nothing to be done
+    my $seen = $seen{$plain_url->as_string};
+    if ($seen) {
+	my $frag = $url->frag;
+	$seen .= "#$frag" if defined($frag);
+	$seen = protect_frag_spaces($seen);
+	print STDERR "$seen (again)\n" if $VERBOSE;
+	return $seen;
+    }
+
+    # Too much or too deep
+    if ($depth > $MAX_DEPTH and $type ne 'img') {
+	print STDERR "*too deep*\n" if $VERBOSE;
+	return $url;
+    }
+    if ($no_docs > $MAX_DOCS) {
+	print STDERR "*too many*\n" if $VERBOSE;
+	return $url;
+    }
+
+    # Fetch document 
+    $no_docs++;
+    sleep($SLEEP) if $SLEEP;
+    my $req = HTTP::Request->new(GET => $url);
+    # See: http://ftp.sunet.se/pub/NT/mirror-microsoft/kb/Q163/7/74.TXT
+    $req->header ('Accept', '*/*') if (defined $IIS);  # GIF/JPG from IIS 2.0
+    $req->authorization_basic(split (/:/, $AUTH)) if (defined $AUTH);
+    if ($referer && !$SUPPRESS_REFERER) {
+	if ($req->url->scheme eq 'http') {
+	    # RFC 2616, section 15.1.3
+	    $referer = url($referer) unless ref($referer);
+	    undef $referer if ($referer->scheme || '') eq 'https';
+	}
+	$req->referer($referer) if $referer;
+    }
+    my $res = $ua->request($req);
+
+    # Check outcome
+    if ($res->is_success) {
+	my $doc = $res->content;
+	my $ct = $res->content_type;
+	my $name = find_name($res->request->url, $ct);
+	print STDERR "$name\n" unless $QUIET;
+	$seen{$plain_url->as_string} = $name;
+
+	# If the file is HTML, then we look for internal links
+	if ($ct eq "text/html") {
+	    # Save an unprosessed version of the HTML document.	 This
+	    # both reserves the name used, and it also ensures that we
+	    # don't loose everything if this program is killed before
+	    # we finish.
+	    save($name, $doc);
+	    my $base = $res->base;
+
+	    # Follow and substitute links...
+	    $doc =~
+s/
+  (
+    <(img|a|body|area|frame|td)\b   # some interesting tag
+    [^>]+			    # still inside tag (not strictly correct)
+    \b(?:src|href|background)	    # some link attribute
+    \s*=\s*			    # =
+  )
+    (?:				    # scope of OR-ing
+	 (")([^"]*)"	|	    # value in double quotes  OR
+	 (')([^']*)'	|	    # value in single quotes  OR
+	    ([^\s>]+)		    # quoteless value
+    )
+/
+  new_link($1, lc($2), $3||$5, HTML::Entities::decode($4||$6||$7),
+           $base, $name, "$url", $depth+1)
+/giex;
+	   # XXX
+	   # The regular expression above is not strictly correct.
+	   # It is not really possible to parse HTML with a single
+	   # regular expression, but it is faster.  Tags that might
+	   # confuse us include:
+	   #	<a alt="href" href=link.html>
+	   #	<a alt=">" href="link.html">
+	   #
+	}
+	save($name, $doc);
+	return $name;
+    }
+    else {
+	print STDERR $res->code . " " . $res->message . "\n" if $VERBOSE;
+	$seen{$plain_url->as_string} = $url->as_string;
+	return $url->as_string;
+    }
+}
+
+sub new_link
+{
+    my($pre, $type, $quote, $url, $base, $localbase, $referer, $depth) = @_;
+
+    $url = protect_frag_spaces($url);
+
+    $url = fetch(url($url, $base)->abs, $type, $referer, $depth);
+    $url = url("file:$url", "file:$localbase")->rel
+	unless $url =~ /^[.+\-\w]+:/;
+
+    $url = unprotect_frag_spaces($url);
+
+    return $pre . $quote . $url . $quote;
+}
+
+
+sub protect_frag_spaces
+{
+    my ($url) = @_;
+
+    $url = $url->as_string if (ref($url));
+
+    if ($url =~ m/^([^#]*#)(.+)$/)
+    {
+      my ($base, $frag) = ($1, $2);
+      $frag =~ s/ /%20/g;
+      $url = $base . $frag;
+    }
+
+    return $url;
+}
+
+
+sub unprotect_frag_spaces
+{
+    my ($url) = @_;
+
+    $url = $url->as_string if (ref($url));
+
+    if ($url =~ m/^([^#]*#)(.+)$/)
+    {
+      my ($base, $frag) = ($1, $2);
+      $frag =~ s/%20/ /g;
+      $url = $base . $frag;
+    }
+
+    return $url;
+}
+
+
+sub fix_backslashes
+{
+    my ($url) = @_;
+    my ($base, $frag);
+
+    $url = $url->as_string if (ref($url));
+
+    if ($url =~ m/([^#]+)(#.*)/)
+    {
+      ($base, $frag) = ($1, $2);
+    }
+    else
+    {
+      $base = $url;
+      $frag = "";
+    }
+
+    $base =~ tr/\\/\//;
+    $base =~ s/%5[cC]/\//g;	# URL-encoded back slash is %5C
+
+    return $base . $frag;
+}
+
+
+sub to_lower
+{
+    my ($url) = @_;
+    my $was_object = 0;
+
+    if (ref($url))
+    {
+      $url = $url->as_string;
+      $was_object = 1;
+    }
+
+    if ($url =~ m/([^#]+)(#.*)/)
+    {
+      $url = lc($1) . $2;
+    }
+    else
+    {
+      $url = lc($url);
+    }
+
+    if ($was_object == 1)
+    {
+      return url($url);
+    }
+    else
+    {
+      return $url;
+    }
+}
+
+
+sub translate_spaces
+{
+    my ($url) = @_;
+    my ($base, $frag);
+
+    $url = $url->as_string if (ref($url));
+
+    if ($url =~ m/([^#]+)(#.*)/)
+    {
+      ($base, $frag) = ($1, $2);
+    }
+    else
+    {
+      $base = $url;
+      $frag = "";
+    }
+
+    $base =~ s/^ *//;	# Remove initial spaces from base
+    $base =~ s/ *$//;	# Remove trailing spaces from base
+
+    $base =~ tr/ /_/;
+    $base =~ s/%20/_/g; # URL-encoded space is %20
+
+    return $base . $frag;
+}
+
+
+sub mkdirp
+{
+    my($directory, $mode) = @_;
+    my @dirs = split(/\//, $directory);
+    my $path = shift(@dirs);   # build it as we go
+    my $result = 1;   # assume it will work
+
+    unless (-d $path) {
+	$result &&= mkdir($path, $mode);
+    }
+
+    foreach (@dirs) {
+	$path .= "/$_";
+	if ( ! -d $path) {
+	    $result &&= mkdir($path, $mode);
+	}
+    }
+
+    return $result;
+}
+
+
+sub find_name
+{
+    my($url, $type) = @_;
+    #print "find_name($url, $type)\n";
+
+    # Translate spaces in URL to underscores (_) if $NOSPACE defined
+    $url = translate_spaces($url) if (defined $NOSPACE);
+
+    # Translate URL to lowercase if $TOLOWER defined
+    $url = to_lower($url) if (defined $TOLOWER);
+
+    $url = url($url) unless ref($url);
+
+    my $path = $url->path;
+
+    # trim path until only the basename is left
+    $path =~ s|(.*/)||;
+    my $dirname = ".$1";
+    if (!$HIER) {
+	$dirname = "";
+    }
+    elsif (! -d $dirname) {
+	mkdirp($dirname, 0775);
+    }
+
+    my $extra = "";  # something to make the name unique
+    my $suffix;
+
+    if ($KEEPEXT{lc($type)}) {
+        $suffix = ($path =~ m/\.(.*)/) ? $1 : "";
+    }
+    else {
+        $suffix = media_suffix($type);
+    }
+
+    $path =~ s|\..*||;	# trim suffix
+    $path = "index" unless length $path;
+
+    while (1) {
+	# Construct a new file name
+	my $file = $dirname . $path . $extra;
+	$file .= ".$suffix" if $suffix;
+	# Check if it is unique
+	return $file unless -f $file;
+
+	# Try something extra
+	unless ($extra) {
+	    $extra = "001";
+	    next;
+	}
+	$extra++;
+    }
+}
+
+
+sub save
+{
+    my $name = shift;
+    #print "save($name,...)\n";
+    open(FILE, ">$name") || die "Can't save $name: $!";
+    binmode FILE;
+    print FILE $_[0];
+    close(FILE);
+}
+
+
+sub usage
+{
+    print <<""; exit 1;
+Usage: $progname [options] <URL>
+Allowed options are:
+  --auth=USER:PASS  Set authentication credentials for web site
+  --depth=N	    Maximum depth to traverse (default is $MAX_DEPTH)
+  --hier	    Download into hierarchy (not all files into cwd)
+  --referer=URI     Set initial referer header (or "NONE")
+  --iis		    Workaround IIS 2.0 bug by sending "Accept: */*" MIME
+		    header; translates backslashes (\\) to forward slashes (/)
+  --keepext=type    Keep file extension for MIME types (comma-separated list)
+  --limit=N	    A limit on the number documents to get (default is $MAX_DOCS)
+  --nospace	    Translate spaces URLs (not #fragments) to underscores (_)
+  --version	    Print version number and quit
+  --verbose	    More output
+  --quiet	    No output
+  --sleep=SECS	    Sleep between gets, ie. go slowly
+  --prefix=PREFIX   Limit URLs to follow to those which begin with PREFIX
+  --tolower	    Translate all URLs to lowercase (useful with IIS servers)
+
+}

Perl/bin/lwp-rget.bat

@@ -0,0 +1,623 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl -w
+#line 15
+
+=head1 NAME
+
+lwp-rget - Retrieve web documents recursively
+
+=head1 SYNOPSIS
+
+ lwp-rget [--verbose] [--auth=USER:PASS] [--depth=N] [--hier] [--iis]
+	  [--keepext=mime/type[,mime/type]] [--limit=N] [--nospace]
+	  [--prefix=URL] [--referer=URL] [--sleep=N] [--tolower] <URL>
+ lwp-rget --version
+
+=head1 DESCRIPTION
+
+This program will retrieve a document and store it in a local file.  It
+will follow any links found in the document and store these documents
+as well, patching links so that they refer to these local copies.
+This process continues until there are no more unvisited links or the
+process is stopped by the one or more of the limits which can be
+controlled by the command line arguments.
+
+This program is useful if you want to make a local copy of a
+collection of documents or want to do web reading off-line.
+
+All documents are stored as plain files in the current directory. The
+file names chosen are derived from the last component of URL paths.
+
+The options are:
+
+=over 3
+
+=item --auth=USER:PASS<n>
+
+Set the authentication credentials to user "USER" and password "PASS" if
+any restricted parts of the web site are hit.  If there are restricted
+parts of the web site and authentication credentials are not available,
+those pages will not be downloaded.
+
+=item --depth=I<n>
+
+Limit the recursive level. Embedded images are always loaded, even if
+they fall outside the I<--depth>. This means that one can use
+I<--depth=0> in order to fetch a single document together with all
+inline graphics.
+
+The default depth is 5.
+
+=item --hier
+
+Download files into a hierarchy that mimics the web site structure.
+The default is to put all files in the current directory.
+
+=item --referer=I<URI>
+
+Set the value of the Referer header for the initial request.  The
+special value C<"NONE"> can be used to suppress the Referer header in
+any of subsequent requests.  The Referer header will always be suppressed
+in all normal C<http> requests if the referring page was transmitted over
+C<https> as recommended in RFC 2616.
+
+=item --iis
+
+Sends an "Accept: */*" on all URL requests as a workaround for a bug in
+IIS 2.0.  If no Accept MIME header is present, IIS 2.0 returns with a
+"406 No acceptable objects were found" error.  Also converts any back
+slashes (\\) in URLs to forward slashes (/).
+
+=item --keepext=I<mime/type[,mime/type]>
+
+Keeps the current extension for the list MIME types.  Useful when
+downloading text/plain documents that shouldn't all be translated to
+*.txt files.
+
+=item --limit=I<n>
+
+Limit the number of documents to get.  The default limit is 50.
+
+=item --nospace
+
+Changes spaces in all URLs to underscore characters (_).  Useful when
+downloading files from sites serving URLs with spaces in them.	Does not
+remove spaces from fragments, e.g., "file.html#somewhere in here".
+
+=item --prefix=I<url_prefix>
+
+Limit the links to follow. Only URLs that start the prefix string are
+followed.
+
+The default prefix is set as the "directory" of the initial URL to
+follow.	 For instance if we start lwp-rget with the URL
+C<http://www.sn.no/foo/bar.html>, then prefix will be set to
+C<http://www.sn.no/foo/>.
+
+Use C<--prefix=''> if you don't want the fetching to be limited by any
+prefix.
+
+=item --sleep=I<n>
+
+Sleep I<n> seconds before retrieving each document. This options allows
+you to go slowly, not loading the server you visiting too much.
+
+=item --tolower
+
+Translates all links to lowercase.  Useful when downloading files from
+IIS since it does not serve files in a case sensitive manner.
+
+=item --verbose
+
+Make more noise while running.
+
+=item --quiet
+
+Don't make any noise.
+
+=item --version
+
+Print program version number and quit.
+
+=item --help
+
+Print the usage message and quit.
+
+=back
+
+Before the program exits the name of the file, where the initial URL
+is stored, is printed on stdout.  All used filenames are also printed
+on stderr as they are loaded.  This printing can be suppressed with
+the I<--quiet> option.
+
+=head1 SEE ALSO
+
+L<lwp-request>, L<LWP>
+
+=head1 AUTHOR
+
+Gisle Aas <aas@sn.no>
+
+=cut
+
+use strict;
+
+use Getopt::Long    qw(GetOptions);
+use URI::URL	    qw(url);
+use LWP::MediaTypes qw(media_suffix);
+use HTML::Entities  ();
+
+use vars qw($VERSION);
+use vars qw($MAX_DEPTH $MAX_DOCS $PREFIX $REFERER $VERBOSE $QUIET $SLEEP $HIER $AUTH $IIS $TOLOWER $NOSPACE %KEEPEXT);
+
+my $progname = $0;
+$progname =~ s|.*/||;  # only basename left
+$progname =~ s/\.\w*$//; #strip extension if any
+
+$VERSION = sprintf("%d.%02d", q$Revision: 2.4 $ =~ /(\d+)\.(\d+)/);
+
+#$Getopt::Long::debug = 1;
+#$Getopt::Long::ignorecase = 0;
+
+# Defaults
+$MAX_DEPTH = 5;
+$MAX_DOCS  = 50;
+
+GetOptions('version'  => \&print_version,
+	   'help'     => \&usage,
+	   'depth=i'  => \$MAX_DEPTH,
+	   'limit=i'  => \$MAX_DOCS,
+	   'verbose!' => \$VERBOSE,
+	   'quiet!'   => \$QUIET,
+	   'sleep=i'  => \$SLEEP,
+	   'prefix:s' => \$PREFIX,
+	   'referer:s'=> \$REFERER,
+	   'hier'     => \$HIER,
+	   'auth=s'   => \$AUTH,
+	   'iis'      => \$IIS,
+	   'tolower'  => \$TOLOWER,
+	   'nospace'  => \$NOSPACE,
+	   'keepext=s' => \$KEEPEXT{'OPT'},
+	  ) || usage();
+
+sub print_version {
+    require LWP;
+    my $DISTNAME = 'libwww-perl-' . LWP::Version();
+    print <<"EOT";
+This is lwp-rget version $VERSION ($DISTNAME)
+
+Copyright 1996-1998, Gisle Aas.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+EOT
+    exit 0;
+}
+
+my $start_url = shift || usage();
+usage() if @ARGV;
+
+require LWP::UserAgent;
+my $ua = new LWP::UserAgent;
+$ua->agent("$progname/$VERSION " . $ua->agent);
+$ua->env_proxy;
+
+unless (defined $PREFIX) {
+    $PREFIX = url($start_url);	 # limit to URLs below this one
+    eval {
+	$PREFIX->eparams(undef);
+	$PREFIX->equery(undef);
+    };
+
+    $_ = $PREFIX->epath;
+    s|[^/]+$||;
+    $PREFIX->epath($_);
+    $PREFIX = $PREFIX->as_string;
+}
+
+%KEEPEXT = map { lc($_) => 1 } split(/\s*,\s*/, ($KEEPEXT{'OPT'}||0));
+
+my $SUPPRESS_REFERER;
+$SUPPRESS_REFERER++ if ($REFERER || "") eq "NONE";
+
+print <<"" if $VERBOSE;
+START	  = $start_url
+MAX_DEPTH = $MAX_DEPTH
+MAX_DOCS  = $MAX_DOCS
+PREFIX	  = $PREFIX
+
+my $no_docs = 0;
+my %seen = ();	   # mapping from URL => local_file
+
+my $filename = fetch($start_url, undef, $REFERER);
+print "$filename\n" unless $QUIET;
+
+sub fetch
+{
+    my($url, $type, $referer, $depth) = @_;
+
+    # Fix http://sitename.com/../blah/blah.html to
+    #	  http://sitename.com/blah/blah.html
+    $url = $url->as_string if (ref($url));
+    while ($url =~ s#(https?://[^/]+/)\.\.\/#$1#) {}
+
+    # Fix backslashes (\) in URL if $IIS defined
+    $url = fix_backslashes($url) if (defined $IIS);
+
+    $url = url($url);
+    $type  ||= 'a';
+    # Might be the background attribute
+    $type = 'img' if ($type eq 'body' || $type eq 'td');
+    $depth ||= 0;
+
+    # Print the URL before we start checking...
+    my $out = (" " x $depth) . $url . " ";
+    $out .= "." x (60 - length($out));
+    print STDERR $out . " " if $VERBOSE;
+
+    # Can't get mailto things
+    if ($url->scheme eq 'mailto') {
+	print STDERR "*skipping mailto*\n" if $VERBOSE;
+	return $url->as_string;
+    }
+
+    # The $plain_url is a URL without the fragment part
+    my $plain_url = $url->clone;
+    $plain_url->frag(undef);
+
+    # Check PREFIX, but not for <IMG ...> links
+    if ($type ne 'img' and  $url->as_string !~ /^\Q$PREFIX/o) {
+	print STDERR "*outsider*\n" if $VERBOSE;
+	return $url->as_string;
+    }
+
+    # Translate URL to lowercase if $TOLOWER defined
+    $plain_url = to_lower($plain_url) if (defined $TOLOWER);
+
+    # If we already have it, then there is nothing to be done
+    my $seen = $seen{$plain_url->as_string};
+    if ($seen) {
+	my $frag = $url->frag;
+	$seen .= "#$frag" if defined($frag);
+	$seen = protect_frag_spaces($seen);
+	print STDERR "$seen (again)\n" if $VERBOSE;
+	return $seen;
+    }
+
+    # Too much or too deep
+    if ($depth > $MAX_DEPTH and $type ne 'img') {
+	print STDERR "*too deep*\n" if $VERBOSE;
+	return $url;
+    }
+    if ($no_docs > $MAX_DOCS) {
+	print STDERR "*too many*\n" if $VERBOSE;
+	return $url;
+    }
+
+    # Fetch document 
+    $no_docs++;
+    sleep($SLEEP) if $SLEEP;
+    my $req = HTTP::Request->new(GET => $url);
+    # See: http://ftp.sunet.se/pub/NT/mirror-microsoft/kb/Q163/7/74.TXT
+    $req->header ('Accept', '*/*') if (defined $IIS);  # GIF/JPG from IIS 2.0
+    $req->authorization_basic(split (/:/, $AUTH)) if (defined $AUTH);
+    if ($referer && !$SUPPRESS_REFERER) {
+	if ($req->url->scheme eq 'http') {
+	    # RFC 2616, section 15.1.3
+	    $referer = url($referer) unless ref($referer);
+	    undef $referer if ($referer->scheme || '') eq 'https';
+	}
+	$req->referer($referer) if $referer;
+    }
+    my $res = $ua->request($req);
+
+    # Check outcome
+    if ($res->is_success) {
+	my $doc = $res->content;
+	my $ct = $res->content_type;
+	my $name = find_name($res->request->url, $ct);
+	print STDERR "$name\n" unless $QUIET;
+	$seen{$plain_url->as_string} = $name;
+
+	# If the file is HTML, then we look for internal links
+	if ($ct eq "text/html") {
+	    # Save an unprosessed version of the HTML document.	 This
+	    # both reserves the name used, and it also ensures that we
+	    # don't loose everything if this program is killed before
+	    # we finish.
+	    save($name, $doc);
+	    my $base = $res->base;
+
+	    # Follow and substitute links...
+	    $doc =~
+s/
+  (
+    <(img|a|body|area|frame|td)\b   # some interesting tag
+    [^>]+			    # still inside tag (not strictly correct)
+    \b(?:src|href|background)	    # some link attribute
+    \s*=\s*			    # =
+  )
+    (?:				    # scope of OR-ing
+	 (")([^"]*)"	|	    # value in double quotes  OR
+	 (')([^']*)'	|	    # value in single quotes  OR
+	    ([^\s>]+)		    # quoteless value
+    )
+/
+  new_link($1, lc($2), $3||$5, HTML::Entities::decode($4||$6||$7),
+           $base, $name, "$url", $depth+1)
+/giex;
+	   # XXX
+	   # The regular expression above is not strictly correct.
+	   # It is not really possible to parse HTML with a single
+	   # regular expression, but it is faster.  Tags that might
+	   # confuse us include:
+	   #	<a alt="href" href=link.html>
+	   #	<a alt=">" href="link.html">
+	   #
+	}
+	save($name, $doc);
+	return $name;
+    }
+    else {
+	print STDERR $res->code . " " . $res->message . "\n" if $VERBOSE;
+	$seen{$plain_url->as_string} = $url->as_string;
+	return $url->as_string;
+    }
+}
+
+sub new_link
+{
+    my($pre, $type, $quote, $url, $base, $localbase, $referer, $depth) = @_;
+
+    $url = protect_frag_spaces($url);
+
+    $url = fetch(url($url, $base)->abs, $type, $referer, $depth);
+    $url = url("file:$url", "file:$localbase")->rel
+	unless $url =~ /^[.+\-\w]+:/;
+
+    $url = unprotect_frag_spaces($url);
+
+    return $pre . $quote . $url . $quote;
+}
+
+
+sub protect_frag_spaces
+{
+    my ($url) = @_;
+
+    $url = $url->as_string if (ref($url));
+
+    if ($url =~ m/^([^#]*#)(.+)$/)
+    {
+      my ($base, $frag) = ($1, $2);
+      $frag =~ s/ /%20/g;
+      $url = $base . $frag;
+    }
+
+    return $url;
+}
+
+
+sub unprotect_frag_spaces
+{
+    my ($url) = @_;
+
+    $url = $url->as_string if (ref($url));
+
+    if ($url =~ m/^([^#]*#)(.+)$/)
+    {
+      my ($base, $frag) = ($1, $2);
+      $frag =~ s/%20/ /g;
+      $url = $base . $frag;
+    }
+
+    return $url;
+}
+
+
+sub fix_backslashes
+{
+    my ($url) = @_;
+    my ($base, $frag);
+
+    $url = $url->as_string if (ref($url));
+
+    if ($url =~ m/([^#]+)(#.*)/)
+    {
+      ($base, $frag) = ($1, $2);
+    }
+    else
+    {
+      $base = $url;
+      $frag = "";
+    }
+
+    $base =~ tr/\\/\//;
+    $base =~ s/%5[cC]/\//g;	# URL-encoded back slash is %5C
+
+    return $base . $frag;
+}
+
+
+sub to_lower
+{
+    my ($url) = @_;
+    my $was_object = 0;
+
+    if (ref($url))
+    {
+      $url = $url->as_string;
+      $was_object = 1;
+    }
+
+    if ($url =~ m/([^#]+)(#.*)/)
+    {
+      $url = lc($1) . $2;
+    }
+    else
+    {
+      $url = lc($url);
+    }
+
+    if ($was_object == 1)
+    {
+      return url($url);
+    }
+    else
+    {
+      return $url;
+    }
+}
+
+
+sub translate_spaces
+{
+    my ($url) = @_;
+    my ($base, $frag);
+
+    $url = $url->as_string if (ref($url));
+
+    if ($url =~ m/([^#]+)(#.*)/)
+    {
+      ($base, $frag) = ($1, $2);
+    }
+    else
+    {
+      $base = $url;
+      $frag = "";
+    }
+
+    $base =~ s/^ *//;	# Remove initial spaces from base
+    $base =~ s/ *$//;	# Remove trailing spaces from base
+
+    $base =~ tr/ /_/;
+    $base =~ s/%20/_/g; # URL-encoded space is %20
+
+    return $base . $frag;
+}
+
+
+sub mkdirp
+{
+    my($directory, $mode) = @_;
+    my @dirs = split(/\//, $directory);
+    my $path = shift(@dirs);   # build it as we go
+    my $result = 1;   # assume it will work
+
+    unless (-d $path) {
+	$result &&= mkdir($path, $mode);
+    }
+
+    foreach (@dirs) {
+	$path .= "/$_";
+	if ( ! -d $path) {
+	    $result &&= mkdir($path, $mode);
+	}
+    }
+
+    return $result;
+}
+
+
+sub find_name
+{
+    my($url, $type) = @_;
+    #print "find_name($url, $type)\n";
+
+    # Translate spaces in URL to underscores (_) if $NOSPACE defined
+    $url = translate_spaces($url) if (defined $NOSPACE);
+
+    # Translate URL to lowercase if $TOLOWER defined
+    $url = to_lower($url) if (defined $TOLOWER);
+
+    $url = url($url) unless ref($url);
+
+    my $path = $url->path;
+
+    # trim path until only the basename is left
+    $path =~ s|(.*/)||;
+    my $dirname = ".$1";
+    if (!$HIER) {
+	$dirname = "";
+    }
+    elsif (! -d $dirname) {
+	mkdirp($dirname, 0775);
+    }
+
+    my $extra = "";  # something to make the name unique
+    my $suffix;
+
+    if ($KEEPEXT{lc($type)}) {
+        $suffix = ($path =~ m/\.(.*)/) ? $1 : "";
+    }
+    else {
+        $suffix = media_suffix($type);
+    }
+
+    $path =~ s|\..*||;	# trim suffix
+    $path = "index" unless length $path;
+
+    while (1) {
+	# Construct a new file name
+	my $file = $dirname . $path . $extra;
+	$file .= ".$suffix" if $suffix;
+	# Check if it is unique
+	return $file unless -f $file;
+
+	# Try something extra
+	unless ($extra) {
+	    $extra = "001";
+	    next;
+	}
+	$extra++;
+    }
+}
+
+
+sub save
+{
+    my $name = shift;
+    #print "save($name,...)\n";
+    open(FILE, ">$name") || die "Can't save $name: $!";
+    binmode FILE;
+    print FILE $_[0];
+    close(FILE);
+}
+
+
+sub usage
+{
+    print <<""; exit 1;
+Usage: $progname [options] <URL>
+Allowed options are:
+  --auth=USER:PASS  Set authentication credentials for web site
+  --depth=N	    Maximum depth to traverse (default is $MAX_DEPTH)
+  --hier	    Download into hierarchy (not all files into cwd)
+  --referer=URI     Set initial referer header (or "NONE")
+  --iis		    Workaround IIS 2.0 bug by sending "Accept: */*" MIME
+		    header; translates backslashes (\\) to forward slashes (/)
+  --keepext=type    Keep file extension for MIME types (comma-separated list)
+  --limit=N	    A limit on the number documents to get (default is $MAX_DOCS)
+  --nospace	    Translate spaces URLs (not #fragments) to underscores (_)
+  --version	    Print version number and quit
+  --verbose	    More output
+  --quiet	    No output
+  --sleep=SECS	    Sleep between gets, ie. go slowly
+  --prefix=PREFIX   Limit URLs to follow to those which begin with PREFIX
+  --tolower	    Translate all URLs to lowercase (useful with IIS servers)
+
+}
+
+__END__
+:endofperl

Perl/bin/perlcc.bat

@@ -0,0 +1,666 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+    if $running_under_some_shell;
+--$running_under_some_shell;
+
+# Version 2.0, Simon Cozens, Thu Mar 30 17:52:45 JST 2000 
+# Version 2.01, Tom Christiansen, Thu Mar 30 08:25:14 MST 2000
+# Version 2.02, Simon Cozens, Sun Apr 16 01:53:36 JST 2000
+# Version 2.03, Edward Peschko, Mon Feb 26 12:04:17 PST 2001
+# Version 2.04, Enache Adrian,Fri, 18 Jul 2003 23:15:37 +0300
+
+use strict;
+use warnings;
+use 5.006_000;
+
+use FileHandle;
+use Config;
+use Fcntl qw(:DEFAULT :flock);
+use File::Temp qw(tempfile);
+use Cwd;
+our $VERSION = 2.04;
+$| = 1;
+
+$SIG{INT} = sub { exit(); }; # exit gracefully and clean up after ourselves.
+
+use subs qw{
+    cc_harness check_read check_write checkopts_byte choose_backend
+    compile_byte compile_cstyle compile_module generate_code
+    grab_stash parse_argv sanity_check vprint yclept spawnit
+};
+sub opt(*); # imal quoting
+sub is_win32();
+sub is_msvc();
+
+our ($Options, $BinPerl, $Backend);
+our ($Input => $Output);
+our ($logfh);
+our ($cfile);
+our (@begin_output); # output from BEGIN {}, for testsuite
+
+# eval { main(); 1 } or die;
+
+main();
+
+sub main {
+    parse_argv();
+    check_write($Output);
+    choose_backend();
+    generate_code();
+    run_code();
+    _die("XXX: Not reached?");
+}
+
+#######################################################################
+
+sub choose_backend {
+    # Choose the backend.
+    $Backend = 'C';
+    if (opt(B)) {
+        checkopts_byte();
+        $Backend = 'Bytecode';
+    }
+    if (opt(S) && opt(c)) {
+        # die "$0: Do you want me to compile this or not?\n";
+        delete $Options->{S};
+    }
+    $Backend = 'CC' if opt(O);
+}
+
+
+sub generate_code { 
+
+    vprint 0, "Compiling $Input";
+
+    $BinPerl  = yclept();  # Calling convention for perl.
+
+    if (opt(shared)) {
+        compile_module();
+    } else {
+        if ($Backend eq 'Bytecode') {
+            compile_byte();
+        } else {
+            compile_cstyle();
+        }
+    }
+    exit(0) if (!opt('r'));
+}
+
+sub run_code {
+    vprint 0, "Running code";
+    run("$Output @ARGV");
+    exit(0);
+}
+
+# usage: vprint [level] msg args
+sub vprint {
+    my $level;
+    if (@_ == 1) {
+        $level = 1;
+    } elsif ($_[0] =~ /^\d$/) {
+        $level = shift;
+    } else {
+        # well, they forgot to use a number; means >0
+        $level = 0;
+    } 
+    my $msg = "@_";
+    $msg .= "\n" unless substr($msg, -1) eq "\n";
+    if (opt(v) > $level)
+    {
+         print        "$0: $msg" if !opt('log');
+	 print $logfh "$0: $msg" if  opt('log');
+    }
+}
+
+sub parse_argv {
+
+    use Getopt::Long; 
+
+    # disallows using long arguments
+    # Getopt::Long::Configure("bundling");
+
+    Getopt::Long::Configure("no_ignore_case");
+
+    # no difference in exists and defined for %ENV; also, a "0"
+    # argument or a "" would not help cc, so skip
+    unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS};
+
+    $Options = {};
+    Getopt::Long::GetOptions( $Options,
+        'L:s',          # lib directory
+        'I:s',          # include directories (FOR C, NOT FOR PERL)
+        'o:s',          # Output executable
+        'v:i',          # Verbosity level
+        'e:s',          # One-liner
+	'r',            # run resulting executable
+        'B',            # Byte compiler backend
+        'O',            # Optimised C backend
+        'c',            # Compile only
+        'h',            # Help me
+        'S',            # Dump C files
+	'r',            # run the resulting executable
+        'T',            # run the backend using perl -T
+        't',            # run the backend using perl -t
+        'static',       # Dirty hack to enable -shared/-static
+        'shared',       # Create a shared library (--shared for compat.)
+	'log:s',        # where to log compilation process information
+        'Wb:s',         # pass (comma-sepearated) options to backend
+        'testsuite',    # try to be nice to testsuite
+    );
+
+    $Options->{v} += 0;
+
+    if( opt(t) && opt(T) ) {
+        warn "Can't specify both -T and -t, -t ignored";
+        $Options->{t} = 0;
+    }
+
+    helpme() if opt(h); # And exit
+
+    $Output = opt(o) || ( is_win32 ? 'a.exe' : 'a.out' );
+    $Output = is_win32() ? $Output : relativize($Output);
+    $logfh  = new FileHandle(">> " . opt('log')) if (opt('log'));
+
+    if (opt(e)) {
+        warn "$0: using -e 'code' as input file, ignoring @ARGV\n" if @ARGV;
+        # We don't use a temporary file here; why bother?
+        # XXX: this is not bullet proof -- spaces or quotes in name!
+        $Input = is_win32() ? # Quotes eaten by shell
+            '-e "'.opt(e).'"' :
+            "-e '".opt(e)."'";
+    } else {
+        $Input = shift @ARGV;  # XXX: more files?
+        _usage_and_die("$0: No input file specified\n") unless $Input;
+        # DWIM modules. This is bad but necessary.
+        $Options->{shared}++ if $Input =~ /\.pm\z/;
+        warn "$0: using $Input as input file, ignoring @ARGV\n" if @ARGV;
+        check_read($Input);
+        check_perl($Input);
+        sanity_check();
+    }
+
+}
+
+sub opt(*) {
+    my $opt = shift;
+    return exists($Options->{$opt}) && ($Options->{$opt} || 0);
+} 
+
+sub compile_module { 
+    die "$0: Compiling to shared libraries is currently disabled\n";
+}
+
+sub compile_byte {
+    my $command = "$BinPerl -MO=Bytecode,-H,-o$Output $Input";
+    $Input =~ s/^-e.*$/-e/;
+
+    my ($output_r, $error_r) = spawnit($command);
+
+    if (@$error_r && $? != 0) {
+	_die("$0: $Input did not compile:\n@$error_r\n");
+    } else {
+	my @error = grep { !/^$Input syntax OK$/o } @$error_r;
+	warn "$0: Unexpected compiler output:\n@error" if @error;
+    }
+
+    chmod 0777 & ~umask, $Output    or _die("can't chmod $Output: $!");
+    exit 0;
+}
+
+sub compile_cstyle {
+    my $stash = grab_stash();
+    my $taint = opt(T) ? '-T' :
+                opt(t) ? '-t' : '';
+
+    # What are we going to call our output C file?
+    my $lose = 0;
+    my ($cfh);
+    my $testsuite = '';
+    my $addoptions = opt(Wb);
+
+    if( $addoptions ) {
+        $addoptions .= ',' if $addoptions !~ m/,$/;
+    }
+
+    if (opt(testsuite)) {
+        my $bo = join '', @begin_output;
+        $bo =~ s/\\/\\\\\\\\/gs;
+        $bo =~ s/\n/\\n/gs;
+        $bo =~ s/,/\\054/gs;
+        # don't look at that: it hurts
+        $testsuite = q{-fuse-script-name,-fsave-data,-fsave-sig-hash,}.
+            qq[-e"print q{$bo}",] .
+            q{-e"open(Test::Builder::TESTOUT\054 '>&STDOUT') or die $!",} .
+            q{-e"open(Test::Builder::TESTERR\054 '>&STDERR') or die $!",};
+    }
+    if (opt(S) || opt(c)) {
+        # We need to keep it.
+        if (opt(e)) {
+            $cfile = "a.out.c";
+        } else {
+            $cfile = $Input;
+            # File off extension if present
+            # hold on: plx is executable; also, careful of ordering!
+            $cfile =~ s/\.(?:p(?:lx|l|h)|m)\z//i;
+            $cfile .= ".c";
+            $cfile = $Output if opt(c) && $Output =~ /\.c\z/i;
+        }
+        check_write($cfile);
+    } else {
+        # Don't need to keep it, be safe with a tempfile.
+        $lose = 1;
+        ($cfh, $cfile) = tempfile("pccXXXXX", SUFFIX => ".c"); 
+        close $cfh; # See comment just below
+    }
+    vprint 1, "Writing C on $cfile";
+
+    my $max_line_len = '';
+    if ($^O eq 'MSWin32' && $Config{cc} =~ /^cl/i) {
+        $max_line_len = '-l2000,';
+    }
+
+    # This has to do the write itself, so we can't keep a lock. Life
+    # sucks.
+    my $command = "$BinPerl $taint -MO=$Backend,$addoptions$testsuite$max_line_len$stash,-o$cfile $Input";
+    vprint 1, "Compiling...";
+    vprint 1, "Calling $command";
+
+	my ($output_r, $error_r) = spawnit($command);
+	my @output = @$output_r;
+	my @error = @$error_r;
+
+    if (@error && $? != 0) {
+        _die("$0: $Input did not compile, which can't happen:\n@error\n");
+    }
+
+    is_msvc ?
+        cc_harness_msvc($cfile,$stash) :
+        cc_harness($cfile,$stash) unless opt(c);
+
+    if ($lose) {
+        vprint 2, "unlinking $cfile";
+        unlink $cfile or _die("can't unlink $cfile: $!"); 
+    }
+}
+
+sub cc_harness_msvc {
+    my ($cfile,$stash)=@_;
+    use ExtUtils::Embed ();
+    my $obj = "${Output}.obj";
+    my $compile = ExtUtils::Embed::ccopts." -c -Fo$obj $cfile ";
+    my $link = "-out:$Output $obj";
+    $compile .= " -I".$_ for split /\s+/, opt(I);
+    $link .= " -libpath:".$_ for split /\s+/, opt(L);
+    my @mods = split /-?u /, $stash;
+    $link .= " ".ExtUtils::Embed::ldopts("-std", \@mods);
+    $link .= " perl5$Config{PERL_VERSION}.lib kernel32.lib msvcrt.lib";
+    vprint 3, "running $Config{cc} $compile";
+    system("$Config{cc} $compile");
+    vprint 3, "running $Config{ld} $link";
+    system("$Config{ld} $link");
+}
+
+sub cc_harness {
+	my ($cfile,$stash)=@_;
+	use ExtUtils::Embed ();
+	my $command = ExtUtils::Embed::ccopts." -o $Output $cfile ";
+	$command .= " -I".$_ for split /\s+/, opt(I);
+	$command .= " -L".$_ for split /\s+/, opt(L);
+	my @mods = split /-?u /, $stash;
+	$command .= " ".ExtUtils::Embed::ldopts("-std", \@mods);
+        $command .= " -lperl";
+	vprint 3, "running $Config{cc} $command";
+	system("$Config{cc} $command");
+}
+
+# Where Perl is, and which include path to give it.
+sub yclept {
+    my $command = "$^X ";
+
+    # DWIM the -I to be Perl, not C, include directories.
+    if (opt(I) && $Backend eq "Bytecode") {
+        for (split /\s+/, opt(I)) {
+            if (-d $_) {
+                push @INC, $_;
+            } else {
+                warn "$0: Include directory $_ not found, skipping\n";
+            }
+        }
+    }
+            
+    $command .= "-I$_ " for @INC;
+    return $command;
+}
+
+# Use B::Stash to find additional modules and stuff.
+{
+    my $_stash;
+    sub grab_stash {
+
+        warn "already called get_stash once" if $_stash;
+
+        my $taint = opt(T) ? '-T' :
+                    opt(t) ? '-t' : '';
+        my $command = "$BinPerl $taint -MB::Stash -c $Input";
+        # Filename here is perfectly sanitised.
+        vprint 3, "Calling $command\n";
+
+		my ($stash_r, $error_r) = spawnit($command);
+		my @stash = @$stash_r;
+		my @error = @$error_r;
+
+    	if (@error && $? != 0) {
+            _die("$0: $Input did not compile:\n@error\n");
+        }
+
+        # band-aid for modules with noisy BEGIN {}
+        foreach my $i ( @stash ) {
+            $i =~ m/-u(?:[\w:]+|\<none\>)$/ and $stash[0] = $i and next;
+            push @begin_output, $i;
+        }
+        chomp $stash[0];
+        $stash[0] =~ s/,-u\<none\>//;
+        $stash[0] =~ s/^.*?-u/-u/s;
+        vprint 2, "Stash: ", join " ", split /,?-u/, $stash[0];
+        chomp $stash[0];
+        return $_stash = $stash[0];
+    }
+
+}
+
+# Check the consistency of options if -B is selected.
+# To wit, (-B|-O) ==> no -shared, no -S, no -c
+sub checkopts_byte {
+
+    _die("$0: Please choose one of either -B and -O.\n") if opt(O);
+
+    if (opt(shared)) {
+        warn "$0: Will not create a shared library for bytecode\n";
+        delete $Options->{shared};
+    }
+
+    for my $o ( qw[c S] ) { 
+        if (opt($o)) { 
+            warn "$0: Compiling to bytecode is a one-pass process--",
+                  "-$o ignored\n";
+            delete $Options->{$o};
+        }
+    }
+
+}
+
+# Check the input and output files make sense, are read/writeable.
+sub sanity_check {
+    if ($Input eq $Output) {
+        if ($Input eq 'a.out') {
+            _die("$0: Compiling a.out is probably not what you want to do.\n");
+            # You fully deserve what you get now. No you *don't*. typos happen.
+        } else {
+            warn "$0: Will not write output on top of input file, ",
+                "compiling to a.out instead\n";
+            $Output = "a.out";
+        }
+    }
+}
+
+sub check_read { 
+    my $file = shift;
+    unless (-r $file) {
+        _die("$0: Input file $file is a directory, not a file\n") if -d _;
+        unless (-e _) {
+            _die("$0: Input file $file was not found\n");
+        } else {
+            _die("$0: Cannot read input file $file: $!\n");
+        }
+    }
+    unless (-f _) {
+        # XXX: die?  don't try this on /dev/tty
+        warn "$0: WARNING: input $file is not a plain file\n";
+    } 
+}
+
+sub check_write {
+    my $file = shift;
+    if (-d $file) {
+        _die("$0: Cannot write on $file, is a directory\n");
+    }
+    if (-e _) {
+        _die("$0: Cannot write on $file: $!\n") unless -w _;
+    } 
+    unless (-w cwd()) { 
+        _die("$0: Cannot write in this directory: $!\n");
+    }
+}
+
+sub check_perl {
+    my $file = shift;
+    unless (-T $file) {
+        warn "$0: Binary `$file' sure doesn't smell like perl source!\n";
+        print "Checking file type... ";
+        system("file", $file);  
+        _die("Please try a perlier file!\n");
+    } 
+
+    open(my $handle, "<", $file)    or _die("XXX: can't open $file: $!");
+    local $_ = <$handle>;
+    if (/^#!/ && !/perl/) {
+        _die("$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n");
+    } 
+
+} 
+
+# File spawning and error collecting
+sub spawnit {
+	my ($command) = shift;
+	my (@error,@output);
+	my $errname;
+	(undef, $errname) = tempfile("pccXXXXX");
+	{ 
+	open (S_OUT, "$command 2>$errname |")
+		or _die("$0: Couldn't spawn the compiler.\n");
+	@output = <S_OUT>;
+	}
+	open (S_ERROR, $errname) or _die("$0: Couldn't read the error file.\n");
+	@error = <S_ERROR>;
+	close S_ERROR;
+	close S_OUT;
+	unlink $errname or _die("$0: Can't unlink error file $errname");
+	return (\@output, \@error);
+}
+
+sub helpme {
+       print "perlcc compiler frontend, version $VERSION\n\n";
+       { no warnings;
+       exec "pod2usage $0";
+       exec "perldoc $0";
+       exec "pod2text $0";
+       }
+}
+
+sub relativize {
+	my ($args) = @_;
+
+	return() if ($args =~ m"^[/\\]");
+	return("./$args");
+}
+
+sub _die {
+    $logfh->print(@_) if opt('log');
+    print STDERR @_;
+    exit(); # should die eventually. However, needed so that a 'make compile'
+            # can compile all the way through to the end for standard dist.
+}
+
+sub _usage_and_die {
+    _die(<<EOU);
+$0: Usage:
+$0 [-o executable] [-r] [-O|-B|-c|-S] [-I /foo] [-L /foo] [-log log] [source[.pl] | -e oneliner]
+EOU
+}
+
+sub run {
+    my (@commands) = @_;
+
+    print interruptrun(@commands) if (!opt('log'));
+    $logfh->print(interruptrun(@commands)) if (opt('log'));
+}
+
+sub interruptrun
+{
+    my (@commands) = @_;
+
+    my $command = join('', @commands);
+    local(*FD);
+    my $pid = open(FD, "$command |");
+    my $text;
+    
+    local($SIG{HUP}) = sub { kill 9, $pid; exit };
+    local($SIG{INT}) = sub { kill 9, $pid; exit };
+
+    my $needalarm = 
+          ($ENV{PERLCC_TIMEOUT} && 
+	  $Config{'osname'} ne 'MSWin32' && 
+	  $command =~ m"(^|\s)perlcc\s");
+
+    eval 
+    {
+         local($SIG{ALRM}) = sub { die "INFINITE LOOP"; };
+         alarm($ENV{PERLCC_TIMEOUT}) if ($needalarm);
+	 $text = join('', <FD>);
+	 alarm(0) if ($needalarm);
+    };
+
+    if ($@)
+    {
+        eval { kill 'HUP', $pid };
+        vprint 0, "SYSTEM TIMEOUT (infinite loop?)\n";
+    }
+
+    close(FD);
+    return($text);
+}
+
+sub is_win32() { $^O =~ m/^MSWin/ }
+sub is_msvc() { is_win32 && $Config{cc} =~ m/^cl/i }
+
+END {
+    unlink $cfile if ($cfile && !opt(S) && !opt(c));
+}
+
+__END__
+
+=head1 NAME
+
+perlcc - generate executables from Perl programs
+
+=head1 SYNOPSIS
+
+    $ perlcc hello              # Compiles into executable 'a.out'
+    $ perlcc -o hello hello.pl  # Compiles into executable 'hello'
+
+    $ perlcc -O file            # Compiles using the optimised C backend
+    $ perlcc -B file            # Compiles using the bytecode backend
+
+    $ perlcc -c file            # Creates a C file, 'file.c'
+    $ perlcc -S -o hello file   # Creates a C file, 'file.c',
+                                # then compiles it to executable 'hello'
+    $ perlcc -c out.c file      # Creates a C file, 'out.c' from 'file'
+
+    $ perlcc -e 'print q//'     # Compiles a one-liner into 'a.out'
+    $ perlcc -c -e 'print q//'  # Creates a C file 'a.out.c'
+
+    $ perlcc -I /foo hello	# extra headers (notice the space after -I)
+    $ perlcc -L /foo hello	# extra libraries (notice the space after -L)
+
+    $ perlcc -r hello           # compiles 'hello' into 'a.out', runs 'a.out'.
+    $ perlcc -r hello a b c     # compiles 'hello' into 'a.out', runs 'a.out'.
+                                # with arguments 'a b c' 
+
+    $ perlcc hello -log c       # compiles 'hello' into 'a.out' logs compile
+                                # log into 'c'. 
+
+=head1 DESCRIPTION
+
+F<perlcc> creates standalone executables from Perl programs, using the
+code generators provided by the L<B> module. At present, you may
+either create executable Perl bytecode, using the C<-B> option, or 
+generate and compile C files using the standard and 'optimised' C
+backends.
+
+The code generated in this way is not guaranteed to work. The whole
+codegen suite (C<perlcc> included) should be considered B<very>
+experimental. Use for production purposes is strongly discouraged.
+
+=head1 OPTIONS
+
+=over 4
+
+=item -LI<library directories>
+
+Adds the given directories to the library search path when C code is
+passed to your C compiler.
+
+=item -II<include directories>
+
+Adds the given directories to the include file search path when C code is
+passed to your C compiler; when using the Perl bytecode option, adds the
+given directories to Perl's include path.
+
+=item -o I<output file name>
+
+Specifies the file name for the final compiled executable.
+
+=item -c I<C file name>
+
+Create C code only; do not compile to a standalone binary.
+
+=item -e I<perl code>
+
+Compile a one-liner, much the same as C<perl -e '...'>
+
+=item -S
+
+Do not delete generated C code after compilation.
+
+=item -B
+
+Use the Perl bytecode code generator.
+
+=item -O
+
+Use the 'optimised' C code generator. This is more experimental than
+everything else put together, and the code created is not guaranteed to
+compile in finite time and memory, or indeed, at all.
+
+=item -v
+
+Increase verbosity of output; can be repeated for more verbose output.
+
+=item -r 
+
+Run the resulting compiled script after compiling it.
+
+=item -log
+
+Log the output of compiling to a file rather than to stdout.
+
+=back
+
+=cut
+
+
+__END__
+:endofperl

Perl/bin/perldoc.bat

@@ -0,0 +1,27 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+	if 0;
+
+# This "perldoc" file was generated by "perldoc.PL"
+
+require 5;
+BEGIN { $^W = 1 if $ENV{'PERLDOCDEBUG'} }
+use Pod::Perldoc;
+exit( Pod::Perldoc->run() );
+
+
+__END__
+:endofperl

Perl/bin/perlglob.bat

@@ -0,0 +1,69 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl -w
+#line 15
+use File::DosGlob;
+$| = 1;
+while (@ARGV) {
+    my $arg = shift;
+    my @m = File::DosGlob::doglob(1,$arg);
+    print (@m ? join("\0", sort @m) : $arg);
+    print "\0" if @ARGV;
+}
+__END__
+
+=head1 NAME
+
+perlglob.bat - a more capable perlglob.exe replacement
+
+=head1 SYNOPSIS
+
+    @perlfiles = glob  "..\\pe?l/*.p?";
+    print <..\\pe?l/*.p?>;
+
+    # more efficient version
+    > perl -MFile::DosGlob=glob -e "print <../pe?l/*.p?>"
+
+=head1 DESCRIPTION
+
+This file is a portable replacement for perlglob.exe.  It
+is largely compatible with perlglob.exe (the Microsoft setargv.obj
+version) in all but one respect--it understands wildcards in
+directory components.
+
+It prints null-separated filenames to standard output.
+
+For details of the globbing features implemented, see
+L<File::DosGlob>.
+
+While one may replace perlglob.exe with this, usage by overriding
+CORE::glob with File::DosGlob::glob should be much more efficient,
+because it avoids launching a separate process, and is therefore
+strongly recommended.  See L<perlsub> for details of overriding
+builtins.
+
+=head1 AUTHOR
+
+Gurusamy Sarathy <gsar@activestate.com>
+
+=head1 SEE ALSO
+
+perl
+
+File::DosGlob
+
+=cut
+
+
+__END__
+:endofperl

Perl/bin/perlivp.bat

@@ -0,0 +1,446 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+        if $running_under_some_shell;
+
+# perlivp V 0.02
+
+
+sub usage {
+    warn "@_\n" if @_;
+    print << "    EOUSAGE";
+Usage:
+
+    $0 [-a] [-p] [-v] | [-h]
+
+    -a Run all tests (default is to skip .ph tests)
+    -p Print a preface before each test telling what it will test.
+    -v Verbose mode in which extra information about test results
+       is printed.  Test failures always print out some extra information
+       regardless of whether or not this switch is set.
+    -h Prints this help message.
+    EOUSAGE
+    exit;
+}
+
+use vars qw(%opt); # allow testing with older versions (do not use our)
+
+@opt{ qw/? H h P p V v/ } = qw(0 0 0 0 0 0 0);
+
+while ($ARGV[0] =~ /^-/) {
+    $ARGV[0] =~ s/^-//; 
+    for my $flag (split(//,$ARGV[0])) {
+        usage() if '?' =~ /\Q$flag/;
+        usage() if 'h' =~ /\Q$flag/;
+        usage() if 'H' =~ /\Q$flag/;
+        usage("unknown flag: `$flag'") unless 'HhPpVva' =~ /\Q$flag/;
+        warn "$0: `$flag' flag already set\n" if $opt{$flag}++;
+    } 
+    shift;
+}
+
+$opt{p}++ if $opt{P};
+$opt{v}++ if $opt{V};
+
+my $pass__total = 0;
+my $error_total = 0;
+my $tests_total = 0;
+
+my $perlpath = 'C:\Perl\bin\perl.exe';
+my $useithreads = 'define';
+
+print "## Checking Perl binary via variable `\$perlpath' = $perlpath.\n" if $opt{'p'};
+
+if (-x $perlpath) {
+    print "## Perl binary `$perlpath' appears executable.\n" if $opt{'v'};
+    print "ok 1\n";
+    $pass__total++;
+}
+else {
+    print "# Perl binary `$perlpath' does not appear executable.\n";
+    print "not ok 1\n";
+    $error_total++;
+}
+$tests_total++;
+
+
+print "## Checking Perl version via variable `\$]'.\n" if $opt{'p'};
+
+my $ivp_VERSION = 5.008008;
+
+if ($ivp_VERSION eq $]) {
+    print "## Perl version `$]' appears installed as expected.\n" if $opt{'v'};
+    print "ok 2\n";
+    $pass__total++;
+}
+else {
+    print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
+    print "not ok 2\n";
+    $error_total++;
+}
+$tests_total++;
+
+
+print "## Checking roots of the Perl library directory tree via variable `\@INC'.\n" if $opt{'p'};
+
+my $INC_total = 0;
+my $INC_there = 0;
+foreach (@INC) {
+    next if $_ eq '.'; # skip -d test here
+    if ($^O eq 'MacOS') {
+        next if $_ eq ':'; # skip -d test here
+        next if $_ eq 'Dev:Pseudo:'; # why is this in @INC?
+    }
+    if (-d $_) {
+        print "## Perl \@INC directory `$_' exists.\n" if $opt{'v'};
+        $INC_there++;
+    }
+    else {
+        print "# Perl \@INC directory `$_' does not appear to exist.\n";
+    }
+    $INC_total++;
+}
+if ($INC_total == $INC_there) {
+    print "ok 3\n";
+    $pass__total++;
+}
+else {
+    print "not ok 3\n";
+    $error_total++;
+}
+$tests_total++;
+
+
+print "## Checking installations of modules necessary for ivp.\n" if $opt{'p'};
+
+my $needed_total = 0;
+my $needed_there = 0;
+foreach (qw(Config.pm ExtUtils/Installed.pm)) {
+    $@ = undef;
+    $needed_total++;
+    eval "require \"$_\";";
+    if (!$@) {
+        print "## Module `$_' appears to be installed.\n" if $opt{'v'};
+        $needed_there++;
+    }
+    else {
+        print "# Needed module `$_' does not appear to be properly installed.\n";
+    }
+    $@ = undef;
+}
+if ($needed_total == $needed_there) {
+    print "ok 4\n";
+    $pass__total++;
+}
+else {
+    print "not ok 4\n";
+    $error_total++;
+}
+$tests_total++;
+
+
+print "## Checking installations of extensions built with perl.\n" if $opt{'p'};
+
+use Config;
+
+my $extensions_total = 0;
+my $extensions_there = 0;
+if (defined($Config{'extensions'})) {
+    my @extensions = split(/\s+/,$Config{'extensions'});
+    foreach (@extensions) {
+        next if ($_ eq '');
+        if ( $useithreads !~ /define/i ) {
+            next if ($_ eq 'threads');
+            next if ($_ eq 'threads/shared');
+        }
+        next if ($_ eq 'Devel/DProf'); 
+           # VMS$ perl  -e "eval ""require \""Devel/DProf.pm\"";"" print $@"
+           # \NT> perl  -e "eval \"require 'Devel/DProf.pm'\"; print $@"
+           # DProf: run perl with -d to use DProf.
+           # Compilation failed in require at (eval 1) line 1.
+        eval " require \"$_.pm\"; ";
+        if (!$@) {
+            print "## Module `$_' appears to be installed.\n" if $opt{'v'};
+            $extensions_there++;
+        }
+        else {
+            print "# Required module `$_' does not appear to be properly installed.\n";
+            $@ = undef;
+        }
+        $extensions_total++;
+    }
+
+    # A silly name for a module (that hopefully won't ever exist).
+    # Note that this test serves more as a check of the validity of the
+    # actuall required module tests above.
+    my $unnecessary = 'bLuRfle';
+
+    if (!grep(/$unnecessary/, @extensions)) {
+        $@ = undef;
+        eval " require \"$unnecessary.pm\"; ";
+        if ($@) {
+            print "## Unnecessary module `$unnecessary' does not appear to be installed.\n" if $opt{'v'};
+        }
+        else {
+            print "# Unnecessary module `$unnecessary' appears to be installed.\n";
+            $extensions_there++;
+        }
+    }
+    $@ = undef;
+}
+if ($extensions_total == $extensions_there) {
+    print "ok 5\n";
+    $pass__total++;
+}
+else {
+    print "not ok 5\n";
+    $error_total++;
+}
+$tests_total++;
+
+
+print "## Checking installations of later additional extensions.\n" if $opt{'p'};
+
+use ExtUtils::Installed;
+
+my $installed_total = 0;
+my $installed_there = 0;
+my $version_check = 0;
+my $installed = ExtUtils::Installed -> new();
+my @modules = $installed -> modules();
+my @missing = ();
+my $version = undef;
+for (@modules) {
+    $installed_total++;
+    # Consider it there if it contains one or more files,
+    # and has zero missing files,
+    # and has a defined version
+    $version = undef;
+    $version = $installed -> version($_);
+    if ($version) {
+        print "## $_; $version\n" if $opt{'v'};
+        $version_check++;
+    }
+    else {
+        print "# $_; NO VERSION\n" if $opt{'v'};
+    }
+    $version = undef;
+    @missing = ();
+    @missing = $installed -> validate($_);
+    if ($#missing >= 0) {
+        print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
+        print '# ',join(' ',@missing),"\n";
+    }
+    elsif ($#missing == -1) {
+        $installed_there++;
+    }
+    @missing = ();
+}
+if (($installed_total == $installed_there) && 
+    ($installed_total == $version_check)) {
+    print "ok 6\n";
+    $pass__total++;
+}
+else {
+    print "not ok 6\n";
+    $error_total++;
+}
+$tests_total++;
+
+
+if ($opt{'a'}) {
+print "## Checking installations of *.h -> *.ph header files.\n" if $opt{'p'};
+my $ph_there = 0;
+my $var = undef;
+my $val = undef;
+my $h_file = undef;
+# Just about "any" C implementation ought to have a stdio.h (even if 
+# Config.pm may not list a i_stdio var).
+my @ph_files = qw(stdio.ph);
+# Add the ones that we know that perl thinks are there:
+while (($var, $val) = each %Config) {
+    if ($var =~ m/i_(.+)/ && $val eq 'define') {
+        $h_file = $1;
+	# Some header and symbol names don't match for hysterical raisins.
+	$h_file = 'arpa/inet'    if $h_file eq 'arpainet';
+	$h_file = 'netinet/in'   if $h_file eq 'niin';
+	$h_file = 'netinet/tcp'  if $h_file eq 'netinettcp';
+	$h_file = 'sys/resource' if $h_file eq 'sysresrc';
+	$h_file = 'sys/select'   if $h_file eq 'sysselct';
+	$h_file = 'sys/security' if $h_file eq 'syssecrt';
+        $h_file = 'rpcsvc/dbm'   if $h_file eq 'rpcsvcdbm';
+        # This ought to distinguish syslog from sys/syslog.
+        # (NB syslog.ph is heavily used for the DBI pre-requisites).
+        $h_file =~ s{^sys(\w.+)}{sys/$1} unless $h_file eq 'syslog';
+        push(@ph_files, "$h_file.ph");
+    }
+}
+#foreach (qw(stdio.ph syslog.ph)) {
+foreach (@ph_files) {
+    $@ = undef;
+    eval "require \"$_\";";
+    if (!$@) {
+        print "## Perl header `$_' appears to be installed.\n" if $opt{'v'};
+        $ph_there++;
+    }
+    else {
+        print "# Perl header `$_' does not appear to be properly installed.\n";
+    }
+    $@ = undef;
+}
+
+if (scalar(@ph_files) == $ph_there) {
+    print "ok 7\n";
+    $pass__total++;
+}
+else {
+    print "not ok 7\n";
+    $error_total++;
+}
+$tests_total++;
+}
+else {
+    print "##  Skip checking of *.ph header files.\n" if $opt{'p'};
+}
+
+# Final report (rather than feed ousrselves to Test::Harness::runtests()
+# we simply format some output on our own to keep things simple and
+# easier to "fix" - at least for now.
+
+if ($error_total == 0 && $tests_total) {
+    print "All tests successful.\n";
+} elsif ($tests_total==0){
+        die "FAILED--no tests were run for some reason.\n";
+} else {
+    my $rate = 0.0;
+    if ($tests_total > 0) { $rate = sprintf "%.2f", 100.0 * ($pass__total / $tests_total); }
+    printf " %d/%d subtests failed, %.2f%% okay.\n",
+                              $error_total, $tests_total, $rate;
+}
+
+=head1 NAME
+
+perlivp - Perl Installation Verification Procedure
+
+=head1 SYNOPSIS
+
+B<perlivp> [B<-a>] [B<-p>] [B<-v>] [B<-h>]
+
+=head1 DESCRIPTION
+
+The B<perlivp> program is set up at Perl source code build time to test the
+Perl version it was built under.  It can be used after running:
+
+    make install
+
+(or your platform's equivalent procedure) to verify that B<perl> and its
+libraries have been installed correctly.  A correct installation is verified
+by output that looks like:
+
+    ok 1
+    ok 2
+
+etc.
+
+=head1 OPTIONS
+
+=over 5
+
+=item B<-h> help
+
+Prints out a brief help message.
+
+=item B<-a> run all tests
+
+Normally tests for optional features are skipped.  With -a all tests
+are executed.
+
+=item B<-p> print preface
+
+Gives a description of each test prior to performing it.
+
+=item B<-v> verbose
+
+Gives more detailed information about each test, after it has been performed.
+Note that any failed tests ought to print out some extra information whether
+or not -v is thrown.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item * print "# Perl binary `$perlpath' does not appear executable.\n";
+
+Likely to occur for a perl binary that was not properly installed.
+Correct by conducting a proper installation.
+
+=item * print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
+
+Likely to occur for a perl that was not properly installed.
+Correct by conducting a proper installation.
+
+=item * print "# Perl \@INC directory `$_' does not appear to exist.\n";
+
+Likely to occur for a perl library tree that was not properly installed.
+Correct by conducting a proper installation.
+
+=item * print "# Needed module `$_' does not appear to be properly installed.\n";
+
+One of the two modules that is used by perlivp was not present in the 
+installation.  This is a serious error since it adversely affects perlivp's
+ability to function.  You may be able to correct this by performing a
+proper perl installation.
+
+=item * print "# Required module `$_' does not appear to be properly installed.\n";
+
+An attempt to C<eval "require $module"> failed, even though the list of 
+extensions indicated that it should succeed.  Correct by conducting a proper 
+installation.
+
+=item * print "# Unnecessary module `bLuRfle' appears to be installed.\n";
+
+This test not coming out ok could indicate that you have in fact installed 
+a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
+test may give misleading results with your installation of perl.  If yours
+is the latter case then please let the author know.
+
+=item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
+
+One or more files turned up missing according to a run of 
+C<ExtUtils::Installed -E<gt> validate()> over your installation.
+Correct by conducting a proper installation.
+
+=item * print "# Perl header `$_' does not appear to be properly installed.\n";
+
+Correct by running B<h2ph> over your system's C header files.  If necessary, 
+edit the resulting *.ph files to eliminate perl syntax errors.
+
+=back
+
+For further information on how to conduct a proper installation consult the 
+INSTALL file that comes with the perl source and the README file for your 
+platform.
+
+=head1 AUTHOR
+
+Peter Prymmer
+
+=cut
+
+
+__END__
+:endofperl

Perl/bin/piconv.bat

@@ -0,0 +1,262 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+	if $running_under_some_shell;
+#!./perl
+# $Id: piconv,v 2.1 2004/10/06 05:07:20 dankogai Exp $
+#
+use 5.8.0;
+use strict;
+use Encode ;
+use Encode::Alias;
+my %Scheme =  map {$_ => 1} qw(from_to decode_encode perlio);
+
+use File::Basename;
+my $name = basename($0);
+
+use Getopt::Long qw(:config no_ignore_case);
+
+my %Opt;
+
+help()
+    unless
+      GetOptions(\%Opt,
+		 'from|f=s',
+		 'to|t=s',
+		 'list|l',
+		 'string|s=s',
+		 'check|C=i',
+		 'c',
+		 'perlqq|p',
+		 'debug|D',
+		 'scheme|S=s',
+		 'resolve|r=s',
+		 'help',
+		 );
+
+$Opt{help} and help();
+$Opt{list} and list_encodings();
+my $locale = $ENV{LC_CTYPE} || $ENV{LC_ALL} || $ENV{LANG};
+defined $Opt{resolve} and resolve_encoding($Opt{resolve});
+$Opt{from} || $Opt{to} || help();
+my $from = $Opt{from} || $locale or help("from_encoding unspecified");
+my $to   = $Opt{to}   || $locale or help("to_encoding unspecified");
+$Opt{string} and Encode::from_to($Opt{string}, $from, $to) and print $Opt{string} and exit;
+my $scheme = exists $Scheme{$Opt{Scheme}} ? $Opt{Scheme} :  'from_to';
+$Opt{check} ||= $Opt{c};
+$Opt{perlqq} and $Opt{check} = Encode::FB_PERLQQ;
+
+if ($Opt{debug}){
+    my $cfrom = Encode->getEncoding($from)->name;
+    my $cto   = Encode->getEncoding($to)->name;
+    print <<"EOT";
+Scheme: $scheme
+From:   $from => $cfrom
+To:     $to => $cto
+EOT
+}
+
+# we do not use <> (or ARGV) for the sake of binmode()
+@ARGV or push @ARGV, \*STDIN; 
+
+unless ($scheme eq 'perlio'){
+    binmode STDOUT;
+    for my $argv (@ARGV){
+	my $ifh = ref $argv ? $argv : undef;
+	$ifh or open $ifh, "<", $argv or next;
+	binmode $ifh;
+	if ($scheme eq 'from_to'){ 	    # default
+	    while(<$ifh>){
+		Encode::from_to($_, $from, $to, $Opt{check}); 
+		print;
+	    }
+	}elsif ($scheme eq 'decode_encode'){ # step-by-step
+	    while(<$ifh>){
+		my $decoded = decode($from, $_, $Opt{check});
+		my $encoded = encode($to, $decoded);
+		print $encoded;
+	    }
+	} else { # won't reach
+	    die "$name: unknown scheme: $scheme";
+	}
+    }
+}else{
+    # NI-S favorite
+    binmode STDOUT => "raw:encoding($to)";
+    for my $argv (@ARGV){
+	my $ifh = ref $argv ? $argv : undef;
+	$ifh or open $ifh, "<", $argv or next;
+	binmode $ifh => "raw:encoding($from)";
+	print while(<$ifh>);
+    }
+}
+
+sub list_encodings{
+    print join("\n", Encode->encodings(":all")), "\n";
+    exit 0;
+}
+
+sub resolve_encoding {
+    if (my $alias = Encode::resolve_alias($_[0])) {
+	print $alias, "\n";
+	exit 0;
+    } else {
+	warn "$name: $_[0] is not known to Encode\n";
+	exit 1;
+    }
+}
+
+sub help{
+    my $message = shift;
+    $message and print STDERR "$name error: $message\n";
+    print STDERR <<"EOT";
+$name [-f from_encoding] [-t to_encoding] [-s string] [files...]
+$name -l
+$name -r encoding_alias
+  -l,--list
+     lists all available encodings
+  -r,--resolve encoding_alias
+    resolve encoding to its (Encode) canonical name
+  -f,--from from_encoding  
+     when omitted, the current locale will be used
+  -t,--to to_encoding    
+     when omitted, the current locale will be used
+  -s,--string string         
+     "string" will be the input instead of STDIN or files
+The following are mainly of interest to Encode hackers:
+  -D,--debug          show debug information
+  -C N | -c | -p      check the validity of the input
+  -S,--scheme scheme  use the scheme for conversion
+EOT
+  exit;
+}
+
+__END__
+
+=head1 NAME
+
+piconv -- iconv(1), reinvented in perl
+
+=head1 SYNOPSIS
+
+  piconv [-f from_encoding] [-t to_encoding] [-s string] [files...]
+  piconv -l
+  piconv [-C N|-c|-p]
+  piconv -S scheme ...
+  piconv -r encoding
+  piconv -D ...
+  piconv -h
+
+=head1 DESCRIPTION
+
+B<piconv> is perl version of B<iconv>, a character encoding converter
+widely available for various Unixen today.  This script was primarily
+a technology demonstrator for Perl 5.8.0, but you can use piconv in the
+place of iconv for virtually any case.
+
+piconv converts the character encoding of either STDIN or files
+specified in the argument and prints out to STDOUT.
+
+Here is the list of options.  Each option can be in short format (-f)
+or long (--from).
+
+=over 4
+
+=item -f,--from from_encoding
+
+Specifies the encoding you are converting from.  Unlike B<iconv>,
+this option can be omitted.  In such cases, the current locale is used.
+
+=item -t,--to to_encoding
+
+Specifies the encoding you are converting to.  Unlike B<iconv>,
+this option can be omitted.  In such cases, the current locale is used.
+
+Therefore, when both -f and -t are omitted, B<piconv> just acts
+like B<cat>.
+
+=item -s,--string I<string>
+
+uses I<string> instead of file for the source of text.
+
+=item -l,--list
+
+Lists all available encodings, one per line, in case-insensitive
+order.  Note that only the canonical names are listed; many aliases
+exist.  For example, the names are case-insensitive, and many standard
+and common aliases work, such as "latin1" for "ISO-8859-1", or "ibm850"
+instead of "cp850", or "winlatin1" for "cp1252".  See L<Encode::Supported>
+for a full discussion.
+
+=item -C,--check I<N>
+
+Check the validity of the stream if I<N> = 1.  When I<N> = -1, something
+interesting happens when it encounters an invalid character.
+
+=item -c
+
+Same as C<-C 1>.
+
+=item -p,--perlqq
+
+Same as C<-C -1>.
+
+=item -h,--help
+
+Show usage.
+
+=item -D,--debug
+
+Invokes debugging mode.  Primarily for Encode hackers.
+
+=item -S,--scheme scheme
+
+Selects which scheme is to be used for conversion.  Available schemes
+are as follows:
+
+=over 4
+
+=item from_to
+
+Uses Encode::from_to for conversion.  This is the default.
+
+=item decode_encode
+
+Input strings are decode()d then encode()d.  A straight two-step
+implementation.
+
+=item perlio
+
+The new perlIO layer is used.  NI-S' favorite.
+
+=back
+
+Like the I<-D> option, this is also for Encode hackers.
+
+=back
+
+=head1 SEE ALSO
+
+L<iconv/1>
+L<locale/3>
+L<Encode>
+L<Encode::Supported>
+L<Encode::Alias>
+L<PerlIO>
+
+=cut
+
+__END__
+:endofperl

Perl/bin/pl2bat.bat

@@ -0,0 +1,430 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec perl -x -S "$0" ${1+"$@"}'
+	if 0;	# In case running under some shell
+
+require 5;
+use Getopt::Std;
+use Config;
+
+$0 =~ s|.*[/\\]||;
+
+my $usage = <<EOT;
+Usage:  $0 [-h]
+   or:  $0 [-w] [-u] [-a argstring] [-s stripsuffix] [files]
+   or:  $0 [-w] [-u] [-n ntargs] [-o otherargs] [-s stripsuffix] [files]
+        -n ntargs       arguments to invoke perl with in generated file
+                            when run from Windows NT.  Defaults to
+                            '-x -S %0 %*'.
+        -o otherargs    arguments to invoke perl with in generated file
+                            other than when run from Windows NT.  Defaults
+                            to '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9'.
+        -a argstring    arguments to invoke perl with in generated file
+                            ignoring operating system (for compatibility
+                            with previous pl2bat versions).
+        -u              update files that may have already been processed
+                            by (some version of) pl2bat.
+        -w              include "-w" on the /^#!.*perl/ line (unless
+                            a /^#!.*perl/ line was already present).
+        -s stripsuffix  strip this suffix from file before appending ".bat"
+                            Not case-sensitive
+                            Can be a regex if it begins with `/'
+                            Defaults to "/\.plx?/"
+        -h              show this help
+EOT
+
+my %OPT = ();
+warn($usage), exit(0) if !getopts('whun:o:a:s:',\%OPT) or $OPT{'h'};
+# NOTE: %0 is already enclosed in doublequotes by cmd.exe, as appropriate
+$OPT{'n'} = '-x -S %0 %*' unless exists $OPT{'n'};
+$OPT{'o'} = '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists $OPT{'o'};
+$OPT{'s'} = '/\\.plx?/' unless exists $OPT{'s'};
+$OPT{'s'} = ($OPT{'s'} =~ m#^/([^/]*[^/\$]|)\$?/?$# ? $1 : "\Q$OPT{'s'}\E");
+
+my $head;
+if(  defined( $OPT{'a'} )  ) {
+    $head = <<EOT;
+	\@rem = '--*-Perl-*--
+	\@echo off
+	perl $OPT{'a'}
+	goto endofperl
+	\@rem ';
+EOT
+} else {
+    $head = <<EOT;
+	\@rem = '--*-Perl-*--
+	\@echo off
+	if "%OS%" == "Windows_NT" goto WinNT
+	perl $OPT{'o'}
+	goto endofperl
+	:WinNT
+	perl $OPT{'n'}
+	if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" goto endofperl
+	if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+	if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+	goto endofperl
+	\@rem ';
+EOT
+}
+$head =~ s/^\t//gm;
+my $headlines = 2 + ($head =~ tr/\n/\n/);
+my $tail = "\n__END__\n:endofperl\n";
+
+@ARGV = ('-') unless @ARGV;
+
+foreach ( @ARGV ) {
+    process($_);
+}
+
+sub process {
+ my( $file )= @_;
+    my $myhead = $head;
+    my $linedone = 0;
+    my $taildone = 0;
+    my $linenum = 0;
+    my $skiplines = 0;
+    my $line;
+    my $start= $Config{startperl};
+    $start= "#!perl"   unless  $start =~ /^#!.*perl/;
+    open( FILE, $file ) or die "$0: Can't open $file: $!";
+    @file = <FILE>;
+    foreach $line ( @file ) {
+	$linenum++;
+	if ( $line =~ /^:endofperl\b/ ) {
+	    if(  ! exists $OPT{'u'}  ) {
+		warn "$0: $file has already been converted to a batch file!\n";
+		return;
+	    }
+	    $taildone++;
+	}
+	if ( not $linedone and $line =~ /^#!.*perl/ ) {
+	    if(  exists $OPT{'u'}  ) {
+		$skiplines = $linenum - 1;
+		$line .= "#line ".(1+$headlines)."\n";
+	    } else {
+		$line .= "#line ".($linenum+$headlines)."\n";
+	    }
+	    $linedone++;
+	}
+	if ( $line =~ /^#\s*line\b/ and $linenum == 2 + $skiplines ) {
+	    $line = "";
+	}
+    }
+    close( FILE );
+    $file =~ s/$OPT{'s'}$//oi;
+    $file .= '.bat' unless $file =~ /\.bat$/i or $file =~ /^-$/;
+    open( FILE, ">$file" ) or die "Can't open $file: $!";
+    print FILE $myhead;
+    print FILE $start, ( $OPT{'w'} ? " -w" : "" ),
+	       "\n#line ", ($headlines+1), "\n" unless $linedone;
+    print FILE @file[$skiplines..$#file];
+    print FILE $tail unless $taildone;
+    close( FILE );
+}
+__END__
+
+=head1 NAME
+
+pl2bat - wrap perl code into a batch file
+
+=head1 SYNOPSIS
+
+B<pl2bat> B<-h>
+
+B<pl2bat> [B<-w>] S<[B<-a> I<argstring>]> S<[B<-s> I<stripsuffix>]> [files]
+
+B<pl2bat> [B<-w>] S<[B<-n> I<ntargs>]> S<[B<-o> I<otherargs>]> S<[B<-s> I<stripsuffix>]> [files]
+
+=head1 DESCRIPTION
+
+This utility converts a perl script into a batch file that can be
+executed on DOS-like operating systems.  This is intended to allow
+you to use a Perl script like regular programs and batch files where
+you just enter the name of the script [probably minus the extension]
+plus any command-line arguments and the script is found in your B<PATH>
+and run.
+
+=head2 ADVANTAGES
+
+There are several alternatives to this method of running a Perl script. 
+They each have disadvantages that help you understand the motivation
+for using B<pl2bat>.
+
+=over
+
+=item 1
+
+    C:> perl x:/path/to/script.pl [args]
+
+=item 2
+
+    C:> perl -S script.pl [args]
+
+=item 3
+
+    C:> perl -S script [args]
+
+=item 4
+
+    C:> ftype Perl=perl.exe "%1" %*
+    C:> assoc .pl=Perl
+    then
+    C:> script.pl [args]
+
+=item 5
+
+    C:> ftype Perl=perl.exe "%1" %*
+    C:> assoc .pl=Perl
+    C:> set PathExt=%PathExt%;.PL
+    then
+    C:> script [args]
+
+=back
+
+B<1> and B<2> are the most basic invocation methods that should work on
+any system [DOS-like or not].  They require extra typing and require
+that the script user know that the script is written in Perl.  This
+is a pain when you have lots of scripts, some written in Perl and some
+not.  It can be quite difficult to keep track of which scripts need to
+be run through Perl and which do not.  Even worse, scripts often get
+rewritten from simple batch files into more powerful Perl scripts in
+which case these methods would require all existing users of the scripts
+be updated.
+
+B<3> works on modern Win32 versions of Perl.  It allows the user to
+omit the ".pl" or ".bat" file extension, which is a minor improvement.
+
+B<4> and B<5> work on some Win32 operating systems with some command
+shells.  One major disadvantage with both is that you can't use them
+in pipelines nor with file redirection.  For example, none of the
+following will work properly if you used method B<4> or B<5>:
+
+    C:> script.pl <infile
+    C:> script.pl >outfile
+    C:> echo y | script.pl
+    C:> script.pl | more
+
+This is due to a Win32 bug which Perl has no control over.  This bug
+is the major motivation for B<pl2bat> [which was originally written
+for DOS] being used on Win32 systems.
+
+Note also that B<5> works on a smaller range of combinations of Win32
+systems and command shells while B<4> requires that the user know
+that the script is a Perl script [because the ".pl" extension must
+be entered].  This makes it hard to standardize on either of these
+methods.
+
+=head2 DISADVANTAGES
+
+There are several potential traps you should be aware of when you
+use B<pl2bat>.
+
+The generated batch file is initially processed as a batch file each
+time it is run.  This means that, to use it from within another batch
+file you should precede it with C<call> or else the calling batch
+file will not run any commands after the script:
+
+    call script [args]
+
+Except under Windows NT, if you specify more than 9 arguments to
+the generated batch file then the 10th and subsequent arguments
+are silently ignored.
+
+Except when using F<CMD.EXE> under Windows NT, if F<perl.exe> is not
+in your B<PATH>, then trying to run the script will give you a generic
+"Command not found"-type of error message that will probably make you
+think that the script itself is not in your B<PATH>.  When using
+F<CMD.EXE> under Windows NT, the generic error message is followed by
+"You do not have Perl in your PATH", to make this clearer.
+
+On most DOS-like operating systems, the only way to exit a batch file
+is to "fall off the end" of the file.  B<pl2bat> implements this by
+doing C<goto :endofperl> and adding C<__END__> and C<:endofperl> as
+the last two lines of the generated batch file.  This means:
+
+=over
+
+=item No line of your script should start with a colon.
+
+In particular, for this version of B<pl2bat>, C<:endofperl>,
+C<:WinNT>, and C<:script_failed_so_exit_with_non_zero_val> should not
+be used.
+
+=item Care must be taken when using C<__END__> and the C<DATA> file handle.
+
+One approach is:
+
+    .  #!perl
+    .  while( <DATA> ) {
+    .	  last   if  /^__END__$/;
+    .	  [...]
+    .  }
+    .  __END__
+    .  lines of data
+    .  to be processed
+    .  __END__
+    .  :endofperl
+
+The dots in the first column are only there to prevent F<cmd.exe> to interpret
+the C<:endofperl> line in this documentation.  Otherwise F<pl2bat.bat> itself
+wouldn't work.  See the previous item. :-)
+
+=item The batch file always "succeeds"
+
+The following commands illustrate the problem:
+
+    C:> echo exit(99); >fail.pl
+    C:> pl2bat fail.pl
+    C:> perl -e "print system('perl fail.pl')"
+    99
+    C:> perl -e "print system('fail.bat')"
+    0
+
+So F<fail.bat> always reports that it completed successfully.  Actually,
+under Windows NT, we have:
+
+    C:> perl -e "print system('fail.bat')"
+    1
+
+So, for Windows NT, F<fail.bat> fails when the Perl script fails, but
+the return code is always C<1>, not the return code from the Perl script.
+
+=back
+
+=head2 FUNCTION
+
+By default, the ".pl" suffix will be stripped before adding a ".bat" suffix
+to the supplied file names.  This can be controlled with the C<-s> option.
+
+The default behavior is to have the batch file compare the C<OS>
+environment variable against C<"Windows_NT">.  If they match, it
+uses the C<%*> construct to refer to all the command line arguments
+that were given to it, so you'll need to make sure that works on your
+variant of the command shell.  It is known to work in the F<CMD.EXE> shell
+under Windows NT.  4DOS/NT users will want to put a C<ParameterChar = *>
+line in their initialization file, or execute C<setdos /p*> in
+the shell startup file.
+
+On Windows95 and other platforms a nine-argument limit is imposed
+on command-line arguments given to the generated batch file, since
+they may not support C<%*> in batch files.
+
+These can be overridden using the C<-n> and C<-o> options or the
+deprecated C<-a> option.
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-n> I<ntargs>
+
+Arguments to invoke perl with in generated batch file when run from
+Windows NT (or Windows 98, probably).  Defaults to S<'-x -S %0 %*'>.
+
+=item B<-o> I<otherargs>
+
+Arguments to invoke perl with in generated batch file except when
+run from Windows NT (ie. when run from DOS, Windows 3.1, or Windows 95).
+Defaults to S<'-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9'>.
+
+=item B<-a> I<argstring>
+
+Arguments to invoke perl with in generated batch file.  Specifying
+B<-a> prevents the batch file from checking the C<OS> environment
+variable to determine which operating system it is being run from.
+
+=item B<-s> I<stripsuffix>
+
+Strip a suffix string from file name before appending a ".bat"
+suffix.  The suffix is not case-sensitive.  It can be a regex if
+it begins with `/' (the trailing '/' is optional and a trailing
+C<$> is always assumed).  Defaults to C</.plx?/>.
+
+=item B<-w>
+
+If no line matching C</^#!.*perl/> is found in the script, then such
+a line is inserted just after the new preamble.  The exact line
+depends on C<$Config{startperl}> [see L<Config>].  With the B<-w>
+option, C<" -w"> is added after the value of C<$Config{startperl}>.
+If a line matching C</^#!.*perl/> already exists in the script,
+then it is not changed and the B<-w> option is ignored.
+
+=item B<-u>
+
+If the script appears to have already been processed by B<pl2bat>,
+then the script is skipped and not processed unless B<-u> was
+specified.  If B<-u> is specified, the existing preamble is replaced.
+
+=item B<-h>
+
+Show command line usage.
+
+=back
+
+=head1 EXAMPLES
+
+	C:\> pl2bat foo.pl bar.PM 
+	[..creates foo.bat, bar.PM.bat..]
+	
+	C:\> pl2bat -s "/\.pl|\.pm/" foo.pl bar.PM
+	[..creates foo.bat, bar.bat..]
+	
+	C:\> pl2bat < somefile > another.bat
+	
+	C:\> pl2bat > another.bat
+	print scalar reverse "rekcah lrep rehtona tsuj\n";
+	^Z
+	[..another.bat is now a certified japh application..]
+	
+	C:\> ren *.bat *.pl
+	C:\> pl2bat -u *.pl
+	[..updates the wrapping of some previously wrapped scripts..]
+	
+	C:\> pl2bat -u -s .bat *.bat
+	[..same as previous example except more dangerous..]
+
+=head1 BUGS
+
+C<$0> will contain the full name, including the ".bat" suffix
+when the generated batch file runs.  If you don't like this,
+see runperl.bat for an alternative way to invoke perl scripts.
+
+Default behavior is to invoke Perl with the B<-S> flag, so Perl will
+search the B<PATH> to find the script.   This may have undesirable
+effects.
+
+On really old versions of Win32 Perl, you can't run the script
+via
+
+    C:> script.bat [args]
+
+and must use
+
+    C:> script [args]
+
+A loop should be used to build up the argument list when not on
+Windows NT so more than 9 arguments can be processed.
+
+See also L</Disadvantages>.
+
+=head1 SEE ALSO
+
+perl, perlwin32, runperl.bat
+
+=cut
+
+
+__END__
+:endofperl

Perl/bin/pl2pm.bat

@@ -0,0 +1,393 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+	if $running_under_some_shell;
+
+=head1 NAME
+
+pl2pm - Rough tool to translate Perl4 .pl files to Perl5 .pm modules.
+
+=head1 SYNOPSIS
+
+B<pl2pm> F<files>
+
+=head1 DESCRIPTION
+
+B<pl2pm> is a tool to aid in the conversion of Perl4-style .pl
+library files to Perl5-style library modules.  Usually, your old .pl
+file will still work fine and you should only use this tool if you
+plan to update your library to use some of the newer Perl 5 features,
+such as AutoLoading.
+
+=head1 LIMITATIONS
+
+It's just a first step, but it's usually a good first step.
+
+=head1 AUTHOR
+
+Larry Wall <larry@wall.org>
+
+=cut
+
+use strict;
+use warnings;
+
+my %keyword = ();
+
+while (<DATA>) {
+    chomp;
+    $keyword{$_} = 1;
+}
+
+local $/;
+
+while (<>) {
+    my $newname = $ARGV;
+    $newname =~ s/\.pl$/.pm/ || next;
+    $newname =~ s#(.*/)?(\w+)#$1\u$2#;
+    if (-f $newname) {
+	warn "Won't overwrite existing $newname\n";
+	next;
+    }
+    my $oldpack = $2;
+    my $newpack = "\u$2";
+    my @export = ();
+
+    s/\bstd(in|out|err)\b/\U$&/g;
+    s/(sub\s+)(\w+)(\s*\{[ \t]*\n)\s*package\s+$oldpack\s*;[ \t]*\n+/${1}main'$2$3/ig;
+    if (/sub\s+\w+'/) {
+	@export = m/sub\s+\w+'(\w+)/g;
+	s/(sub\s+)main'(\w+)/$1$2/g;
+    }
+    else {
+	@export = m/sub\s+([A-Za-z]\w*)/g;
+    }
+    my @export_ok = grep($keyword{$_}, @export);
+    @export = grep(!$keyword{$_}, @export);
+
+    my %export = ();
+    @export{@export} = (1) x @export;
+
+    s/(^\s*);#/$1#/g;
+    s/(#.*)require ['"]$oldpack\.pl['"]/$1use $newpack/;
+    s/(package\s*)($oldpack)\s*;[ \t]*\n+//ig;
+    s/([\$\@%&*])'(\w+)/&xlate($1,"",$2,$newpack,$oldpack,\%export)/eg;
+    s/([\$\@%&*]?)(\w+)'(\w+)/&xlate($1,$2,$3,$newpack,$oldpack,\%export)/eg;
+    if (!/\$\[\s*\)?\s*=\s*[^0\s]/) {
+	s/^\s*(local\s*\()?\s*\$\[\s*\)?\s*=\s*0\s*;[ \t]*\n//g;
+	s/\$\[\s*\+\s*//g;
+	s/\s*\+\s*\$\[//g;
+	s/\$\[/0/g;
+    }
+    s/open\s+(\w+)/open($1)/g;
+ 
+    my $export_ok = '';
+    my $carp      ='';
+
+
+    if (s/\bdie\b/croak/g) {
+	$carp = "use Carp;\n";
+	s/croak "([^"]*)\\n"/croak "$1"/g;
+    }
+
+    if (@export_ok) {
+	$export_ok = "\@EXPORT_OK = qw(@export_ok);\n";
+    }
+
+    if ( open(PM, ">$newname") ) {
+        print PM <<"END";
+package $newpack;
+use 5.006;
+require Exporter;
+$carp
+\@ISA = qw(Exporter);
+\@EXPORT = qw(@export);
+$export_ok
+$_
+END
+    }
+    else {
+      warn "Can't create $newname: $!\n";
+    }
+}
+
+sub xlate {
+    my ($prefix, $pack, $ident,$newpack,$oldpack,$export) = @_;
+
+    my $xlated ;
+    if ($prefix eq '' && $ident =~ /^(t|s|m|d|ing|ll|ed|ve|re)$/) {
+	$xlated = "${pack}'$ident";
+    }
+    elsif ($pack eq '' || $pack eq 'main') {
+	if ($export->{$ident}) {
+	    $xlated = "$prefix$ident";
+	}
+	else {
+	    $xlated = "$prefix${pack}::$ident";
+	}
+    }
+    elsif ($pack eq $oldpack) {
+	$xlated = "$prefix${newpack}::$ident";
+    }
+    else {
+	$xlated = "$prefix${pack}::$ident";
+    }
+
+    return $xlated;
+}
+__END__
+AUTOLOAD
+BEGIN
+CORE
+DESTROY
+END
+INIT
+CHECK
+abs
+accept
+alarm
+and
+atan2
+bind
+binmode
+bless
+caller
+chdir
+chmod
+chomp
+chop
+chown
+chr
+chroot
+close
+closedir
+cmp
+connect
+continue
+cos
+crypt
+dbmclose
+dbmopen
+defined
+delete
+die
+do
+dump
+each
+else
+elsif
+endgrent
+endhostent
+endnetent
+endprotoent
+endpwent
+endservent
+eof
+eq
+eval
+exec
+exists
+exit
+exp
+fcntl
+fileno
+flock
+for
+foreach
+fork
+format
+formline
+ge
+getc
+getgrent
+getgrgid
+getgrnam
+gethostbyaddr
+gethostbyname
+gethostent
+getlogin
+getnetbyaddr
+getnetbyname
+getnetent
+getpeername
+getpgrp
+getppid
+getpriority
+getprotobyname
+getprotobynumber
+getprotoent
+getpwent
+getpwnam
+getpwuid
+getservbyname
+getservbyport
+getservent
+getsockname
+getsockopt
+glob
+gmtime
+goto
+grep
+gt
+hex
+if
+index
+int
+ioctl
+join
+keys
+kill
+last
+lc
+lcfirst
+le
+length
+link
+listen
+local
+localtime
+lock
+log
+lstat
+lt
+m
+map
+mkdir
+msgctl
+msgget
+msgrcv
+msgsnd
+my
+ne
+next
+no
+not
+oct
+open
+opendir
+or
+ord
+our
+pack
+package
+pipe
+pop
+pos
+print
+printf
+prototype
+push
+q
+qq
+qr
+quotemeta
+qw
+qx
+rand
+read
+readdir
+readline
+readlink
+readpipe
+recv
+redo
+ref
+rename
+require
+reset
+return
+reverse
+rewinddir
+rindex
+rmdir
+s
+scalar
+seek
+seekdir
+select
+semctl
+semget
+semop
+send
+setgrent
+sethostent
+setnetent
+setpgrp
+setpriority
+setprotoent
+setpwent
+setservent
+setsockopt
+shift
+shmctl
+shmget
+shmread
+shmwrite
+shutdown
+sin
+sleep
+socket
+socketpair
+sort
+splice
+split
+sprintf
+sqrt
+srand
+stat
+study
+sub
+substr
+symlink
+syscall
+sysopen
+sysread
+sysseek
+system
+syswrite
+tell
+telldir
+tie
+tied
+time
+times
+tr
+truncate
+uc
+ucfirst
+umask
+undef
+unless
+unlink
+unpack
+unshift
+untie
+until
+use
+utime
+values
+vec
+wait
+waitpid
+wantarray
+warn
+while
+write
+x
+xor
+y
+
+__END__
+:endofperl

Perl/bin/plexalizer.pl

@@ -0,0 +1,332 @@
+#!/usr/bin/env perl
+
+use strict;
+
+use Getopt::Long;
+
+my $curr_script = '(unknown)';
+my %opened_files = ();
+my %closed_files = ();
+my %opts = ();
+
+GetOptions(\%opts, 'h|help') or usage();
+usage() if $opts{'h'};
+
+foreach my $file (@ARGV) {
+    process_log($file);
+}
+
+# Now, go through opened_files and see which are still open.
+
+my $nopened = 0;
+
+print "\nRemaining Open Files:\n" if scalar(keys %opened_files);
+foreach my $key (keys %opened_files) {
+    $nopened++;
+    print "$key:\n";
+    print "  current script: $opened_files{$key}->{'curr_script'}\n";
+    print "  file name: $opened_files{$key}->{'filename'}\n";
+    print "  fileno: $opened_files{$key}->{'fileno'}\n";
+    print "  open operation: $opened_files{$key}->{'open_op'}\n";
+    print "  opened by: $opened_files{$key}->{'opened_by'}\n\n";
+}
+
+print "Number of files still open: $nopened\n";
+
+exit 0;
+
+sub handle_fclose {
+    my ($file, $line, $lineno) = @_;
+
+    if ($line =~ /^fclose\(\) FILE=(\S+) fileno=(\d+) status=([-0-9]+)/) {
+	my $file_ptr = $1;
+	my $file_no = $2;
+	my $status = $3;
+	my $caller_file = '(unknown)';
+	my $caller_lineno = '(unknown)';
+
+	if ($line =~ / at (.*)? line (\d+)/) {
+	    $caller_file = $1;
+	    $caller_lineno = $2;
+	}
+
+	# Find the entry in the opened_files hash corresponding
+	# to this file, and move it to the closed_files hash.
+
+	if (exists($opened_files{$file_ptr})) {
+	    $closed_files{$file_ptr} = $opened_files{$file_ptr};
+
+	    # XXX can file_ptr match but file_no be different?
+
+	    $closed_files{$file_ptr}->{'closed_by'} =
+		"$caller_file:$caller_lineno";
+	    $closed_files{$file_ptr}->{'close_op'} = 'fclose';
+	    $closed_files{$file_ptr}->{'status'} = $status;
+
+	    delete $opened_files{$file_ptr};
+
+	} else {
+	    warn "NOTICE: closing file not known to have been opened:\n";
+	    warn "file: $file\n";
+	    warn "line $lineno: $line\n";
+	    warn "$file_ptr\n";
+	    warn "  current script: $curr_script\n";
+	    warn "  fileno: $file_no\n";
+	    warn "  open operation: $opened_files{$file_ptr}->{'open_op'}\n";
+	    warn "  opened by: $opened_files{$file_ptr}->{'opened_by'}\n";
+	    warn "  close operation: fclose\n";
+
+	    if ($caller_file eq '(unknown)') {
+		warn "  (most likely closing handles during interpreter unloading)\n\n";
+	    } else {
+		warn "  closed by: $caller_file:$caller_lineno\n\n";
+	    }
+
+	    $closed_files{$file_ptr} = {
+		'fileno' => $file_no,
+		'status' => $status,
+		'closed_by' => "$caller_file:$caller_lineno",
+		'close_op' => 'fclose',
+	    };
+	}
+
+    } else {
+	warn "unknown fclose pattern: $line (line $lineno)\n";
+    }
+}
+
+sub handle_fdopen {
+    my ($file, $line, $lineno) = @_;
+
+    if ($line =~ /^fdopen\(\) fileno=(\d+) mode='(\S+)' FILE=(\S+) at (.*)? line (\d+)/) {
+	my $file_no = $1;
+	my $file_mode = $2;
+	my $file_ptr = $3;
+	my $caller_file = $4;
+	my $caller_lineno = $5;
+
+	# Add an entry to the opened_files hash.  We're only tracking open
+	# file handles here, not open file descriptors.
+	$opened_files{$file_ptr} = {
+	    'curr_script' => $curr_script,
+	    'filename' => '(fdopen)',
+	    'fileno' => $file_no,
+	    'mode' => $file_mode,
+	    'opened_by' => "$caller_file:$caller_lineno",
+	    'open_op' => 'fdopen',
+	};
+
+    } else {
+	warn "unknown fdopen pattern: $line (line $lineno)\n";
+    }
+}
+
+sub handle_fopen {
+    my ($file, $line, $lineno) = @_;
+
+    if ($line =~ /^fopen\(\) file='(\S+)' mode='(\S+)' FILE=(\S+) fileno=(\d+) at (.*)? line (\d+)/) {
+	my $file_name = $1;
+	my $file_mode = $2;
+	my $file_ptr = $3;
+	my $file_no = $4;
+	my $caller_file = $5;
+	my $caller_lineno = $6;
+
+        # Add an entry to the opened_files hash.  We're only tracking open
+        # file handles here, not open file descriptors.
+        $opened_files{$file_ptr} = {
+	    'curr_script' => $curr_script,
+	    'filename' => $file_name,
+            'fileno' => $file_no,
+            'mode' => $file_mode,
+            'opened_by' => "$caller_file:$caller_lineno",
+	    'open_op' => 'fopen',
+        };
+
+    } elsif ($line =~ /^fopen\(\) file='(\S+)' mode='(\S+)' FILE=NULL errno=(\d+) at (.*)? line (\d+)/) {
+
+	# XXX Are we interested in this?
+
+    } else {
+	warn "unknown fopen pattern: $line (line $lineno)\n";
+    }
+}
+
+sub handle_freopen {
+    my ($file, $line, $lineno) = @_;
+
+    if ($line =~ /^freopen\(\) file='(\S+)' mode='(\S+)' oFILE=(\S+) ofileno=(\d+) FILE=(\S+) fileno=(\d+) at (.*)? line (\d+)/) {
+	my $file_name = $1;
+	my $file_mode = $2;
+	my $old_file_ptr = $3;
+	my $old_file_no = $4;
+	my $new_file_ptr = $5;
+	my $new_file_no = $6;
+	my $caller_file = $7;
+	my $caller_lineno = $8;
+
+        if (exists($opened_files{$old_file_ptr})) {
+            $closed_files{$old_file_ptr} = $opened_files{$old_file_ptr};
+
+            # XXX can file_ptr match but file_no be different?
+
+            $closed_files{$old_file_ptr}->{'closed_by'} =
+                "$caller_file:$caller_lineno";
+	    $closed_files{$old_file_ptr}->{'close_op'} = 'freopen';
+
+            delete $opened_files{$old_file_ptr};
+
+        } else {
+            warn "\nNOTICE: closing file not known to have been opened\n";
+	    warn "file: $file\n";
+	    warn "line $lineno: $line\n";
+            warn "$old_file_ptr\n";
+            warn "  current script: $curr_script\n";
+            warn "  fileno: $old_file_no\n";
+            warn "  open operation: $opened_files{$old_file_ptr}->{'open_op'}\n";
+            warn "  opened by: $opened_files{$old_file_ptr}->{'opened_by'}\n";
+            warn "  close operation: freopen\n";
+
+            if ($caller_file eq '(unknown)') {
+                warn "  (most likely closing handles during interpreter unloadin
+g)\n\n";
+            } else {
+                warn "  closed by: $caller_file:$caller_lineno\n\n";
+            }
+
+            $closed_files{$old_file_ptr} = {
+                'fileno' => $old_file_no,
+                'closed_by' => "$caller_file:$caller_lineno",
+		'close_op' => 'freopen',
+            };
+        }
+
+	# Now, add a new entry, under new_file_ptr, to the opened_files hash.
+        $opened_files{$new_file_ptr} = {
+	    'curr_script' => $curr_script,
+            'filename' => $file_name,
+            'fileno' => $new_file_no,
+            'mode' => $file_mode,
+            'opened_by' => "$caller_file:$caller_lineno",
+            'open_op' => 'freopen',
+        };
+
+    } elsif ($line = /^freopen\(\) file='(\S+)' mode='(\S+)' oFILE=(\S+) ofileno=(\d+) FILE=NULL errno=(\d+)/) {
+	my $file_name = $1;
+	my $file_mode = $2;
+	my $old_file_ptr = $3;
+	my $old_file_no = $4;
+	my $errno = $5;
+
+	# XXX Are we interested in this?  The given stream isn't changed...
+
+    } else {
+	warn "unknown freopen pattern: $line (line $lineno)\n";
+    }
+}
+
+sub handle_tmpfile {
+    my ($file, $line, $lineno) = @_;
+
+    if ($line =~ /^tmpfile\(\) FILE=(\S+) fileno=(\d+) at (.*)? line (\d+)/) {
+	my $file_ptr = $1;
+	my $file_no = $2;
+	my $caller_file = $3;
+	my $caller_lineno = $4;
+
+        $opened_files{$file_ptr} = {
+	    'curr_script' => $curr_script,
+            'filename' => '(tmpfile)',
+            'fileno' => $file_no,
+            'opened_by' => "$caller_file:$caller_lineno",
+        };
+
+    } else {
+	warn "unknown tmpfile pattern: $line (line $lineno)\n";
+    }
+}
+
+sub process_log {
+    my ($file) = @_;
+
+    if (open(my $fh, "< $file")) {
+	my $lineno = 0;
+
+	while (my $line = <$fh>) {
+	    chomp($line);
+
+	    # Get rid of CRs, too
+	    $line =~ s/^M$//;
+	    $lineno++;
+
+	    # Look for the name of the script generating this log
+	    $curr_script = $1 if ($line =~ /^\*\*\* '(\S+)' log message/);
+
+	    # Look for lines that contain 'FILE=' patterns
+	    if ($line =~ /FILE\=/) {
+
+                # Strip a timestamp from line
+                $line =~ s/\s*\[.+\]: //;
+
+		# The first word in the log line is the file operation
+		$line =~ /^(\S+)\(\)\s+/;
+
+		my $op = $1;
+
+		# The format of the fd logging varies from op to op, so
+		# handle each accordingly
+
+		if ($op eq 'fclose') {
+		    handle_fclose($file, $line, $lineno);
+
+		} elsif ($op eq 'fdopen') {
+		    handle_fdopen($file, $line, $lineno);
+
+		} elsif ($op eq 'fopen') {
+		    handle_fopen($file, $line, $lineno);
+
+		} elsif ($op eq 'freopen') {
+		    handle_freopen($file, $line, $lineno);
+
+		} elsif ($op eq 'tmpfile') {
+		    handle_tmpfile($file, $line, $lineno);
+
+		} else {
+		    warn "unknown file operation '$op': $line (line $lineno)\n";
+		}
+	    }
+	}
+
+	close($fh);
+
+    } else {
+	warn "unable to open '$file': $!\n";
+    }
+}
+
+sub usage {
+    print <<EOH;
+
+usage: plexalizer.pl log1 log2 ... logN
+
+plexalizer.pl scans the given log files for the file-descriptor tracking log
+entries generated by the PerlEx .dll.  It will report on the number of
+files that it has determined, from the log entries, have not been explicitly
+closed, generating entries that look like:
+
+  7803A7F0:
+    current script: C:\\path\\to\\some\\PerlEx\\lib\\test.plex
+    file name: (tmpfile)
+    fileno: 13
+    open operation:
+    opened by: C:\\path\\to\\some\\PerlEx\\lib\\test.pm:27
+
+The 'current script' shows the name of the script that is generating the
+log entries parsed at the time, and 'opened by' shows the name of the file,
+and the line number within that file (the number following the colon) where
+the file open/close operation occurred.
+
+EOH
+
+    exit 0;
+}

Perl/bin/pod2html.bat

@@ -0,0 +1,160 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+	if $running_under_some_shell;
+=pod
+
+=head1 NAME
+
+pod2html - convert .pod files to .html files
+
+=head1 SYNOPSIS
+
+    pod2html --help --htmlroot=<name> --infile=<name> --outfile=<name>
+             --podpath=<name>:...:<name> --podroot=<name>
+             --libpods=<name>:...:<name> --recurse --norecurse --verbose
+             --index --noindex --title=<name>
+
+=head1 DESCRIPTION
+
+Converts files from pod format (see L<perlpod>) to HTML format.
+
+=head1 ARGUMENTS
+
+pod2html takes the following arguments:
+
+=over 4
+
+=item help
+
+  --help
+
+Displays the usage message.
+
+=item htmlroot
+
+  --htmlroot=name
+
+Sets the base URL for the HTML files.  When cross-references are made,
+the HTML root is prepended to the URL.
+
+=item infile
+
+  --infile=name
+
+Specify the pod file to convert.  Input is taken from STDIN if no
+infile is specified.
+
+=item outfile
+
+  --outfile=name
+
+Specify the HTML file to create.  Output goes to STDOUT if no outfile
+is specified.
+
+=item podroot
+
+  --podroot=name
+
+Specify the base directory for finding library pods.
+
+=item podpath
+
+  --podpath=name:...:name
+
+Specify which subdirectories of the podroot contain pod files whose
+HTML converted forms can be linked-to in cross-references.
+
+=item libpods
+
+  --libpods=name:...:name
+
+List of page names (eg, "perlfunc") which contain linkable C<=item>s.
+
+=item netscape
+
+  --netscape
+
+Use Netscape HTML directives when applicable.
+
+=item nonetscape
+
+  --nonetscape
+
+Do not use Netscape HTML directives (default).
+
+=item index
+
+  --index
+
+Generate an index at the top of the HTML file (default behaviour).
+
+=item noindex
+
+  --noindex
+
+Do not generate an index at the top of the HTML file.
+
+
+=item recurse
+
+  --recurse
+
+Recurse into subdirectories specified in podpath (default behaviour).
+
+=item norecurse
+
+  --norecurse
+
+Do not recurse into subdirectories specified in podpath.
+
+=item title
+
+  --title=title
+
+Specify the title of the resulting HTML file.
+
+=item verbose
+
+  --verbose
+
+Display progress messages.
+
+=back
+
+=head1 AUTHOR
+
+Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
+
+=head1 BUGS
+
+See L<Pod::Html> for a list of known bugs in the translator.
+
+=head1 SEE ALSO
+
+L<perlpod>, L<Pod::Html>
+
+=head1 COPYRIGHT
+
+This program is distributed under the Artistic License.
+
+=cut
+
+use Pod::Html;
+
+pod2html @ARGV;
+
+__END__
+:endofperl

Perl/bin/pod2latex.bat

@@ -0,0 +1,398 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+	if $running_under_some_shell;
+
+# pod2latex conversion program
+
+use strict;
+use Pod::LaTeX;
+use Pod::Find qw/ pod_find /;
+use Pod::Usage;
+use Getopt::Long;
+use File::Basename;
+use Symbol;
+
+my $VERSION = "1.01";
+
+# return the entire contents of a text file
+# whose name is given as argument
+sub _get {
+    my $fn = shift;
+    my $infh = gensym;
+    open $infh, $fn
+        or die "Could not open file $fn: $!\n";
+    local $/;
+    return <$infh>;
+}
+
+# Read command line arguments
+
+my %options = (
+	       "help"   => 0,
+	       "man"    => 0,
+	       "sections" => [],
+	       "full"   => 0,
+	       "out"    => undef,
+	       "verbose" => 0,
+	       "modify" => 0,
+	       "h1level" => 1,  # section is equivalent to H1
+	       "preamble" => [],
+	       "postamble" => [],
+	      );
+# "prefile" is just like "preamble", but the argument 
+# comes from the file named by the argument
+$options{"prefile"} = sub { shift; push @{$options{"preamble"}}, _get(shift) };
+# the same between "postfile" and "postamble"
+$options{"postfile"} = sub { shift; push @{$options{"postamble"}}, _get(shift) };
+
+GetOptions(\%options, 
+	   "help",
+	   "man",
+	   "verbose",
+	   "full",
+	   "sections=s@",
+	   "out=s",
+	   "modify",
+	   "h1level=i",
+	   "preamble=s@",
+	   "postamble=s@",
+	   "prefile=s", 
+	   "postfile=s"
+	  ) || pod2usage(2);
+
+pod2usage(1)  if ($options{help});
+pod2usage(-verbose => 2)  if ($options{man});
+
+
+# Read all the files from the command line
+my @files = @ARGV;
+
+# Now find which ones are real pods and convert 
+# directories to their contents.
+
+# Extract the pods from each arg since some of them might
+# be directories
+# This is not as efficient as using pod_find to search through
+# everything at once but it allows us to preserve the order 
+# supplied by the user
+
+my @pods;
+foreach my $arg (@files) {
+  my %pods = pod_find($arg);
+  push(@pods, sort keys %pods);
+}
+
+# Abort if nothing to do
+if ($#pods == -1) {
+  warn "None of the supplied Pod files actually exist\n";
+  exit;
+}
+
+# Only want to override the preamble and postamble if we have
+# been given values.
+my %User;
+$User{UserPreamble} = join("\n", @{$options{'preamble'}})
+  if ($options{preamble} && @{$options{preamble}});
+$User{UserPostamble} = join("\n", @{$options{'postamble'}})
+  if ($options{postamble} && @{$options{postamble}});
+
+
+
+# If $options{'out'} is set we are processing to a single output file
+my $multi_documents;
+if (exists $options{'out'} && defined $options{'out'}) {
+  $multi_documents = 0;
+} else {
+  $multi_documents = 1;
+}
+
+# If the output file is not specified it is assumed that
+# a single output file is required per input file using
+# a .tex extension rather than any exisiting extension
+
+if ($multi_documents) {
+
+  # Case where we just generate one input per output
+
+  foreach my $pod (@pods) {
+
+    if (-f $pod) {
+
+      my $output = $pod;
+      $output = basename($output, '.pm', '.pod','.pl') . '.tex';
+
+      # Create a new parser object
+      my $parser = new Pod::LaTeX(
+				  AddPreamble => $options{'full'},
+				  AddPostamble => $options{'full'},
+				  MakeIndex => $options{'full'},
+				  TableOfContents => $options{'full'},
+				  ReplaceNAMEwithSection => $options{'modify'},
+				  UniqueLabels => $options{'modify'},
+				  Head1Level => $options{'h1level'},
+				  LevelNoNum => $options{'h1level'} + 1,
+                                  %User,
+				 );
+
+      # Select sections if supplied
+      $parser->select(@{ $options{'sections'}})
+	if @{$options{'sections'}};
+
+      # Derive the input file from the output file
+      $parser->parse_from_file($pod, $output);
+
+      print "Written output to $output\n" if $options{'verbose'};
+
+    } else {
+      warn "File $pod not found\n";
+    }
+
+  }
+} else {
+
+  # Case where we want everything to be in a single document
+
+  # Need to open the output file ourselves
+  my $output = $options{'out'};
+  $output .= '.tex' unless $output =~ /\.tex$/;
+
+  # Use auto-vivified file handle in perl 5.6
+  my $outfh = gensym;
+  open ($outfh, ">$output") || die "Could not open output file: $!\n";
+
+  # Flag to indicate whether we have converted at least one file
+  # indicates how many files have been converted
+  my $converted = 0;
+
+  # Loop over the input files
+  foreach my $pod (@pods) {
+
+    if (-f $pod) {
+
+      warn "Converting $pod\n" if $options{'verbose'};
+
+      # Open the file (need the handle)
+      # Use auto-vivified handle in perl 5.6
+      my $podfh = gensym;
+      open ($podfh, "<$pod") || die "Could not open pod file $pod: $!\n";
+
+      # if this is the first file to be converted we may want to add
+      # a preamble (controlled by command line option)
+      my $preamble = 0;
+      $preamble = 1 if ($converted == 0 && $options{'full'});
+
+      # if this is the last file to be converted may want to add
+      # a postamble (controlled by command line option)
+      # relies on a previous pass to check existence of all pods we
+      # are converting.
+      my $postamble = ( ($converted == $#pods && $options{'full'}) ? 1 : 0 );
+
+      # Open parser object
+      # May want to start with a preamble for the first one and
+      # end with an index for the last
+      my $parser = new Pod::LaTeX(
+				  MakeIndex => $options{'full'},
+				  TableOfContents => $preamble,
+				  ReplaceNAMEwithSection => $options{'modify'},
+				  UniqueLabels => $options{'modify'},
+				  StartWithNewPage => $options{'full'},
+				  AddPreamble => $preamble,
+				  AddPostamble => $postamble,
+				  Head1Level => $options{'h1level'},
+				  LevelNoNum => $options{'h1level'} + 1,
+                                  %User
+				 );
+
+      # Store the file name for error messages
+      # This is a kluge that breaks the data hiding of the object
+      $parser->{_INFILE} = $pod;
+
+      # Select sections if supplied
+      $parser->select(@{ $options{'sections'}})
+	if @{$options{'sections'}};
+
+      # Parse it
+      $parser->parse_from_filehandle($podfh, $outfh);
+
+      # We have converted at least one file
+      $converted++;
+
+    } else {
+      warn "File $pod not found\n";
+    }
+
+  }
+
+  # Should unlink the file if we didn't convert anything!
+  # dont check for return status of unlink
+  # since there is not a lot to be done if the unlink failed
+  # and the program does not rely upon it.
+  unlink "$output" unless $converted;
+
+  # If verbose
+  warn "Converted $converted files\n" if $options{'verbose'};
+
+}
+
+exit;
+
+__END__
+
+=head1 NAME
+
+pod2latex - convert pod documentation to latex format
+
+=head1 SYNOPSIS
+
+  pod2latex *.pm
+
+  pod2latex -out mytex.tex *.pod
+
+  pod2latex -full -sections 'DESCRIPTION|NAME' SomeDir
+
+  pod2latex -prefile h.tex -postfile t.tex my.pod
+
+=head1 DESCRIPTION
+
+C<pod2latex> is a program to convert POD format documentation
+(L<perlpod>) into latex. It can process multiple input documents at a
+time and either generate a latex file per input document or a single
+combined output file.
+
+=head1 OPTIONS AND ARGUMENTS
+
+This section describes the supported command line options. Minimum
+matching is supported.
+
+=over 4
+
+=item B<-out>
+
+Name of the output file to be used. If there are multiple input pods
+it is assumed that the intention is to write all translated output
+into a single file. C<.tex> is appended if not present.  If the
+argument is not supplied, a single document will be created for each
+input file.
+
+=item B<-full>
+
+Creates a complete C<latex> file that can be processed immediately
+(unless C<=for/=begin> directives are used that rely on extra packages).
+Table of contents and index generation commands are included in the
+wrapper C<latex> code.
+
+=item B<-sections>
+
+Specify pod sections to include (or remove if negated) in the
+translation.  See L<Pod::Select/"SECTION SPECIFICATIONS"> for the
+format to use for I<section-spec>. This option may be given multiple
+times on the command line.This is identical to the similar option in
+the C<podselect()> command.
+
+=item B<-modify>
+
+This option causes the output C<latex> to be slightly
+modified from the input pod such that when a C<=head1 NAME>
+is encountered a section is created containing the actual
+pod name (rather than B<NAME>) and all subsequent C<=head1>
+directives are treated as subsections. This has the advantage
+that the description of a module will be in its own section
+which is helpful for including module descriptions in documentation.
+Also forces C<latex> label and index entries to be prefixed by the
+name of the module.
+
+=item B<-h1level>
+
+Specifies the C<latex> section that is equivalent to a C<H1> pod
+directive. This is an integer between 0 and 5 with 0 equivalent to a
+C<latex> chapter, 1 equivalent to a C<latex> section etc. The default
+is 1 (C<H1> equivalent to a latex section).
+
+=item B<-help>
+
+Print a brief help message and exit.
+
+=item B<-man>
+
+Print the manual page and exit.
+
+=item B<-verbose>
+
+Print information messages as each document is processed.
+
+=item B<-preamble>
+
+A user-supplied preamble for the LaTeX code. Multiple values
+are supported and appended in order separated by "\n".
+See B<-prefile> for reading the preamble from a file.
+
+=item B<-postamble>
+
+A user supplied postamble for the LaTeX code. Multiple values
+are supported and appended in order separated by "\n".
+See B<-postfile> for reading the postamble from a file.
+
+=item B<-prefile>
+
+A user-supplied preamble for the LaTeX code to be read from the
+named file. Multiple values are supported and appended in
+order. See B<-preamble>.
+
+=item B<-postfile>
+
+A user-supplied postamble for the LaTeX code to be read from the
+named file. Multiple values are supported and appended in
+order. See B<-postamble>.
+
+=back
+
+=head1 BUGS
+
+Known bugs are:
+
+=over 4
+
+=item *
+
+Cross references between documents are not resolved when multiple
+pod documents are converted into a single output C<latex> file.
+
+=item *
+
+Functions and variables are not automatically recognized
+and they will therefore not be marked up in any special way
+unless instructed by an explicit pod command.
+
+=back
+
+=head1 SEE ALSO
+
+L<Pod::LaTeX>
+
+=head1 AUTHOR
+
+Tim Jenness E<lt>tjenness@cpan.orgE<gt>
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+Copyright (C) 2000, 2003, 2004 Tim Jenness. All Rights Reserved.
+
+=cut
+
+
+__END__
+:endofperl

Perl/bin/pod2man.bat

@@ -0,0 +1,529 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+        if $running_under_some_shell;
+
+# pod2man -- Convert POD data to formatted *roff input.
+# $Id: pod2man.PL,v 1.10 2002/07/15 05:45:56 eagle Exp $
+#
+# Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>
+#
+# This program is free software; you may redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+require 5.004;
+
+use Getopt::Long qw(GetOptions);
+use Pod::Man ();
+use Pod::Usage qw(pod2usage);
+
+use strict;
+
+# Silence -w warnings.
+use vars qw($running_under_some_shell);
+
+# Insert -- into @ARGV before any single dash argument to hide it from
+# Getopt::Long; we want to interpret it as meaning stdin (which Pod::Parser
+# does correctly).
+my $stdin;
+@ARGV = map { $_ eq '-' && !$stdin++ ? ('--', $_) : $_ } @ARGV;
+
+# Parse our options, trying to retain backwards compatibility with pod2man but
+# allowing short forms as well.  --lax is currently ignored.
+my %options;
+Getopt::Long::config ('bundling_override');
+GetOptions (\%options, 'section|s=s', 'release|r:s', 'center|c=s',
+            'date|d=s', 'fixed=s', 'fixedbold=s', 'fixeditalic=s',
+            'fixedbolditalic=s', 'name|n=s', 'official|o', 'quotes|q=s',
+            'lax|l', 'help|h', 'verbose|v') or exit 1;
+pod2usage (0) if $options{help};
+
+# Official sets --center, but don't override things explicitly set.
+if ($options{official} && !defined $options{center}) {
+    $options{center} = 'Perl Programmers Reference Guide';
+}
+
+# Verbose is only our flag, not a Pod::Man flag.
+my $verbose = $options{verbose};
+delete $options{verbose};
+
+# This isn't a valid Pod::Man option and is only accepted for backwards
+# compatibility.
+delete $options{lax};
+
+# Initialize and run the formatter, pulling a pair of input and output off at
+# a time.
+my $parser = Pod::Man->new (%options);
+my @files;
+do {
+    @files = splice (@ARGV, 0, 2);
+    print "  $files[1]\n" if $verbose;
+    $parser->parse_from_file (@files);
+} while (@ARGV);
+
+__END__
+
+=head1 NAME
+
+pod2man - Convert POD data to formatted *roff input
+
+=head1 SYNOPSIS
+
+pod2man [B<--section>=I<manext>] [B<--release>=I<version>]
+[B<--center>=I<string>] [B<--date>=I<string>] [B<--fixed>=I<font>]
+[B<--fixedbold>=I<font>] [B<--fixeditalic>=I<font>]
+[B<--fixedbolditalic>=I<font>] [B<--name>=I<name>] [B<--official>]
+[B<--lax>] [B<--quotes>=I<quotes>] [B<--verbose>]
+[I<input> [I<output>] ...]
+
+pod2man B<--help>
+
+=head1 DESCRIPTION
+
+B<pod2man> is a front-end for Pod::Man, using it to generate *roff input
+from POD source.  The resulting *roff code is suitable for display on a
+terminal using nroff(1), normally via man(1), or printing using troff(1).
+
+I<input> is the file to read for POD source (the POD can be embedded in
+code).  If I<input> isn't given, it defaults to STDIN.  I<output>, if given,
+is the file to which to write the formatted output.  If I<output> isn't
+given, the formatted output is written to STDOUT.  Several POD files can be
+processed in the same B<pod2man> invocation (saving module load and compile
+times) by providing multiple pairs of I<input> and I<output> files on the
+command line.
+
+B<--section>, B<--release>, B<--center>, B<--date>, and B<--official> can be
+used to set the headers and footers to use; if not given, Pod::Man will
+assume various defaults.  See below or L<Pod::Man> for details.
+
+B<pod2man> assumes that your *roff formatters have a fixed-width font named
+CW.  If yours is called something else (like CR), use B<--fixed> to specify
+it.  This generally only matters for troff output for printing.  Similarly,
+you can set the fonts used for bold, italic, and bold italic fixed-width
+output.
+
+Besides the obvious pod conversions, Pod::Man, and therefore pod2man also
+takes care of formatting func(), func(n), and simple variable references
+like $foo or @bar so you don't have to use code escapes for them; complex
+expressions like C<$fred{'stuff'}> will still need to be escaped, though.
+It also translates dashes that aren't used as hyphens into en dashes, makes
+long dashes--like this--into proper em dashes, fixes "paired quotes," and
+takes care of several other troff-specific tweaks.  See L<Pod::Man> for
+complete information.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-c> I<string>, B<--center>=I<string>
+
+Sets the centered page header to I<string>.  The default is "User
+Contributed Perl Documentation", but also see B<--official> below.
+
+=item B<-d> I<string>, B<--date>=I<string>
+
+Set the left-hand footer string to this value.  By default, the modification
+date of the input file will be used, or the current date if input comes from
+STDIN.
+
+=item B<--fixed>=I<font>
+
+The fixed-width font to use for vertabim text and code.  Defaults to CW.
+Some systems may want CR instead.  Only matters for troff(1) output.
+
+=item B<--fixedbold>=I<font>
+
+Bold version of the fixed-width font.  Defaults to CB.  Only matters for
+troff(1) output.
+
+=item B<--fixeditalic>=I<font>
+
+Italic version of the fixed-width font (actually, something of a misnomer,
+since most fixed-width fonts only have an oblique version, not an italic
+version).  Defaults to CI.  Only matters for troff(1) output.
+
+=item B<--fixedbolditalic>=I<font>
+
+Bold italic (probably actually oblique) version of the fixed-width font.
+Pod::Man doesn't assume you have this, and defaults to CB.  Some systems
+(such as Solaris) have this font available as CX.  Only matters for troff(1)
+output.
+
+=item B<-h>, B<--help>
+
+Print out usage information.
+
+=item B<-l>, B<--lax>
+
+No longer used.  B<pod2man> used to check its input for validity as a manual
+page, but this should now be done by L<podchecker(1)> instead.  Accepted for
+backwards compatibility; this option no longer does anything.
+
+=item B<-n> I<name>, B<--name>=I<name>
+
+Set the name of the manual page to I<name>.  Without this option, the manual
+name is set to the uppercased base name of the file being converted unless
+the manual section is 3, in which case the path is parsed to see if it is a
+Perl module path.  If it is, a path like C<.../lib/Pod/Man.pm> is converted
+into a name like C<Pod::Man>.  This option, if given, overrides any
+automatic determination of the name.
+
+Note that this option is probably not useful when converting multiple POD
+files at once.  The convention for Unix man pages for commands is for the
+man page title to be in all-uppercase even if the command isn't.
+
+=item B<-o>, B<--official>
+
+Set the default header to indicate that this page is part of the standard
+Perl release, if B<--center> is not also given.
+
+=item B<-q> I<quotes>, B<--quotes>=I<quotes>
+
+Sets the quote marks used to surround CE<lt>> text to I<quotes>.  If
+I<quotes> is a single character, it is used as both the left and right
+quote; if I<quotes> is two characters, the first character is used as the
+left quote and the second as the right quoted; and if I<quotes> is four
+characters, the first two are used as the left quote and the second two as
+the right quote.
+
+I<quotes> may also be set to the special value C<none>, in which case no
+quote marks are added around CE<lt>> text (but the font is still changed for
+troff output).
+
+=item B<-r>, B<--release>
+
+Set the centered footer.  By default, this is the version of Perl you run
+B<pod2man> under.  Note that some system an macro sets assume that the
+centered footer will be a modification date and will prepend something like
+"Last modified: "; if this is the case, you may want to set B<--release> to
+the last modified date and B<--date> to the version number.
+
+=item B<-s>, B<--section>
+
+Set the section for the C<.TH> macro.  The standard section numbering
+convention is to use 1 for user commands, 2 for system calls, 3 for
+functions, 4 for devices, 5 for file formats, 6 for games, 7 for
+miscellaneous information, and 8 for administrator commands.  There is a lot
+of variation here, however; some systems (like Solaris) use 4 for file
+formats, 5 for miscellaneous information, and 7 for devices.  Still others
+use 1m instead of 8, or some mix of both.  About the only section numbers
+that are reliably consistent are 1, 2, and 3.
+
+By default, section 1 will be used unless the file ends in .pm in which case
+section 3 will be selected.
+
+=item B<-v>, B<--verbose>
+
+Print out the name of each output file as it is being generated.
+
+=back
+
+=head1 DIAGNOSTICS
+
+If B<pod2man> fails with errors, see L<Pod::Man> and L<Pod::Parser> for
+information about what those errors might mean.
+
+=head1 EXAMPLES
+
+    pod2man program > program.1
+    pod2man SomeModule.pm /usr/perl/man/man3/SomeModule.3
+    pod2man --section=7 note.pod > note.7
+
+If you would like to print out a lot of man page continuously, you probably
+want to set the C and D registers to set contiguous page numbering and
+even/odd paging, at least on some versions of man(7).
+
+    troff -man -rC1 -rD1 perl.1 perldata.1 perlsyn.1 ...
+
+To get index entries on stderr, turn on the F register, as in:
+
+    troff -man -rF1 perl.1
+
+The indexing merely outputs messages via C<.tm> for each major page,
+section, subsection, item, and any C<XE<lt>E<gt>> directives.  See
+L<Pod::Man> for more details.
+
+=head1 BUGS
+
+Lots of this documentation is duplicated from L<Pod::Man>.
+
+=head1 NOTES
+
+For those not sure of the proper layout of a man page, here are some notes
+on writing a proper man page.
+
+The name of the program being documented is conventionally written in bold
+(using BE<lt>E<gt>) wherever it occurs, as are all program options.
+Arguments should be written in italics (IE<lt>E<gt>).  Functions are
+traditionally written in italics; if you write a function as function(),
+Pod::Man will take care of this for you.  Literal code or commands should
+be in CE<lt>E<gt>.  References to other man pages should be in the form
+C<manpage(section)>, and Pod::Man will automatically format those
+appropriately.  As an exception, it's traditional not to use this form when
+referring to module documentation; use C<LE<lt>Module::NameE<gt>> instead.
+
+References to other programs or functions are normally in the form of man
+page references so that cross-referencing tools can provide the user with
+links and the like.  It's possible to overdo this, though, so be careful not
+to clutter your documentation with too much markup.
+
+The major headers should be set out using a C<=head1> directive, and are
+historically written in the rather startling ALL UPPER CASE format, although
+this is not mandatory.  Minor headers may be included using C<=head2>, and
+are typically in mixed case.
+
+The standard sections of a manual page are:
+
+=over 4
+
+=item NAME
+
+Mandatory section; should be a comma-separated list of programs or functions
+documented by this podpage, such as:
+
+    foo, bar - programs to do something
+
+Manual page indexers are often extremely picky about the format of this
+section, so don't put anything in it except this line.  A single dash, and
+only a single dash, should separate the list of programs or functions from
+the description.  Functions should not be qualified with C<()> or the like.
+The description should ideally fit on a single line, even if a man program
+replaces the dash with a few tabs.
+
+=item SYNOPSIS
+
+A short usage summary for programs and functions.  This section is mandatory
+for section 3 pages.
+
+=item DESCRIPTION
+
+Extended description and discussion of the program or functions, or the body
+of the documentation for man pages that document something else.  If
+particularly long, it's a good idea to break this up into subsections
+C<=head2> directives like:
+
+    =head2 Normal Usage
+
+    =head2 Advanced Features
+
+    =head2 Writing Configuration Files
+
+or whatever is appropriate for your documentation.
+
+=item OPTIONS
+
+Detailed description of each of the command-line options taken by the
+program.  This should be separate from the description for the use of things
+like L<Pod::Usage|Pod::Usage>.  This is normally presented as a list, with
+each option as a separate C<=item>.  The specific option string should be
+enclosed in BE<lt>E<gt>.  Any values that the option takes should be
+enclosed in IE<lt>E<gt>.  For example, the section for the option
+B<--section>=I<manext> would be introduced with:
+
+    =item B<--section>=I<manext>
+
+Synonymous options (like both the short and long forms) are separated by a
+comma and a space on the same C<=item> line, or optionally listed as their
+own item with a reference to the canonical name.  For example, since
+B<--section> can also be written as B<-s>, the above would be:
+
+    =item B<-s> I<manext>, B<--section>=I<manext>
+
+(Writing the short option first is arguably easier to read, since the long
+option is long enough to draw the eye to it anyway and the short option can
+otherwise get lost in visual noise.)
+
+=item RETURN VALUE
+
+What the program or function returns, if successful.  This section can be
+omitted for programs whose precise exit codes aren't important, provided
+they return 0 on success as is standard.  It should always be present for
+functions.
+
+=item ERRORS
+
+Exceptions, error return codes, exit statuses, and errno settings.
+Typically used for function documentation; program documentation uses
+DIAGNOSTICS instead.  The general rule of thumb is that errors printed to
+STDOUT or STDERR and intended for the end user are documented in DIAGNOSTICS
+while errors passed internal to the calling program and intended for other
+programmers are documented in ERRORS.  When documenting a function that sets
+errno, a full list of the possible errno values should be given here.
+
+=item DIAGNOSTICS
+
+All possible messages the program can print out--and what they mean.  You
+may wish to follow the same documentation style as the Perl documentation;
+see perldiag(1) for more details (and look at the POD source as well).
+
+If applicable, please include details on what the user should do to correct
+the error; documenting an error as indicating "the input buffer is too
+small" without telling the user how to increase the size of the input buffer
+(or at least telling them that it isn't possible) aren't very useful.
+
+=item EXAMPLES
+
+Give some example uses of the program or function.  Don't skimp; users often
+find this the most useful part of the documentation.  The examples are
+generally given as verbatim paragraphs.
+
+Don't just present an example without explaining what it does.  Adding a
+short paragraph saying what the example will do can increase the value of
+the example immensely.
+
+=item ENVIRONMENT
+
+Environment variables that the program cares about, normally presented as a
+list using C<=over>, C<=item>, and C<=back>.  For example:
+
+    =over 6
+
+    =item HOME
+
+    Used to determine the user's home directory.  F<.foorc> in this
+    directory is read for configuration details, if it exists.
+
+    =back
+
+Since environment variables are normally in all uppercase, no additional
+special formatting is generally needed; they're glaring enough as it is.
+
+=item FILES
+
+All files used by the program or function, normally presented as a list, and
+what it uses them for.  File names should be enclosed in FE<lt>E<gt>.  It's
+particularly important to document files that will be potentially modified.
+
+=item CAVEATS
+
+Things to take special care with, sometimes called WARNINGS.
+
+=item BUGS
+
+Things that are broken or just don't work quite right.
+
+=item RESTRICTIONS
+
+Bugs you don't plan to fix.  :-)
+
+=item NOTES
+
+Miscellaneous commentary.
+
+=item SEE ALSO
+
+Other man pages to check out, like man(1), man(7), makewhatis(8), or
+catman(8).  Normally a simple list of man pages separated by commas, or a
+paragraph giving the name of a reference work.  Man page references, if they
+use the standard C<name(section)> form, don't have to be enclosed in
+LE<lt>E<gt> (although it's recommended), but other things in this section
+probably should be when appropriate.
+
+If the package has a mailing list, include a URL or subscription
+instructions here.
+
+If the package has a web site, include a URL here.
+
+=item AUTHOR
+
+Who wrote it (use AUTHORS for multiple people).  Including your current
+e-mail address (or some e-mail address to which bug reports should be sent)
+so that users have a way of contacting you is a good idea.  Remember that
+program documentation tends to roam the wild for far longer than you expect
+and pick an e-mail address that's likely to last if possible.
+
+=item COPYRIGHT AND LICENSE
+
+For copyright
+
+    Copyright YEAR(s) by YOUR NAME(s)
+
+(No, (C) is not needed.  No, "all rights reserved" is not needed.)
+
+For licensing the easiest way is to use the same licensing as Perl itself:
+
+    This library is free software; you may redistribute it and/or modify
+    it under the same terms as Perl itself.
+
+This makes it easy for people to use your module with Perl.  Note that
+this licensing is neither an endorsement or a requirement, you are of
+course free to choose any licensing.
+
+=item HISTORY
+
+Programs derived from other sources sometimes have this, or you might keep
+a modification log here.  If the log gets overly long or detailed,
+consider maintaining it in a separate file, though.
+
+=back
+
+In addition, some systems use CONFORMING TO to note conformance to relevant
+standards and MT-LEVEL to note safeness for use in threaded programs or
+signal handlers.  These headings are primarily useful when documenting parts
+of a C library.  Documentation of object-oriented libraries or modules may
+use CONSTRUCTORS and METHODS sections for detailed documentation of the
+parts of the library and save the DESCRIPTION section for an overview; other
+large modules may use FUNCTIONS for similar reasons.  Some people use
+OVERVIEW to summarize the description if it's quite long.
+
+Section ordering varies, although NAME should I<always> be the first section
+(you'll break some man page systems otherwise), and NAME, SYNOPSIS,
+DESCRIPTION, and OPTIONS generally always occur first and in that order if
+present.  In general, SEE ALSO, AUTHOR, and similar material should be left
+for last.  Some systems also move WARNINGS and NOTES to last.  The order
+given above should be reasonable for most purposes.
+
+Finally, as a general note, try not to use an excessive amount of markup.
+As documented here and in L<Pod::Man>, you can safely leave Perl variables,
+function names, man page references, and the like unadorned by markup and
+the POD translators will figure it out for you.  This makes it much easier
+to later edit the documentation.  Note that many existing translators
+(including this one currently) will do the wrong thing with e-mail addresses
+or URLs when wrapped in LE<lt>E<gt>, so don't do that.
+
+For additional information that may be more accurate for your specific
+system, see either L<man(5)> or L<man(7)> depending on your system manual
+section numbering conventions.
+
+=head1 SEE ALSO
+
+L<Pod::Man>, L<Pod::Parser>, L<man(1)>, L<nroff(1)>, L<podchecker(1)>,
+L<troff(1)>, L<man(7)>
+
+The man page documenting the an macro set may be L<man(5)> instead of
+L<man(7)> on your system.
+
+The current version of this script is always available from its web site at
+L<http://www.eyrie.org/~eagle/software/podlators/>.  It is also part of the
+Perl core distribution as of 5.6.0.
+
+=head1 AUTHOR
+
+Russ Allbery <rra@stanford.edu>, based I<very> heavily on the original
+B<pod2man> by Larry Wall and Tom Christiansen.  Large portions of this
+documentation, particularly the sections on the anatomy of a proper man
+page, are taken from the B<pod2man> documentation by Tom.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>.
+
+This program is free software; you may redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+__END__
+:endofperl

Perl/bin/pod2text.bat

@@ -0,0 +1,257 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+        if $running_under_some_shell;
+
+# pod2text -- Convert POD data to formatted ASCII text.
+#
+# Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>
+#
+# This program is free software; you may redistribute it and/or modify it
+# under the same terms as Perl itself.
+#
+# The driver script for Pod::Text, Pod::Text::Termcap, and Pod::Text::Color,
+# invoked by perldoc -t among other things.
+
+require 5.004;
+
+use Getopt::Long qw(GetOptions);
+use Pod::Text ();
+use Pod::Usage qw(pod2usage);
+
+use strict;
+
+# Silence -w warnings.
+use vars qw($running_under_some_shell);
+
+# Take an initial pass through our options, looking for one of the form
+# -<number>.  We turn that into -w <number> for compatibility with the
+# original pod2text script.
+for (my $i = 0; $i < @ARGV; $i++) {
+    last if $ARGV[$i] =~ /^--$/;
+    if ($ARGV[$i] =~ /^-(\d+)$/) {
+        splice (@ARGV, $i++, 1, '-w', $1);
+    }
+}
+
+# Insert -- into @ARGV before any single dash argument to hide it from
+# Getopt::Long; we want to interpret it as meaning stdin (which Pod::Parser
+# does correctly).
+my $stdin;
+@ARGV = map { $_ eq '-' && !$stdin++ ? ('--', $_) : $_ } @ARGV;
+
+# Parse our options.  Use the same names as Pod::Text for simplicity, and
+# default to sentence boundaries turned off for compatibility.
+my %options;
+$options{sentence} = 0;
+Getopt::Long::config ('bundling');
+GetOptions (\%options, 'alt|a', 'code', 'color|c', 'help|h', 'indent|i=i',
+            'loose|l', 'margin|left-margin|m=i', 'overstrike|o',
+            'quotes|q=s', 'sentence|s', 'termcap|t', 'width|w=i') or exit 1;
+pod2usage (1) if $options{help};
+
+# Figure out what formatter we're going to use.  -c overrides -t.
+my $formatter = 'Pod::Text';
+if ($options{color}) {
+    $formatter = 'Pod::Text::Color';
+    eval { require Term::ANSIColor };
+    if ($@) { die "-c (--color) requires Term::ANSIColor be installed\n" }
+    require Pod::Text::Color;
+} elsif ($options{termcap}) {
+    $formatter = 'Pod::Text::Termcap';
+    require Pod::Text::Termcap;
+} elsif ($options{overstrike}) {
+    $formatter = 'Pod::Text::Overstrike';
+    require Pod::Text::Overstrike;
+}
+delete @options{'color', 'termcap', 'overstrike'};
+
+# Initialize and run the formatter.
+my $parser = $formatter->new (%options);
+$parser->parse_from_file (@ARGV);
+
+__END__
+
+=head1 NAME
+
+pod2text - Convert POD data to formatted ASCII text
+
+=head1 SYNOPSIS
+
+pod2text [B<-aclost>] [B<--code>] [B<-i> I<indent>] S<[B<-q> I<quotes>]>
+S<[B<-w> I<width>]> [I<input> [I<output>]]
+
+pod2text B<-h>
+
+=head1 DESCRIPTION
+
+B<pod2text> is a front-end for Pod::Text and its subclasses.  It uses them
+to generate formatted ASCII text from POD source.  It can optionally use
+either termcap sequences or ANSI color escape sequences to format the text.
+
+I<input> is the file to read for POD source (the POD can be embedded in
+code).  If I<input> isn't given, it defaults to STDIN.  I<output>, if given,
+is the file to which to write the formatted output.  If I<output> isn't
+given, the formatted output is written to STDOUT.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-a>, B<--alt>
+
+Use an alternate output format that, among other things, uses a different
+heading style and marks C<=item> entries with a colon in the left margin.
+
+=item B<--code>
+
+Include any non-POD text from the input file in the output as well.  Useful
+for viewing code documented with POD blocks with the POD rendered and the
+code left intact.
+
+=item B<-c>, B<--color>
+
+Format the output with ANSI color escape sequences.  Using this option
+requires that Term::ANSIColor be installed on your system.
+
+=item B<-i> I<indent>, B<--indent=>I<indent>
+
+Set the number of spaces to indent regular text, and the default indentation
+for C<=over> blocks.  Defaults to 4 spaces if this option isn't given.
+
+=item B<-h>, B<--help>
+
+Print out usage information and exit.
+
+=item B<-l>, B<--loose>
+
+Print a blank line after a C<=head1> heading.  Normally, no blank line is
+printed after C<=head1>, although one is still printed after C<=head2>,
+because this is the expected formatting for manual pages; if you're
+formatting arbitrary text documents, using this option is recommended.
+
+=item B<-m> I<width>, B<--left-margin>=I<width>, B<--margin>=I<width>
+
+The width of the left margin in spaces.  Defaults to 0.  This is the margin
+for all text, including headings, not the amount by which regular text is
+indented; for the latter, see B<-i> option.
+
+=item B<-o>, B<--overstrike>
+
+Format the output with overstruck printing.  Bold text is rendered as
+character, backspace, character.  Italics and file names are rendered as
+underscore, backspace, character.  Many pagers, such as B<less>, know how
+to convert this to bold or underlined text.
+
+=item B<-q> I<quotes>, B<--quotes>=I<quotes>
+
+Sets the quote marks used to surround CE<lt>> text to I<quotes>.  If
+I<quotes> is a single character, it is used as both the left and right
+quote; if I<quotes> is two characters, the first character is used as the
+left quote and the second as the right quoted; and if I<quotes> is four
+characters, the first two are used as the left quote and the second two as
+the right quote.
+
+I<quotes> may also be set to the special value C<none>, in which case no
+quote marks are added around CE<lt>> text.
+
+=item B<-s>, B<--sentence>
+
+Assume each sentence ends with two spaces and try to preserve that spacing.
+Without this option, all consecutive whitespace in non-verbatim paragraphs
+is compressed into a single space.
+
+=item B<-t>, B<--termcap>
+
+Try to determine the width of the screen and the bold and underline
+sequences for the terminal from termcap, and use that information in
+formatting the output.  Output will be wrapped at two columns less than the
+width of your terminal device.  Using this option requires that your system
+have a termcap file somewhere where Term::Cap can find it and requires that
+your system support termios.  With this option, the output of B<pod2text>
+will contain terminal control sequences for your current terminal type.
+
+=item B<-w>, B<--width=>I<width>, B<->I<width>
+
+The column at which to wrap text on the right-hand side.  Defaults to 76,
+unless B<-t> is given, in which case it's two columns less than the width of
+your terminal device.
+
+=back
+
+=head1 DIAGNOSTICS
+
+If B<pod2text> fails with errors, see L<Pod::Text> and L<Pod::Parser> for
+information about what those errors might mean.  Internally, it can also
+produce the following diagnostics:
+
+=over 4
+
+=item -c (--color) requires Term::ANSIColor be installed
+
+(F) B<-c> or B<--color> were given, but Term::ANSIColor could not be
+loaded.
+
+=item Unknown option: %s
+
+(F) An unknown command line option was given.
+
+=back
+
+In addition, other L<Getopt::Long|Getopt::Long> error messages may result
+from invalid command-line options.
+
+=head1 ENVIRONMENT
+
+=over 4
+
+=item COLUMNS
+
+If B<-t> is given, B<pod2text> will take the current width of your screen
+from this environment variable, if available.  It overrides terminal width
+information in TERMCAP.
+
+=item TERMCAP
+
+If B<-t> is given, B<pod2text> will use the contents of this environment
+variable if available to determine the correct formatting sequences for your
+current terminal device.
+
+=back
+
+=head1 SEE ALSO
+
+L<Pod::Text>, L<Pod::Text::Color>, L<Pod::Text::Overstrike>,
+L<Pod::Text::Termcap>, L<Pod::Parser>
+
+The current version of this script is always available from its web site at
+L<http://www.eyrie.org/~eagle/software/podlators/>.  It is also part of the
+Perl core distribution as of 5.6.0.
+
+=head1 AUTHOR
+
+Russ Allbery <rra@stanford.edu>.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>.
+
+This program is free software; you may redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+__END__
+:endofperl

Perl/bin/pod2usage.bat

@@ -0,0 +1,157 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec perl -S $0 "$@"'
+        if 0;
+
+#############################################################################
+# pod2usage -- command to print usage messages from embedded pod docs
+#
+# Copyright (c) 1996-2000 by Bradford Appleton. All rights reserved.
+# This file is part of "PodParser". PodParser is free software;
+# you can redistribute it and/or modify it under the same terms
+# as Perl itself.
+#############################################################################
+
+use strict;
+use diagnostics;
+
+=head1 NAME
+
+pod2usage - print usage messages from embedded pod docs in files
+
+=head1 SYNOPSIS
+
+=over 12
+
+=item B<pod2usage>
+
+[B<-help>]
+[B<-man>]
+[B<-exit>S< >I<exitval>]
+[B<-output>S< >I<outfile>]
+[B<-verbose> I<level>]
+[B<-pathlist> I<dirlist>]
+I<file>
+
+=back
+
+=head1 OPTIONS AND ARGUMENTS
+
+=over 8
+
+=item B<-help>
+
+Print a brief help message and exit.
+
+=item B<-man>
+
+Print this command's manual page and exit.
+
+=item B<-exit> I<exitval>
+
+The exit status value to return.
+
+=item B<-output> I<outfile>
+
+The output file to print to. If the special names "-" or ">&1" or ">&STDOUT"
+are used then standard output is used. If ">&2" or ">&STDERR" is used then
+standard error is used.
+
+=item B<-verbose> I<level>
+
+The desired level of verbosity to use:
+
+    1 : print SYNOPSIS only
+    2 : print SYNOPSIS sections and any OPTIONS/ARGUMENTS sections
+    3 : print the entire manpage (similar to running pod2text)
+
+=item B<-pathlist> I<dirlist>
+
+Specifies one or more directories to search for the input file if it
+was not supplied with an absolute path. Each directory path in the given
+list should be separated by a ':' on Unix (';' on MSWin32 and DOS).
+
+=item I<file>
+
+The pathname of a file containing pod documentation to be output in
+usage mesage format (defaults to standard input).
+
+=back
+
+=head1 DESCRIPTION
+
+B<pod2usage> will read the given input file looking for pod
+documentation and will print the corresponding usage message.
+If no input file is specifed than standard input is read.
+
+B<pod2usage> invokes the B<pod2usage()> function in the B<Pod::Usage>
+module. Please see L<Pod::Usage/pod2usage()>.
+
+=head1 SEE ALSO
+
+L<Pod::Usage>, L<pod2text(1)>
+
+=head1 AUTHOR
+
+Please report bugs using L<http://rt.cpan.org>.
+
+Brad Appleton E<lt>bradapp@enteract.comE<gt>
+
+Based on code for B<pod2text(1)> written by
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+
+=cut
+
+use Pod::Usage;
+use Getopt::Long;
+
+## Define options
+my %options = ();
+my @opt_specs = (
+    "help",
+    "man",
+    "exit=i",
+    "output=s",
+    "pathlist=s",
+    "verbose=i",
+);
+
+## Parse options
+GetOptions(\%options, @opt_specs)  ||  pod2usage(2);
+pod2usage(1)  if ($options{help});
+pod2usage(VERBOSE => 2)  if ($options{man});
+
+## Dont default to STDIN if connected to a terminal
+pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
+
+@ARGV = ("-")  unless (@ARGV > 0);
+if (@ARGV > 1) {
+    print STDERR "pod2usage: Too many filenames given\n\n";
+    pod2usage(2);
+}
+
+my %usage = ();
+$usage{-input}    = shift(@ARGV);
+$usage{-exitval}  = $options{"exit"}      if (defined $options{"exit"});
+$usage{-output}   = $options{"output"}    if (defined $options{"output"});
+$usage{-verbose}  = $options{"verbose"}   if (defined $options{"verbose"});
+$usage{-pathlist} = $options{"pathlist"}  if (defined $options{"pathlist"});
+
+pod2usage(\%usage);
+
+
+
+__END__
+:endofperl

Perl/bin/podchecker.bat

@@ -0,0 +1,161 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec perl -S $0 "$@"'
+        if 0;
+#############################################################################
+# podchecker -- command to invoke the podchecker function in Pod::Checker
+#
+# Copyright (c) 1998-2000 by Bradford Appleton. All rights reserved.
+# This file is part of "PodParser". PodParser is free software;
+# you can redistribute it and/or modify it under the same terms
+# as Perl itself.
+#############################################################################
+
+use strict;
+#use diagnostics;
+
+=head1 NAME
+
+podchecker - check the syntax of POD format documentation files
+
+=head1 SYNOPSIS
+
+B<podchecker> [B<-help>] [B<-man>] [B<-(no)warnings>] [I<file>S< >...]
+
+=head1 OPTIONS AND ARGUMENTS
+
+=over 8
+
+=item B<-help>
+
+Print a brief help message and exit.
+
+=item B<-man>
+
+Print the manual page and exit.
+
+=item B<-warnings> B<-nowarnings>
+
+Turn on/off printing of warnings. Repeating B<-warnings> increases the
+warning level, i.e. more warnings are printed. Currently increasing to
+level two causes flagging of unescaped "E<lt>,E<gt>" characters.
+
+=item I<file>
+
+The pathname of a POD file to syntax-check (defaults to standard input).
+
+=back
+
+=head1 DESCRIPTION
+
+B<podchecker> will read the given input files looking for POD
+syntax errors in the POD documentation and will print any errors
+it find to STDERR. At the end, it will print a status message
+indicating the number of errors found.
+
+Directories are ignored, an appropriate warning message is printed.
+
+B<podchecker> invokes the B<podchecker()> function exported by B<Pod::Checker>
+Please see L<Pod::Checker/podchecker()> for more details.
+
+=head1 RETURN VALUE
+
+B<podchecker> returns a 0 (zero) exit status if all specified
+POD files are ok.
+
+=head1 ERRORS
+
+B<podchecker> returns the exit status 1 if at least one of
+the given POD files has syntax errors.
+
+The status 2 indicates that at least one of the specified 
+files does not contain I<any> POD commands.
+
+Status 1 overrides status 2. If you want unambigouus
+results, call B<podchecker> with one single argument only.
+
+=head1 SEE ALSO
+
+L<Pod::Parser> and L<Pod::Checker>
+
+=head1 AUTHORS
+
+Please report bugs using L<http://rt.cpan.org>.
+
+Brad Appleton E<lt>bradapp@enteract.comE<gt>,
+Marek Rouchal E<lt>marekr@cpan.orgE<gt>
+
+Based on code for B<Pod::Text::pod2text(1)> written by
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+
+=cut
+
+
+use Pod::Checker;
+use Pod::Usage;
+use Getopt::Long;
+
+## Define options
+my %options;
+
+## Parse options
+GetOptions(\%options, qw(help man warnings+ nowarnings))  ||  pod2usage(2);
+pod2usage(1)  if ($options{help});
+pod2usage(-verbose => 2)  if ($options{man});
+
+if($options{nowarnings}) {
+  $options{warnings} = 0;
+}
+elsif(!defined $options{warnings}) {
+  $options{warnings} = 1; # default is warnings on
+}
+
+## Dont default to STDIN if connected to a terminal
+pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
+
+## Invoke podchecker()
+my $status = 0;
+@ARGV = qw(-) unless(@ARGV);
+for my $podfile (@ARGV) {
+    if($podfile eq '-') {
+      $podfile = "<&STDIN";
+    }
+    elsif(-d $podfile) {
+      warn "podchecker: Warning: Ignoring directory '$podfile'\n";
+      next;
+    }
+    my $errors = 
+      podchecker($podfile, undef, '-warnings' => $options{warnings});
+    if($errors > 0) {
+        # errors occurred
+        $status = 1;
+        printf STDERR ("%s has %d pod syntax %s.\n",
+                       $podfile, $errors,
+                       ($errors == 1) ? "error" : "errors");
+    }
+    elsif($errors < 0) {
+        # no pod found
+        $status = 2 unless($status);
+        print STDERR "$podfile does not contain any pod commands.\n";
+    }
+    else {
+        print STDERR "$podfile pod syntax OK.\n";
+    }
+}
+exit $status;
+
+
+__END__
+:endofperl

Perl/bin/podselect.bat

@@ -0,0 +1,120 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec perl -S $0 "$@"'
+        if 0;
+
+#############################################################################
+# podselect -- command to invoke the podselect function in Pod::Select
+#
+# Copyright (c) 1996-2000 by Bradford Appleton. All rights reserved.
+# This file is part of "PodParser". PodParser is free software;
+# you can redistribute it and/or modify it under the same terms
+# as Perl itself.
+#############################################################################
+
+use strict;
+use diagnostics;
+
+=head1 NAME
+
+podselect - print selected sections of pod documentation on standard output
+
+=head1 SYNOPSIS
+
+B<podselect> [B<-help>] [B<-man>] [B<-section>S< >I<section-spec>]
+[I<file>S< >...]
+
+=head1 OPTIONS AND ARGUMENTS
+
+=over 8
+
+=item B<-help>
+
+Print a brief help message and exit.
+
+=item B<-man>
+
+Print the manual page and exit.
+
+=item B<-section>S< >I<section-spec>
+
+Specify a section to include in the output.
+See L<Pod::Parser/"SECTION SPECIFICATIONS">
+for the format to use for I<section-spec>.
+This option may be given multiple times on the command line.
+
+=item I<file>
+
+The pathname of a file from which to select sections of pod
+documentation (defaults to standard input).
+
+=back
+
+=head1 DESCRIPTION
+
+B<podselect> will read the given input files looking for pod
+documentation and will print out (in raw pod format) all sections that
+match one ore more of the given section specifications. If no section
+specifications are given than all pod sections encountered are output.
+
+B<podselect> invokes the B<podselect()> function exported by B<Pod::Select>
+Please see L<Pod::Select/podselect()> for more details.
+
+=head1 SEE ALSO
+
+L<Pod::Parser> and L<Pod::Select>
+
+=head1 AUTHOR
+
+Please report bugs using L<http://rt.cpan.org>.
+
+Brad Appleton E<lt>bradapp@enteract.comE<gt>
+
+Based on code for B<Pod::Text::pod2text(1)> written by
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+
+=cut
+
+use Pod::Select;
+use Pod::Usage;
+use Getopt::Long;
+
+## Define options
+my %options = (
+        "help"     => 0,
+        "man"      => 0,
+        "sections" => [],
+);
+
+## Parse options
+GetOptions(\%options, "help", "man", "sections|select=s@")  ||  pod2usage(2);
+pod2usage(1)  if ($options{help});
+pod2usage(-verbose => 2)  if ($options{man});
+
+## Dont default to STDIN if connected to a terminal
+pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
+
+## Invoke podselect().
+if (@{ $options{"sections"} } > 0) {
+    podselect({ -sections => $options{"sections"} }, @ARGV);
+}
+else {
+    podselect(@ARGV);
+}
+
+
+
+__END__
+:endofperl

Perl/bin/ppm-shell

@@ -0,0 +1,22 @@
+#!/usr/bin/perl -w
+
+use strict;
+BEGIN { $ENV{PERL_RL} = "stub" if $^O eq "MSWin32" }
+use Term::ReadLine ();
+use Text::ParseWords qw(shellwords);
+
+system("ppm", "--version");
+exit 1 if $? != 0;
+
+my $term = new Term::ReadLine 'PPM';
+my $prompt = "ppm> ";
+my $OUT = $term->OUT || \*STDOUT;
+while ( defined ($_ = $term->readline($prompt)) ) {
+    last if /^(quit|exit)$/;
+    my @w = shellwords($_);
+    if (@w) {
+	system("ppm", @w);
+        $term->addhistory($_);
+    }
+}
+print "\n";

Perl/bin/ppm-shell.bat

@@ -0,0 +1,38 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl -w
+#line 15
+
+use strict;
+BEGIN { $ENV{PERL_RL} = "stub" if $^O eq "MSWin32" }
+use Term::ReadLine ();
+use Text::ParseWords qw(shellwords);
+
+system("ppm", "--version");
+exit 1 if $? != 0;
+
+my $term = new Term::ReadLine 'PPM';
+my $prompt = "ppm> ";
+my $OUT = $term->OUT || \*STDOUT;
+while ( defined ($_ = $term->readline($prompt)) ) {
+    last if /^(quit|exit)$/;
+    my @w = shellwords($_);
+    if (@w) {
+	system("ppm", @w);
+        $term->addhistory($_);
+    }
+}
+print "\n";
+
+__END__
+:endofperl

Perl/bin/prove.bat

@@ -0,0 +1,360 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+	if $running_under_some_shell;
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::Harness;
+use Getopt::Long;
+use Pod::Usage 1.12;
+use File::Spec;
+
+use vars qw( $VERSION );
+$VERSION = "1.04";
+
+my @ext = ();
+my $shuffle = 0;
+my $dry = 0;
+my $blib = 0;
+my $lib = 0;
+my $recurse = 0;
+my @includes = ();
+my @switches = ();
+
+# Allow cuddling the paths with the -I
+@ARGV = map { /^(-I)(.+)/ ? ($1,$2) : $_ } @ARGV;
+
+# Stick any default switches at the beginning, so they can be overridden
+# by the command line switches.
+unshift @ARGV, split( " ", $ENV{PROVE_SWITCHES} ) if defined $ENV{PROVE_SWITCHES};
+
+Getopt::Long::Configure( "no_ignore_case" );
+Getopt::Long::Configure( "bundling" );
+GetOptions(
+    'b|blib'        => \$blib,
+    'd|debug'       => \$Test::Harness::debug,
+    'D|dry'         => \$dry,
+    'h|help|?'      => sub {pod2usage({-verbose => 1}); exit},
+    'H|man'         => sub {pod2usage({-verbose => 2}); exit},
+    'I=s@'          => \@includes,
+    'l|lib'         => \$lib,
+    'r|recurse'     => \$recurse,
+    's|shuffle'     => \$shuffle,
+    't'             => sub { unshift @switches, "-t" }, # Always want -t up front
+    'T'             => sub { unshift @switches, "-T" }, # Always want -T up front
+    'timer'         => \$Test::Harness::Timer,
+    'v|verbose'     => \$Test::Harness::verbose,
+    'V|version'     => sub { print_version(); exit; },
+    'ext=s@'        => \@ext,
+) or exit 1;
+
+$ENV{TEST_VERBOSE} = 1 if $Test::Harness::verbose;
+
+# Build up extensions regex
+@ext = map { split /,/ } @ext;
+s/^\.// foreach @ext;
+@ext = ("t") unless @ext;
+my $ext_regex = join( "|", map { quotemeta } @ext );
+$ext_regex = qr/\.($ext_regex)$/;
+
+# Handle blib includes
+if ( $blib ) {
+    my @blibdirs = blibdirs();
+    if ( @blibdirs ) {
+        unshift @includes, @blibdirs;
+    } else {
+        warn "No blib directories found.\n";
+    }
+}
+
+# Handle lib includes
+if ( $lib ) {
+    unshift @includes, "lib";
+}
+
+# Build up TH switches
+push( @switches, map { /\s/ && !/^".*"$/ ? qq["-I$_"] : "-I$_" } @includes );
+$Test::Harness::Switches = join( " ", @switches );
+print "# \$Test::Harness::Switches: $Test::Harness::Switches\n" if $Test::Harness::debug;
+
+my @tests;
+@ARGV = File::Spec->curdir unless @ARGV;
+push( @tests, -d $_ ? all_in( $_ ) : $_ ) for map { glob } @ARGV;
+
+if ( @tests ) {
+    shuffle(@tests) if $shuffle;
+    if ( $dry ) {
+        print join( "\n", @tests, "" );
+    } else {
+        print "# ", scalar @tests, " tests to run\n" if $Test::Harness::debug;
+        runtests(@tests);
+    }
+}
+
+sub all_in {
+    my $start = shift;
+
+    my @hits = ();
+
+    local *DH;
+    if ( opendir( DH, $start ) ) {
+        my @files = sort readdir DH;
+        closedir DH;
+        for my $file ( @files ) {
+            next if $file eq File::Spec->updir || $file eq File::Spec->curdir;
+            next if $file eq ".svn";
+            next if $file eq "CVS";
+
+            my $currfile = File::Spec->catfile( $start, $file );
+            if ( -d $currfile ) {
+                push( @hits, all_in( $currfile ) ) if $recurse;
+            } else {
+                push( @hits, $currfile ) if $currfile =~ $ext_regex;
+            }
+        }
+    } else {
+        warn "$start: $!\n";
+    }
+
+    return @hits;
+}
+
+sub shuffle {
+    # Fisher-Yates shuffle
+    my $i = @_;
+    while ($i) {
+        my $j = rand $i--;
+        @_[$i, $j] = @_[$j, $i];
+    }
+}
+
+sub print_version {
+    printf( "prove v%s, using Test::Harness v%s and Perl v%vd\n",
+        $VERSION, $Test::Harness::VERSION, $^V );
+}
+
+# Stolen directly from blib.pm
+sub blibdirs {
+    my $dir = File::Spec->curdir;
+    if ($^O eq 'VMS') {
+        ($dir = VMS::Filespec::unixify($dir)) =~ s-/\z--;
+    }
+    my $archdir = "arch";
+    if ( $^O eq "MacOS" ) {
+        # Double up the MP::A so that it's not used only once.
+        $archdir = $MacPerl::Architecture = $MacPerl::Architecture;
+    }
+
+    my $i = 5;
+    while ($i--) {
+        my $blib      = File::Spec->catdir( $dir, "blib" );
+        my $blib_lib  = File::Spec->catdir( $blib, "lib" );
+        my $blib_arch = File::Spec->catdir( $blib, $archdir );
+
+        if ( -d $blib && -d $blib_arch && -d $blib_lib ) {
+            return ($blib_arch,$blib_lib);
+        }
+        $dir = File::Spec->catdir($dir, File::Spec->updir);
+    }
+    warn "$0: Cannot find blib\n";
+    return;
+}
+
+__END__
+
+=head1 NAME
+
+prove -- A command-line tool for running tests against Test::Harness
+
+=head1 SYNOPSIS
+
+prove [options] [files/directories]
+
+Options:
+
+    -b, --blib      Adds blib/lib to the path for your tests, a la "use blib".
+    -d, --debug     Includes extra debugging information.
+    -D, --dry       Dry run: Show the tests to run, but don't run them.
+        --ext=x     Extensions (defaults to .t)
+    -h, --help      Display this help
+    -H, --man       Longer manpage for prove
+    -I              Add libraries to @INC, as Perl's -I
+    -l, --lib       Add lib to the path for your tests.
+    -r, --recurse   Recursively descend into directories.
+    -s, --shuffle   Run the tests in a random order.
+    -T              Enable tainting checks
+    -t              Enable tainting warnings
+        --timer     Print elapsed time after each test file
+    -v, --verbose   Display standard output of test scripts while running them.
+    -V, --version   Display version info
+
+Single-character options may be stacked.  Default options may be set by
+specifying the PROVE_SWITCHES environment variable.
+
+=head1 OVERVIEW
+
+F<prove> is a command-line interface to the test-running functionality
+of C<Test::Harness>.  With no arguments, it will run all tests in the
+current directory.
+
+Shell metacharacters may be used with command lines options and will be exanded 
+via C<glob>.
+
+=head1 PROVE VS. "MAKE TEST"
+
+F<prove> has a number of advantages over C<make test> when doing development.
+
+=over 4
+
+=item * F<prove> is designed as a development tool
+
+Perl users typically run the test harness through a makefile via
+C<make test>.  That's fine for module distributions, but it's
+suboptimal for a test/code/debug development cycle.
+
+=item * F<prove> is granular 
+
+F<prove> lets your run against only the files you want to check.
+Running C<prove t/live/ t/master.t> checks every F<*.t> in F<t/live>,
+plus F<t/master.t>.
+
+=item * F<prove> has an easy verbose mode
+
+F<prove> has a C<-v> option to see the raw output from the tests.
+To do this with C<make test>, you must set C<HARNESS_VERBOSE=1> in
+the environment.
+
+=item * F<prove> can run under taint mode
+
+F<prove>'s C<-T> runs your tests under C<perl -T>, and C<-t> runs them
+under C<perl -t>.
+
+=item * F<prove> can shuffle tests
+
+You can use F<prove>'s C<--shuffle> option to try to excite problems
+that don't show up when tests are run in the same order every time.
+
+=item * F<prove> doesn't rely on a make tool
+
+Not everyone wants to write a makefile, or use L<ExtUtils::MakeMaker>
+to do so.  F<prove> has no external dependencies.
+
+=item * Not everything is a module
+
+More and more users are using Perl's testing tools outside the
+context of a module distribution, and may not even use a makefile
+at all.
+
+=back
+
+=head1 COMMAND LINE OPTIONS
+
+=head2 -b, --blib
+
+Adds blib/lib to the path for your tests, a la "use blib".
+
+=head2 -d, --debug
+
+Include debug information about how F<prove> is being run.  This
+option doesn't show the output from the test scripts.  That's handled
+by -v,--verbose.
+
+=head2 -D, --dry
+
+Dry run: Show the tests to run, but don't run them.
+
+=head2 --ext=extension
+
+Specify extensions of the test files to run.  By default, these are .t,
+but you may have other non-.t test files, most likely .sh shell scripts.
+The --ext is repeatable.
+
+=head2 -I
+
+Add libraries to @INC, as Perl's -I.
+
+=head2 -l, --lib
+
+Add C<lib> to @INC.  Equivalent to C<-Ilib>.
+
+=head2 -r, --recurse
+
+Descends into subdirectories of any directories specified, looking for tests.
+
+=head2 -s, --shuffle
+
+Sometimes tests are accidentally dependent on tests that have been
+run before.  This switch will shuffle the tests to be run prior to
+running them, thus ensuring that hidden dependencies in the test
+order are likely to be revealed.  The author hopes the run the
+algorithm on the preceding sentence to see if he can produce something
+slightly less awkward.
+
+=head2 -t
+
+Runs test programs under perl's -t taint warning mode.
+
+=head2 -T
+
+Runs test programs under perl's -T taint mode.
+
+=head2 --timer
+
+Print elapsed time after each test file
+
+=head2 -v, --verbose
+
+Display standard output of test scripts while running them.  Also sets
+TEST_VERBOSE in case your tests rely on them.
+
+=head2 -V, --version
+
+Display version info.
+
+=head1 BUGS
+
+Please use the CPAN bug ticketing system at L<http://rt.cpan.org/>.
+You can also mail bugs, fixes and enhancements to 
+C<< <bug-test-harness@rt.cpan.org> >>.
+
+=head1 TODO
+
+=over 4
+
+=item *
+
+Shuffled tests must be recreatable
+
+=back
+
+=head1 AUTHORS
+
+Andy Lester C<< <andy@petdance.com> >>
+
+=head1 COPYRIGHT
+
+Copyright 2005 by Andy Lester C<< <andy@petdance.com> >>.
+
+This program is free software; you can redistribute it and/or 
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>.
+
+=cut
+
+__END__
+:endofperl

Perl/bin/ptar

@@ -0,0 +1,105 @@
+#!/usr/bin/perl
+use strict;
+
+use Getopt::Std;
+use Archive::Tar;
+use File::Find;
+
+my $opts = {};
+getopts('dcvzthxf:', $opts) or die usage();
+
+### show the help message ###
+die usage() if $opts->{h};
+
+### enable debugging (undocumented feature)
+local $Archive::Tar::DEBUG = 1 if $opts->{d};
+
+### sanity checks ###
+unless ( 1 == grep { defined $opts->{$_} } qw[x t c] ) {
+    die "You need exactly one of 'x', 't' or 'c' options: " . usage();
+}
+
+my $compress    = $opts->{z} ? 1 : 0;
+my $verbose     = $opts->{v} ? 1 : 0;
+my $file        = $opts->{f} ? $opts->{f} : 'default.tar';
+my $tar         = Archive::Tar->new();
+
+if( $opts->{c} ) {
+    my @files;
+    find( sub { push @files, $File::Find::name;
+                print $File::Find::name.$/ if $verbose }, @ARGV );
+
+    Archive::Tar->create_archive( $file, $compress, @files );
+    exit;
+}
+
+my $tar = Archive::Tar->new($file, $compress);
+
+if( $opts->{t} ) {
+    print map { $_->full_path . $/ } $tar->get_files;
+
+} elsif( $opts->{x} ) {
+    print map { $_->full_path . $/ } $tar->get_files
+        if $verbose;
+    Archive::Tar->extract_archive($file, $compress);
+}
+
+
+
+sub usage {
+    qq[
+Usage:  ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
+        ptar -x [-v] [-z] [-f ARCHIVE_FILE]
+        ptar -t [-z] [-f ARCHIVE_FILE]
+        ptar -h
+
+    ptar is a small, tar look-alike program that uses the perl module
+    Archive::Tar to extract, create and list tar archives.
+
+Options:
+    x   Extract from ARCHIVE_FILE
+    c   Create ARCHIVE_FILE from FILE
+    t   List the contents of ARCHIVE_FILE
+    f   Name of the ARCHIVE_FILE to use. Default is './default.tar'
+    z   Read/Write zlib compressed ARCHIVE_FILE (not always available)
+    v   Print filenames as they are added or extraced from ARCHIVE_FILE
+    h   Prints this help message
+
+See Also:
+    tar(1)
+    Archive::Tar
+
+    \n]
+}
+
+=head1 NAME
+
+ptar - a tar-like program written in perl
+
+=head1 DESCRIPTION
+
+ptar is a small, tar look-alike program that uses the perl module
+Archive::Tar to extract, create and list tar archives.
+
+=head1 SYNOPSIS
+
+    ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
+    ptar -x [-v] [-z] [-f ARCHIVE_FILE]
+    ptar -t [-z] [-f ARCHIVE_FILE]
+    ptar -h
+
+=head1 OPTIONS
+
+    x   Extract from ARCHIVE_FILE
+    c   Create ARCHIVE_FILE from FILE
+    t   List the contents of ARCHIVE_FILE
+    f   Name of the ARCHIVE_FILE to use. Default is './default.tar'
+    z   Read/Write zlib compressed ARCHIVE_FILE (not always available)
+    v   Print filenames as they are added or extraced from ARCHIVE_FILE
+    h   Prints this help message
+
+=head1 SEE ALSO
+
+tar(1), L<Archive::Tar>.
+
+=cut

Perl/bin/ptar.bat

@@ -0,0 +1,121 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl
+#line 15
+use strict;
+
+use Getopt::Std;
+use Archive::Tar;
+use File::Find;
+
+my $opts = {};
+getopts('dcvzthxf:', $opts) or die usage();
+
+### show the help message ###
+die usage() if $opts->{h};
+
+### enable debugging (undocumented feature)
+local $Archive::Tar::DEBUG = 1 if $opts->{d};
+
+### sanity checks ###
+unless ( 1 == grep { defined $opts->{$_} } qw[x t c] ) {
+    die "You need exactly one of 'x', 't' or 'c' options: " . usage();
+}
+
+my $compress    = $opts->{z} ? 1 : 0;
+my $verbose     = $opts->{v} ? 1 : 0;
+my $file        = $opts->{f} ? $opts->{f} : 'default.tar';
+my $tar         = Archive::Tar->new();
+
+if( $opts->{c} ) {
+    my @files;
+    find( sub { push @files, $File::Find::name;
+                print $File::Find::name.$/ if $verbose }, @ARGV );
+
+    Archive::Tar->create_archive( $file, $compress, @files );
+    exit;
+}
+
+my $tar = Archive::Tar->new($file, $compress);
+
+if( $opts->{t} ) {
+    print map { $_->full_path . $/ } $tar->get_files;
+
+} elsif( $opts->{x} ) {
+    print map { $_->full_path . $/ } $tar->get_files
+        if $verbose;
+    Archive::Tar->extract_archive($file, $compress);
+}
+
+
+
+sub usage {
+    qq[
+Usage:  ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
+        ptar -x [-v] [-z] [-f ARCHIVE_FILE]
+        ptar -t [-z] [-f ARCHIVE_FILE]
+        ptar -h
+
+    ptar is a small, tar look-alike program that uses the perl module
+    Archive::Tar to extract, create and list tar archives.
+
+Options:
+    x   Extract from ARCHIVE_FILE
+    c   Create ARCHIVE_FILE from FILE
+    t   List the contents of ARCHIVE_FILE
+    f   Name of the ARCHIVE_FILE to use. Default is './default.tar'
+    z   Read/Write zlib compressed ARCHIVE_FILE (not always available)
+    v   Print filenames as they are added or extraced from ARCHIVE_FILE
+    h   Prints this help message
+
+See Also:
+    tar(1)
+    Archive::Tar
+
+    \n]
+}
+
+=head1 NAME
+
+ptar - a tar-like program written in perl
+
+=head1 DESCRIPTION
+
+ptar is a small, tar look-alike program that uses the perl module
+Archive::Tar to extract, create and list tar archives.
+
+=head1 SYNOPSIS
+
+    ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
+    ptar -x [-v] [-z] [-f ARCHIVE_FILE]
+    ptar -t [-z] [-f ARCHIVE_FILE]
+    ptar -h
+
+=head1 OPTIONS
+
+    x   Extract from ARCHIVE_FILE
+    c   Create ARCHIVE_FILE from FILE
+    t   List the contents of ARCHIVE_FILE
+    f   Name of the ARCHIVE_FILE to use. Default is './default.tar'
+    z   Read/Write zlib compressed ARCHIVE_FILE (not always available)
+    v   Print filenames as they are added or extraced from ARCHIVE_FILE
+    h   Prints this help message
+
+=head1 SEE ALSO
+
+tar(1), L<Archive::Tar>.
+
+=cut
+
+__END__
+:endofperl

Perl/bin/ptardiff

@@ -0,0 +1,112 @@
+#!/usr/bin/perl
+
+use strict;
+use Archive::Tar;
+use Getopt::Std;
+
+my $opts = {};
+getopts('h:', $opts) or die usage();
+
+die usages() if $opts->{h};
+
+### need Text::Diff -- give a polite error (not a standard prereq)
+unless ( eval { require Text::Diff; Text::Diff->import; 1 } ) {
+    die "\n\t This tool requires the 'Text::Diff' module to be installed\n";
+}
+
+my $arch = shift                        or die usage();
+my $tar  = Archive::Tar->new( $arch )   or die "Couldn't read '$arch': $!";
+
+
+foreach my $file ( $tar->get_files ) {
+    next unless $file->is_file;
+    my $name = $file->name;
+    
+    diff(   \($file->get_content), $name, 
+            {   FILENAME_A  => $name,
+                MTIME_A     => $file->mtime,
+                OUTPUT      => \*STDOUT
+            } 
+    );
+}
+
+
+
+
+sub usage {
+    return q[
+
+Usage:  ptardiff ARCHIVE_FILE
+        ptardiff -h
+    
+    ptardiff is a small program that diffs an extracted archive
+    against an unextracted one, using the perl module Archive::Tar.
+    
+    This effectively lets you view changes made to an archives contents. 
+    
+    Provide the progam with an ARCHIVE_FILE and it will look up all
+    the files with in the archive, scan the current working directory
+    for a file with the name and diff it against the contents of the
+    archive.
+
+    
+Options:
+    h   Prints this help message
+
+
+Sample Usage:
+
+    $ tar -xzf Acme-Buffy-1.3.tar.gz 
+    $ vi Acme-Buffy-1.3/README
+    
+    [...]
+
+    $ ptardiff Acme-Buffy-1.3.tar.gz > README.patch
+
+
+See Also:
+    tar(1)
+    ptar
+    Archive::Tar
+
+    ] . $/;
+}    
+
+
+
+=head1 NAME
+
+ptardiff - program that diffs an extracted archive against an unextracted one
+
+=head1 DESCRIPTION
+
+    ptardiff is a small program that diffs an extracted archive
+    against an unextracted one, using the perl module Archive::Tar.
+    
+    This effectively lets you view changes made to an archives contents. 
+    
+    Provide the progam with an ARCHIVE_FILE and it will look up all
+    the files with in the archive, scan the current working directory
+    for a file with the name and diff it against the contents of the
+    archive.
+
+=head1 SYNOPSIS
+
+    ptardiff ARCHIVE_FILE
+    ptardiff -h
+
+    $ tar -xzf Acme-Buffy-1.3.tar.gz 
+    $ vi Acme-Buffy-1.3/README
+    [...]
+    $ ptardiff Acme-Buffy-1.3.tar.gz > README.patch
+
+
+=head1 OPTIONS
+
+    h   Prints this help message
+
+=head1 SEE ALSO
+
+tar(1), L<Archive::Tar>.
+
+=cut

Perl/bin/ptardiff.bat

@@ -0,0 +1,128 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl
+#line 15
+
+use strict;
+use Archive::Tar;
+use Getopt::Std;
+
+my $opts = {};
+getopts('h:', $opts) or die usage();
+
+die usages() if $opts->{h};
+
+### need Text::Diff -- give a polite error (not a standard prereq)
+unless ( eval { require Text::Diff; Text::Diff->import; 1 } ) {
+    die "\n\t This tool requires the 'Text::Diff' module to be installed\n";
+}
+
+my $arch = shift                        or die usage();
+my $tar  = Archive::Tar->new( $arch )   or die "Couldn't read '$arch': $!";
+
+
+foreach my $file ( $tar->get_files ) {
+    next unless $file->is_file;
+    my $name = $file->name;
+    
+    diff(   \($file->get_content), $name, 
+            {   FILENAME_A  => $name,
+                MTIME_A     => $file->mtime,
+                OUTPUT      => \*STDOUT
+            } 
+    );
+}
+
+
+
+
+sub usage {
+    return q[
+
+Usage:  ptardiff ARCHIVE_FILE
+        ptardiff -h
+    
+    ptardiff is a small program that diffs an extracted archive
+    against an unextracted one, using the perl module Archive::Tar.
+    
+    This effectively lets you view changes made to an archives contents. 
+    
+    Provide the progam with an ARCHIVE_FILE and it will look up all
+    the files with in the archive, scan the current working directory
+    for a file with the name and diff it against the contents of the
+    archive.
+
+    
+Options:
+    h   Prints this help message
+
+
+Sample Usage:
+
+    $ tar -xzf Acme-Buffy-1.3.tar.gz 
+    $ vi Acme-Buffy-1.3/README
+    
+    [...]
+
+    $ ptardiff Acme-Buffy-1.3.tar.gz > README.patch
+
+
+See Also:
+    tar(1)
+    ptar
+    Archive::Tar
+
+    ] . $/;
+}    
+
+
+
+=head1 NAME
+
+ptardiff - program that diffs an extracted archive against an unextracted one
+
+=head1 DESCRIPTION
+
+    ptardiff is a small program that diffs an extracted archive
+    against an unextracted one, using the perl module Archive::Tar.
+    
+    This effectively lets you view changes made to an archives contents. 
+    
+    Provide the progam with an ARCHIVE_FILE and it will look up all
+    the files with in the archive, scan the current working directory
+    for a file with the name and diff it against the contents of the
+    archive.
+
+=head1 SYNOPSIS
+
+    ptardiff ARCHIVE_FILE
+    ptardiff -h
+
+    $ tar -xzf Acme-Buffy-1.3.tar.gz 
+    $ vi Acme-Buffy-1.3/README
+    [...]
+    $ ptardiff Acme-Buffy-1.3.tar.gz > README.patch
+
+
+=head1 OPTIONS
+
+    h   Prints this help message
+
+=head1 SEE ALSO
+
+tar(1), L<Archive::Tar>.
+
+=cut
+
+__END__
+:endofperl

Perl/bin/ptked

@@ -0,0 +1,345 @@
+#!/usr/local/bin/perl -w
+use strict;
+use Socket;
+use IO::Socket;
+use Cwd;
+use Getopt::Long;
+
+use vars qw($VERSION $portfile);
+$VERSION = sprintf '4.%03d', q$Revision: #29 $ =~ /\D(\d+)\s*$/;
+
+my %opt;
+INIT
+ {
+  my $home = $ENV{'HOME'} || $ENV{'HOMEDRIVE'}.$ENV{'HOMEPATH'};
+  $portfile = "$home/.ptkedsn";
+  my $port = $ENV{'PTKEDPORT'};
+  return if $^C;
+  GetOptions(\%opt,qw(server! encoding=s));
+  unless (defined $port)
+   {
+    if (open(SN,"$portfile"))
+     {
+      $port = <SN>;
+      close(SN);
+     }
+   }
+  if (defined $port)
+   {
+    my $sock = IO::Socket::INET->new(PeerAddr => 'localhost',
+               PeerPort => $port, Proto    => 'tcp');
+    if ($sock)
+     {
+      binmode($sock);
+      $sock->autoflush;
+      foreach my $file (@ARGV)
+       {
+        unless  (print $sock "$file\n")
+         {
+          die "Cannot print $file to socket:$!";
+         }
+        print "Requested '$file'\n";
+       }
+      $sock->close || die "Cannot close socket:$!";
+      exit(0);
+     }
+    else
+     {
+      warn "Cannot connect to server on $port:$!";
+     }
+   }
+ }
+
+use Tk;
+use Tk::DropSite qw(XDND Sun);
+use Tk::DragDrop qw(XDND Sun);
+use Tk::widgets qw(TextUndo Scrollbar Menu Dialog);
+# use Tk::ErrorDialog;
+
+{
+ package Tk::TextUndoPtked;
+ @Tk::TextUndoPtked::ISA = qw(Tk::TextUndo);
+ Construct Tk::Widget 'TextUndoPtked';
+
+ sub Save {
+  my $w = shift;
+  $w->SUPER::Save(@_);
+  $w->toplevel->title($w->FileName);
+ }
+
+ sub Load {
+  my $w = shift;
+  $w->SUPER::Load(@_);
+  $w->toplevel->title($w->FileName);
+ }
+
+ sub MenuLabels { shift->SUPER::MenuLabels, 'Encoding' }
+
+ sub Encoding
+ {
+  my ($w,$enc) = @_;
+  if (@_ > 1)
+   {
+    $enc = $w->getEncoding($enc) unless ref($enc);
+    $w->{ENCODING} = $enc;
+    $enc = $enc->name;
+    $w->PerlIO_layers(":encoding($enc)");
+   }
+  return $w->{ENCODING};
+ }
+
+ sub EncodingMenuItems
+ {
+  my ($w) = @_;
+  return [ [ command => 'System', -command => [ $w, Encoding => Tk::SystemEncoding()->name ]],
+           [ command => 'UTF-8',  -command => [ $w, Encoding => 'UTF-8'] ],
+           [ command => 'iso-8859-1', -command => [ $w, Encoding => 'iso8859-1'] ],
+           [ command => 'iso-8859-15', -command => [ $w, Encoding => 'iso8859-15'] ],
+         ];
+
+ }
+
+}
+
+my $top = MainWindow->new();
+
+if ($opt{'server'})
+ {
+  my $sock = IO::Socket::INET->new(Listen => 5, Proto => 'tcp');
+  die "Cannot open listen socket:$!" unless defined $sock;
+  binmode($sock);
+
+  my $port = $sock->sockport;
+  $ENV{'PTKEDPORT'} = $port;
+  open(SN,">$portfile") || die "Cannot open $portfile:$!";
+  print SN $port;
+  close(SN);
+  print "Accepting connections on $port\n";
+  $top->fileevent($sock,'readable',
+  sub
+  {
+   print "accepting $sock\n";
+   my $client = $sock->accept;
+   if (defined $client)
+    {
+     binmode($client);
+     print "Connection $client\n";
+     $top->fileevent($client,'readable',[\&EditRequest,$client]);
+    }
+   });
+ }
+
+Tk::Event::HandleSignals();
+$SIG{'INT'} = sub { $top->WmDeleteWindow };
+
+$top->iconify;
+$top->optionAdd('*TextUndoPtked.Background' => '#fff5e1');
+$top->fontCreate('ptked',-family => 'courier', -size => ($^O eq 'MSWin32' ? 11 : -12),
+                 -weight => 'normal', -slant => 'roman');
+$top->optionAdd('*TextUndoPtked.Font' => 'ptked');
+
+foreach my $file (@ARGV)
+ {
+  Create_Edit($file);
+ }
+
+
+sub EditRequest
+{
+ my ($client) = @_;
+ local $_;
+ while (<$client>)
+  {
+   chomp($_);
+   print "'$_'\n",
+   Create_Edit($_);
+  }
+ warn "Odd $!" unless eof($client);
+ $top->fileevent($client,'readable','');
+ print "Close $client\n";
+ $client->close;
+}
+
+MainLoop;
+unlink("$portfile");
+exit(0);
+
+sub Create_Edit
+{
+ my $path = shift;
+ my $ed   = $top->Toplevel(-title => $path);
+ $ed->withdraw;
+ $top->{'Edits'}++;
+ $ed->OnDestroy([\&RemoveEdit,$top]);
+ my $t = $ed->Scrolled('TextUndoPtked', -wrap => 'none',
+           -scrollbars => 'se', # both required till optional fixed!
+         );
+ $t->pack(-expand => 1, -fill => 'both');
+ $t = $t->Subwidget('scrolled');
+
+ $t->Encoding($opt{encoding}) if $opt{encoding};
+
+ my $menu = $t->menu;
+ $menu->cascade(-label => '~Help', -menuitems => [
+                [Button => '~About...', -command => [\&About,$ed]],
+               ]);
+ $ed->configure(-menu => $menu);
+ my $dd = $t->DragDrop(-event => '<Meta-B1-Motion>');
+ $t->bind(ref($t),'<Meta-B1-Motion>',\&Ouch);
+ $t->bind(ref($t),'<Meta-ButtonPress>',\&Ouch);
+ $t->bind(ref($t),'<Meta-ButtonRelease>',\&Ouch);
+ $dd->configure(-startcommand =>
+                sub
+                 {
+                  return 1 unless (eval { $t->tagNextrange(sel => '1.0','end')});
+                  $dd->configure(-text => $t->get('sel.first','sel.last'));
+                 });
+
+ $t->DropSite(-motioncommand =>
+               sub
+                { my ($x,$y) = @_;
+                  $t->markSet(insert => "\@$x,$y");
+                },
+               -dropcommand => [\&HandleDrop,$t],
+              );
+
+
+
+ $ed->protocol('WM_DELETE_WINDOW',[ConfirmExit => $t]);
+ $t->bind('<F3>',\&DoFind);
+
+ $ed->idletasks;
+ if (-e $path)
+  {
+   $t->Load($path);
+  }
+ else
+  {
+   $t->FileName($path);
+  }
+ $ed->deiconify;
+ $t->update;
+ $t->focus;
+}
+
+sub Ouch
+{
+ warn join(',','Ouch',@_);
+}
+
+sub RemoveEdit
+{
+ my $top = shift;
+ if (--$top->{'Edits'} == 0)
+  {
+   $top->destroy unless $opt{'s'};
+  }
+}
+
+sub HandleDrop
+{my ($t,$seln,$x,$y) = @_;
+ # warn join(',',Drop => @_);
+ my $string;
+ Tk::catch { $string = $t->SelectionGet(-selection => $seln,'FILE_NAME') };
+ if ($@)
+  {
+   Tk::catch { $string = $t->SelectionGet(-selection => $seln) };
+   if ($@)
+    {
+     my @targets = $t->SelectionGet(-selection => $seln, 'TARGETS');
+     $t->messageBox(-text => "Targets : ".join(' ',@targets));
+    }
+   else
+    {
+     $t->markSet(insert => "\@$x,$y");
+     $t->insert(insert => $string);
+    }
+  }
+ else
+  {
+   Create_Edit($string);
+  }
+}
+
+
+my $str;
+
+sub DoFind
+{
+ my $t = shift;
+ $str = shift if (@_);
+ my $posn = $t->index('insert+1c');
+ $t->tag('remove','sel','1.0','end');
+ local $_;
+ while ($t->compare($posn,'<','end'))
+  {
+   my ($line,$col) = split(/\./,$posn);
+   $_ = $t->get("$line.0","$posn lineend");
+   pos($_) = $col;
+   if (/\G(.*)$str/g)
+    {
+     $col += length($1);
+     $posn = "$line.$col";
+     $t->SetCursor($posn);
+     $t->tag('add','sel',$posn,"$line.".pos($_));
+     $t->focus;
+     return;
+    }
+   $posn = $t->index("$posn lineend + 1c");
+  }
+}
+
+sub AskFind
+{
+ my ($t) = @_;
+ unless (exists $t->{'AskFind'})
+  {
+   my $d = $t->{'AskFind'} = $t->Toplevel(-popover => 'cursor', -popanchor => 'nw');
+   $d->title('Find...');
+   $d->withdraw;
+   $d->transient($t->toplevel);
+   my $e = $d->Entry->pack;
+   $e->bind('<Return>', sub { $d->withdraw; DoFind($t,$e->get); });
+   $d->protocol(WM_DELETE_WINDOW =>[withdraw => $d]);
+  }
+ $t->{'AskFind'}->Popup;
+ $t->update;
+ $t->{'AskFind'}->focusNext;
+}
+
+sub About
+{
+ my $mw = shift;
+
+ $mw->Dialog(-text => <<"END",-popover => $mw)->Show;
+$0 version $VERSION
+perl$]/Tk$Tk::VERSION
+
+Copyright <20> 1995-2004 Nick Ing-Simmons. All rights reserved.
+This package is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+END
+}
+
+__END__
+
+=head1 NAME
+
+ptked - an editor in Perl/Tk
+
+=head1 SYNOPSIS
+
+S<  >B<ptked> [I<file-to-edit>]
+
+=head1 DESCRIPTION
+
+B<ptked> is a simple text editor based on perl/Tk's TextUndo widget.
+
+=cut
+
+
+
+
+
+
+

Perl/bin/ptked.bat

@@ -0,0 +1,361 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/local/bin/perl -w
+#line 15
+use strict;
+use Socket;
+use IO::Socket;
+use Cwd;
+use Getopt::Long;
+
+use vars qw($VERSION $portfile);
+$VERSION = sprintf '4.%03d', q$Revision: #29 $ =~ /\D(\d+)\s*$/;
+
+my %opt;
+INIT
+ {
+  my $home = $ENV{'HOME'} || $ENV{'HOMEDRIVE'}.$ENV{'HOMEPATH'};
+  $portfile = "$home/.ptkedsn";
+  my $port = $ENV{'PTKEDPORT'};
+  return if $^C;
+  GetOptions(\%opt,qw(server! encoding=s));
+  unless (defined $port)
+   {
+    if (open(SN,"$portfile"))
+     {
+      $port = <SN>;
+      close(SN);
+     }
+   }
+  if (defined $port)
+   {
+    my $sock = IO::Socket::INET->new(PeerAddr => 'localhost',
+               PeerPort => $port, Proto    => 'tcp');
+    if ($sock)
+     {
+      binmode($sock);
+      $sock->autoflush;
+      foreach my $file (@ARGV)
+       {
+        unless  (print $sock "$file\n")
+         {
+          die "Cannot print $file to socket:$!";
+         }
+        print "Requested '$file'\n";
+       }
+      $sock->close || die "Cannot close socket:$!";
+      exit(0);
+     }
+    else
+     {
+      warn "Cannot connect to server on $port:$!";
+     }
+   }
+ }
+
+use Tk;
+use Tk::DropSite qw(XDND Sun);
+use Tk::DragDrop qw(XDND Sun);
+use Tk::widgets qw(TextUndo Scrollbar Menu Dialog);
+# use Tk::ErrorDialog;
+
+{
+ package Tk::TextUndoPtked;
+ @Tk::TextUndoPtked::ISA = qw(Tk::TextUndo);
+ Construct Tk::Widget 'TextUndoPtked';
+
+ sub Save {
+  my $w = shift;
+  $w->SUPER::Save(@_);
+  $w->toplevel->title($w->FileName);
+ }
+
+ sub Load {
+  my $w = shift;
+  $w->SUPER::Load(@_);
+  $w->toplevel->title($w->FileName);
+ }
+
+ sub MenuLabels { shift->SUPER::MenuLabels, 'Encoding' }
+
+ sub Encoding
+ {
+  my ($w,$enc) = @_;
+  if (@_ > 1)
+   {
+    $enc = $w->getEncoding($enc) unless ref($enc);
+    $w->{ENCODING} = $enc;
+    $enc = $enc->name;
+    $w->PerlIO_layers(":encoding($enc)");
+   }
+  return $w->{ENCODING};
+ }
+
+ sub EncodingMenuItems
+ {
+  my ($w) = @_;
+  return [ [ command => 'System', -command => [ $w, Encoding => Tk::SystemEncoding()->name ]],
+           [ command => 'UTF-8',  -command => [ $w, Encoding => 'UTF-8'] ],
+           [ command => 'iso-8859-1', -command => [ $w, Encoding => 'iso8859-1'] ],
+           [ command => 'iso-8859-15', -command => [ $w, Encoding => 'iso8859-15'] ],
+         ];
+
+ }
+
+}
+
+my $top = MainWindow->new();
+
+if ($opt{'server'})
+ {
+  my $sock = IO::Socket::INET->new(Listen => 5, Proto => 'tcp');
+  die "Cannot open listen socket:$!" unless defined $sock;
+  binmode($sock);
+
+  my $port = $sock->sockport;
+  $ENV{'PTKEDPORT'} = $port;
+  open(SN,">$portfile") || die "Cannot open $portfile:$!";
+  print SN $port;
+  close(SN);
+  print "Accepting connections on $port\n";
+  $top->fileevent($sock,'readable',
+  sub
+  {
+   print "accepting $sock\n";
+   my $client = $sock->accept;
+   if (defined $client)
+    {
+     binmode($client);
+     print "Connection $client\n";
+     $top->fileevent($client,'readable',[\&EditRequest,$client]);
+    }
+   });
+ }
+
+Tk::Event::HandleSignals();
+$SIG{'INT'} = sub { $top->WmDeleteWindow };
+
+$top->iconify;
+$top->optionAdd('*TextUndoPtked.Background' => '#fff5e1');
+$top->fontCreate('ptked',-family => 'courier', -size => ($^O eq 'MSWin32' ? 11 : -12),
+                 -weight => 'normal', -slant => 'roman');
+$top->optionAdd('*TextUndoPtked.Font' => 'ptked');
+
+foreach my $file (@ARGV)
+ {
+  Create_Edit($file);
+ }
+
+
+sub EditRequest
+{
+ my ($client) = @_;
+ local $_;
+ while (<$client>)
+  {
+   chomp($_);
+   print "'$_'\n",
+   Create_Edit($_);
+  }
+ warn "Odd $!" unless eof($client);
+ $top->fileevent($client,'readable','');
+ print "Close $client\n";
+ $client->close;
+}
+
+MainLoop;
+unlink("$portfile");
+exit(0);
+
+sub Create_Edit
+{
+ my $path = shift;
+ my $ed   = $top->Toplevel(-title => $path);
+ $ed->withdraw;
+ $top->{'Edits'}++;
+ $ed->OnDestroy([\&RemoveEdit,$top]);
+ my $t = $ed->Scrolled('TextUndoPtked', -wrap => 'none',
+           -scrollbars => 'se', # both required till optional fixed!
+         );
+ $t->pack(-expand => 1, -fill => 'both');
+ $t = $t->Subwidget('scrolled');
+
+ $t->Encoding($opt{encoding}) if $opt{encoding};
+
+ my $menu = $t->menu;
+ $menu->cascade(-label => '~Help', -menuitems => [
+                [Button => '~About...', -command => [\&About,$ed]],
+               ]);
+ $ed->configure(-menu => $menu);
+ my $dd = $t->DragDrop(-event => '<Meta-B1-Motion>');
+ $t->bind(ref($t),'<Meta-B1-Motion>',\&Ouch);
+ $t->bind(ref($t),'<Meta-ButtonPress>',\&Ouch);
+ $t->bind(ref($t),'<Meta-ButtonRelease>',\&Ouch);
+ $dd->configure(-startcommand =>
+                sub
+                 {
+                  return 1 unless (eval { $t->tagNextrange(sel => '1.0','end')});
+                  $dd->configure(-text => $t->get('sel.first','sel.last'));
+                 });
+
+ $t->DropSite(-motioncommand =>
+               sub
+                { my ($x,$y) = @_;
+                  $t->markSet(insert => "\@$x,$y");
+                },
+               -dropcommand => [\&HandleDrop,$t],
+              );
+
+
+
+ $ed->protocol('WM_DELETE_WINDOW',[ConfirmExit => $t]);
+ $t->bind('<F3>',\&DoFind);
+
+ $ed->idletasks;
+ if (-e $path)
+  {
+   $t->Load($path);
+  }
+ else
+  {
+   $t->FileName($path);
+  }
+ $ed->deiconify;
+ $t->update;
+ $t->focus;
+}
+
+sub Ouch
+{
+ warn join(',','Ouch',@_);
+}
+
+sub RemoveEdit
+{
+ my $top = shift;
+ if (--$top->{'Edits'} == 0)
+  {
+   $top->destroy unless $opt{'s'};
+  }
+}
+
+sub HandleDrop
+{my ($t,$seln,$x,$y) = @_;
+ # warn join(',',Drop => @_);
+ my $string;
+ Tk::catch { $string = $t->SelectionGet(-selection => $seln,'FILE_NAME') };
+ if ($@)
+  {
+   Tk::catch { $string = $t->SelectionGet(-selection => $seln) };
+   if ($@)
+    {
+     my @targets = $t->SelectionGet(-selection => $seln, 'TARGETS');
+     $t->messageBox(-text => "Targets : ".join(' ',@targets));
+    }
+   else
+    {
+     $t->markSet(insert => "\@$x,$y");
+     $t->insert(insert => $string);
+    }
+  }
+ else
+  {
+   Create_Edit($string);
+  }
+}
+
+
+my $str;
+
+sub DoFind
+{
+ my $t = shift;
+ $str = shift if (@_);
+ my $posn = $t->index('insert+1c');
+ $t->tag('remove','sel','1.0','end');
+ local $_;
+ while ($t->compare($posn,'<','end'))
+  {
+   my ($line,$col) = split(/\./,$posn);
+   $_ = $t->get("$line.0","$posn lineend");
+   pos($_) = $col;
+   if (/\G(.*)$str/g)
+    {
+     $col += length($1);
+     $posn = "$line.$col";
+     $t->SetCursor($posn);
+     $t->tag('add','sel',$posn,"$line.".pos($_));
+     $t->focus;
+     return;
+    }
+   $posn = $t->index("$posn lineend + 1c");
+  }
+}
+
+sub AskFind
+{
+ my ($t) = @_;
+ unless (exists $t->{'AskFind'})
+  {
+   my $d = $t->{'AskFind'} = $t->Toplevel(-popover => 'cursor', -popanchor => 'nw');
+   $d->title('Find...');
+   $d->withdraw;
+   $d->transient($t->toplevel);
+   my $e = $d->Entry->pack;
+   $e->bind('<Return>', sub { $d->withdraw; DoFind($t,$e->get); });
+   $d->protocol(WM_DELETE_WINDOW =>[withdraw => $d]);
+  }
+ $t->{'AskFind'}->Popup;
+ $t->update;
+ $t->{'AskFind'}->focusNext;
+}
+
+sub About
+{
+ my $mw = shift;
+
+ $mw->Dialog(-text => <<"END",-popover => $mw)->Show;
+$0 version $VERSION
+perl$]/Tk$Tk::VERSION
+
+Copyright <20> 1995-2004 Nick Ing-Simmons. All rights reserved.
+This package is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+END
+}
+
+__END__
+
+=head1 NAME
+
+ptked - an editor in Perl/Tk
+
+=head1 SYNOPSIS
+
+S<  >B<ptked> [I<file-to-edit>]
+
+=head1 DESCRIPTION
+
+B<ptked> is a simple text editor based on perl/Tk's TextUndo widget.
+
+=cut
+
+
+
+
+
+
+
+
+__END__
+:endofperl

Perl/bin/ptksh

@@ -0,0 +1,706 @@
+#!perl -w
+#
+# PTKSH 2.0
+#
+# A graphical user interface for testing Perl/Tk commands and scripts.
+#
+# VERSION HISTORY:
+# ...truncated earlier stuff...
+# 4/23/98  V1.7    Achim Bohnet  -- some fixes to "o" command
+# 6/08/98  V2.01  M. Beller -- merge in GUI code for "wish"-like interface
+#
+# 2.01d1 6/6/98 First development version
+#
+# 2.01d2 6/7/98
+#  - apply A.B. patch for pod and -option
+#  - fix "use of uninitialized variable" in END{ } block (for -c option)
+#  - support h and ? only for help
+#  - misc. pod fixes (PITFALLS)
+#  - use default fonts and default colors  ## NOT YET--still working on it
+#  - get rid of Data::Dumper for history
+#
+# 2.01d3 6/8/98
+#  - Remove "use Data::Dumper" line
+#  - Put in hack for unix vs. win32 window manager focus problem
+#  - Achim's pod and histfile patch
+#
+# 2.01d4 6/18/98
+#  - Slaven's patch to make <Home> work properly
+#  - Add help message to banner (per Steve Lydie)
+#  - Fix horizontal scrolling (turn off wrapping in console window)
+#  - Clarify <Up> in docs and help means "up arrow"
+#  - Use HOMEDRIVE/HOMEPATH on Win32
+#
+
+=head1 NAME
+
+ptksh - Perl/Tk script to provide a graphical user interface for testing Perl/Tk
+commands and scripts.
+
+=head1 SYNOPSIS
+
+  % ptksh  ?scriptfile?
+  ... version information ...
+  ptksh> $b=$mw->Button(-text=>'Hi',-command=>sub{print 'Hi'})
+  ptksh> $b->pack
+  ptksh> o $b
+  ... list of options ...
+  ptksh> help
+  ... help information ...
+  ptksh> exit
+  %
+
+
+=head1 DESCRIPTION
+
+ptksh is a perl/Tk shell to enter perl commands
+interactively.  When one starts ptksh a L<MainWindow|Tk::MainWindow>
+is automaticly created, along with a ptksh command window.
+One can access the main window by typing commands using the
+variable $mw at the 'ptksh> ' prompt of the command window.
+
+ptksh supports command line editing and history.  Just type "<Up>" at
+the command prompt to see a history list.  The last 50 commands entered
+are saved, then reloaded into history list the next time you start ptksh.
+
+ptksh supports some convenient commands for inspecting Tk widgets.  See below.
+
+To exit ptksh use: C<exit>.
+
+ptksh is B<*not*> a full symbolic debugger.
+To debug perl/Tk programs at a low level use the more powerful
+L<perl debugger|perldebug>.  (Just enter ``O tk'' on debuggers
+command line to start the Tk eventloop.)
+
+=head1 FEATURES
+
+=head2 History
+
+Press <Up> (the Up Arrow) in the perlwish window to obtain a gui-based history list.
+Press <Enter> on any history line to enter it into the perlwish window.
+Then hit return.  So, for example, repeat last command is <Up><Enter><Enter>.
+You can quit the history window with <Escape>.  NOTE: history is only saved
+if exit is "graceful" (i.e. by the "exit" command from the console or by
+quitting all main windows--NOT by interrupt).
+
+=head2 Debugging Support
+
+ptksh provides some convenience function to make browsing
+in perl/Tk widget easier:
+
+=over 4
+
+=item B<?>, or B<h>
+
+displays a short help summary.
+
+=item B<d> ?I<args>, ...?
+
+Dumps recursively arguments to stdout. (see L<Data::Dumper>).
+You must have <Data::Dumper> installed to support this feature.
+
+=item B<p> ?I<arg>, ...?
+
+appends "|\n" to each of it's arguments and prints it.
+If value is B<undef>, '(undef)' is printed to stdout.
+
+=item B<o> I<$widget> ?I<-option> ...?
+
+prints the option(s) of I<$widget> one on each line.
+If no options are given all options of the widget are
+listed.  See L<Tk::options> for more details on the
+format and contents of the returned list.
+
+=item B<o> I<$widget> B</>I<regexp>B</>
+
+Lists options of I<$widget> matching the
+L<regular expression|perlre> I<regexp>.
+
+=item B<u> ?I<class>?
+
+If no argument is given it lists the modules loaded
+by the commands you executed or since the last time you
+called C<u>.
+
+If argument is the empty string lists all modules that are
+loaded by ptksh.
+
+If argument is a string, ``text'' it tries to do a ``use Tk::Text;''.
+
+=back
+
+=head2 Packages
+
+Ptksh compiles into package Tk::ptksh.  Your code is eval'ed into package
+main.  The coolness of this is that your eval code should not interfere with
+ptksh itself.
+
+=head2 Multiline Commands
+
+ptksh will accept multiline commands.  Simply put a "\" character immediately
+before the newline, and ptksh will continue your command onto the next line.
+
+=head2 Source File Support
+
+If you have a perl/Tk script that you want to do debugging on, try running the
+command
+
+  ptksh> do 'myscript';
+
+   -- or  (at shell command prompt) --
+
+  % ptksh myscript
+
+Then use the perl/Tk commands to try out different operations on your script.
+
+=head1 ENVIRONMENT
+
+Looks for your .ptksh_history in the directory specified by
+the $HOME environment variable ($HOMEPATH on Win32 systems).
+
+=head1 FILES
+
+=over 4
+
+=item F<.ptksh_init>
+
+If found in current directory it is read in an evaluated
+after the mainwindow I<$mw> is created. F<.ptksh_init>
+can contain any valid perl code.
+
+=item F<~/.ptksh_history>
+
+Contains the last 50 lines entered in ptksh session(s).
+
+=back
+
+=head1 PITFALLS
+
+It is best not to use "my" in the commands you type into ptksh.
+For example "my $v" will make $v local just to the command or commands
+entered until <Return> is pressed.
+For a related reason, there are no file-scopy "my" variables in the
+ptksh code itself (else the user might trounce on them by accident).
+
+=head1 BUGS
+
+B<Tk::MainLoop> function interactively entered or sourced in a
+init or script file will block ptksh.
+
+=head1 SEE ALSO
+
+L<Tk|Tk>
+L<perldebug|perldebug>
+
+=head1 VERSION
+
+VERSION 2.02
+
+=head1 AUTHORS
+
+Mike Beller <beller@penvision.com>,
+Achim Bohnet <ach@mpe.mpg.de>
+
+Copyright (c) 1996 - 1998 Achim Bohnet and Mike Beller. All rights reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+package Tk::ptksh;
+require 5.004;
+use strict;
+use Tk;
+
+##### Constants
+
+use vars qw($NAME $VERSION $FONT @FONT $WIN32 $HOME $HISTFILE $HISTSAVE $PROMPT $INITFILE);
+
+$NAME = 'ptksh';
+$VERSION = '2.02';
+$WIN32 = 1 if $^O =~ /Win32/;
+$HOME = $WIN32 ? ($ENV{HOMEDRIVE} . $ENV{HOMEPATH}) || 'C:\\' : $ENV{HOME} . "/";
+@FONT = ($WIN32 ? (-font => 'systemfixed') : () );
+#@FONT = ($WIN32 ? (-font => ['courier', 9, 'normal']) : () );
+$HISTFILE = "${HOME}.${NAME}_history";
+$HISTSAVE = 50;
+$INITFILE = ".${NAME}_init";
+$PROMPT = "$NAME> ";
+
+sub Win32Fix { my $p = shift; $p =~ s'\\'/'g; $p =~ s'/$''; return $p }
+
+use vars qw($mw $st $t @hist $hist $list $isStartOfCommand);
+
+# NOTE: mainwindow creation order seems to impact who gets focus, and
+# order is different on Win32 & *nix!!  So hack is to create the windows
+# in an order dependent on the OS!
+
+$mw = Tk::MainWindow->new unless $WIN32;  # &&& hack to work around focus problem
+
+##### set up user's main window
+package main;
+$main::mw = Tk::MainWindow->new;
+$main::mw->title('$mw');
+$main::mw->geometry("+1+1");
+package Tk::ptksh;
+
+##### Set up ptksh windows
+$mw = Tk::MainWindow->new if $WIN32;  # &&& hack to work around focus problem
+$mw->title($NAME);
+$st = $mw->Scrolled('Text', -scrollbars => 'osoe',
+				-wrap => 'none',
+				-width => 80, -height => 25, @FONT);
+$t = $st->Subwidget('scrolled');
+$st->pack(-fill => 'both', -expand => 'true');
+$mw->bind('<Map>', sub {Center($mw);} );
+
+# Event bindings
+$t->bindtags([$t, ref($t), $t->toplevel, 'all']); # take first crack at events
+$t->bind('<Return>', \&EvalInput);
+$t->bind('<BackSpace>', \&BackSpace);
+$t->bind('<Escape>', \&HistKill);
+$t->bind('<Up>', \&History);
+$t->bind('<Control-a>', \&BeginLine);
+$t->bind('<Home>', \&BeginLine);
+$t->bind('<Any-KeyPress>', [\&Key, Tk::Ev('K'), Tk::Ev('A')]);
+
+# Set up different colors for the various window outputs
+#$t->tagConfigure('prompt', -underline => 'true');
+$t->tagConfigure('prompt', -foreground => 'blue');
+$t->tagConfigure('result', -foreground => 'purple');
+$t->tagConfigure('error', -foreground => 'red');
+$t->tagConfigure('output', -foreground => 'blue');
+
+# The tag 'limit' is the beginning of the input command line
+$t->markSet('limit', 'insert');
+$t->markGravity('limit', 'left');
+
+# redirect stdout
+#tie (*STDOUT, 'Tk::Text', $t);
+tie (*STDOUT, 'Tk::ptksh');
+#tie (*STDERR, 'Tk::ptksh');
+
+# Print banner
+print "$NAME V$VERSION";
+print " perl V$] Tk V$Tk::VERSION  MainWindow -> \$mw\n";
+print "\n\t\@INC:\n";
+foreach (@INC) { print "\t  $_\n" };
+print "Type 'h<Return>' at the prompt for help\n";
+
+##### Read .ptkshinit
+if ( -r $INITFILE)
+  {
+    print "Reading $INITFILE ...\n";
+    package main;
+    do $Tk::ptksh::INITFILE;
+    package Tk::ptksh;
+  }
+
+###### Source the file if given as argument 0
+if (defined($ARGV[0]) && -r $ARGV[0])
+  {
+    print "Reading $ARGV[0] ...\n";
+    package main;
+    do $ARGV[0];
+    package Tk::ptksh;
+  }
+
+##### Read history
+@hist = ();
+if ( -r $HISTFILE and open(HIST, $HISTFILE) ) {
+	print "Reading history ...\n";
+	my $c = "";
+	while (<HIST>) {
+		chomp;
+		$c .= $_;
+		if ($_ !~ /\\$/) { #end of command if no trailing "\"
+			push @hist, $c;
+			$c = "";
+		} else {
+			chop $c;	# kill trailing "\"
+			$c .= "\n";
+		}
+	}
+    close HIST;
+}
+
+##### Initial prompt
+Prompt($PROMPT);
+$Tk::ptksh::mw->focus;
+$t->focus;
+#$mw->after(1000, sub {print STDERR "now\n"; $mw->focus; $t->focus;});
+
+##### Now enter main loop
+MainLoop();
+
+####### Callbacks/etc.
+
+# EvalInput -- Eval the input area (between 'limit' and 'insert')
+#              in package main;
+use vars qw($command $result); # use globals instead of "my" to avoid conflict w/ 'eval'
+sub EvalInput {
+	# If return is hit when not inside the command entry range, reprompt
+	if ($t->compare('insert', '<=', 'limit')) {
+		$t->markSet('insert', 'end');
+		Prompt($PROMPT);
+		Tk->break;
+	}
+
+	# Support multi-line commands
+	if ($t->get('insert-1c', 'insert') eq "\\") {
+		$t->insert('insert', "\n");
+		$t->insert('insert', "> ", 'prompt'); # must use this pattern for continue
+		$t->see('insert');
+		Tk->break;
+	}
+
+	# Get the command and strip out continuations
+	$command = $t->get('limit','end');
+	$t->markSet('insert','end');
+	$command =~ s/\\\n>\s/\n/mg;
+
+	# Eval it
+	if ( $command !~ /^\s*$/) {
+		chomp $command;
+		push(@hist, $command)
+			unless @hist && ($command eq $hist[$#hist]); #could elim more redundancy
+
+		$t->insert('insert', "\n");
+
+		$isStartOfCommand = 1;
+
+		$command = PtkshCommand($command);
+
+		exit if ($command eq 'exit');
+
+		package main;
+		no strict;
+		$Tk::ptksh::result = eval "local \$^W=0; $Tk::ptksh::command;";
+		use strict;
+		package Tk::ptksh;
+
+		if ($t->compare('insert', '!=', 'insert linestart')) {
+			$t->insert('insert', "\n");
+		}
+		if ($@) {
+			$t->insert('insert', '## ' . $@, 'error');
+		} else {
+			$result = "" if !defined($result);
+			$t->insert('insert', '# ' . $result, 'result');
+		}
+	}
+
+	Prompt($PROMPT);
+
+	Tk->break;
+}
+
+sub Prompt {
+	my $pr = shift;
+
+	if ($t->compare('insert', '!=', 'insert linestart')) {
+		$t->insert('insert', "\n");
+	}
+
+	$t->insert('insert', $pr, 'prompt');
+	$t->see('insert');
+	$t->markSet('limit', 'insert');
+
+}
+
+sub BackSpace {
+	if ($t->tagNextrange('sel', '1.0', 'end')) {
+		$t->delete('sel.first', 'sel.last');
+		} elsif ($t->compare('insert', '>', 'limit')) {
+			$t->delete('insert-1c');
+			$t->see('insert');
+		}
+		Tk->break;
+}
+
+sub BeginLine {
+       $t->SetCursor('limit');
+       $t->break;
+}
+
+sub Key {
+	my ($self, $k, $a) = @_;
+	#print "key event: ", $k, "\n";
+	if ($t->compare('insert', '<', 'limit')) {
+		$t->markSet('insert', 'end');
+	}
+	#$t->break; #for testing bindtags
+}
+
+sub History {
+	Tk->break if defined($hist);
+
+	$hist = $mw->Toplevel;
+	$hist->title('History');
+	$list = $hist->ScrlListbox(-scrollbars => 'oe',
+              -width => 30, -height => 10, @FONT)->pack;
+	Center($hist);
+	$list->insert('end', @hist);
+	$list->see('end');
+	$list->activate('end');
+	$hist->bind('<Double-1>', \&HistPick);
+	$hist->bind('<Return>', \&HistPick);
+	$hist->bind('<Escape>', \&HistKill);
+	$hist->bind('<Map>', sub {Center($hist);} );
+	$hist->bind('<Destroy>', \&HistDestroy);
+	$hist->focus;
+	$list->focus;
+	$hist->grab;
+	Tk->break;
+}
+
+sub HistPick {
+	my $item = $list->get('active');
+	return if (!$item);
+	$t->markSet('insert', 'end');
+	$t->insert('insert',$item);
+	$t->see('insert');
+	$mw->focus;
+	$t->focus;
+	HistKill();
+}
+
+sub HistKill {
+	if ($hist) {
+		$hist->grabRelease;
+		$hist->destroy;
+	}
+}
+
+# Called from destroy event mapping
+sub HistDestroy {
+	if (defined($hist) && (shift == $hist)) {
+		$hist = undef;
+		$mw->focus;
+		$t->focus;
+	}
+}
+
+sub LastCommand {
+	if ($t->compare('insert', '==', 'limit')) {
+		$t->insert('insert', $hist[$#hist]);
+		$t->break;
+	}
+}
+
+# Center a toplevel on screen or above parent
+sub Center {
+	my $w = shift;
+	my ($x, $y);
+
+	if ($w->parent) {
+		#print STDERR $w->screenwidth, " ", $w->width, "\n";
+		$x = $w->parent->x + ($w->parent->width - $w->width)/2;
+		$y = $w->parent->y + ($w->parent->height - $w->height)/2;
+	} else {
+		#print STDERR $w->screenwidth, " ", $w->width, "\n";
+		$x = ($w->screenwidth - $w->width)/2;
+		$y = ($w->screenheight - $w->height)/2;
+	}
+	$x = int($x);
+	$y = int($y);
+	my $g = "+$x+$y";
+	#print STDERR "Setting geometry to $g\n";
+	$w->geometry($g);
+}
+
+# To deal with "TIE".
+# We have to make sure the prints don't go into the command entry range.
+
+sub TIEHANDLE {	# just to capture the tied calls
+	my $self = [];
+	return bless $self;
+
+}
+
+sub PRINT {
+	my ($bogus) = shift;
+
+	$t->markSet('insert', 'end');
+
+	if ($isStartOfCommand) {  # Then no prints have happened in this command yet so...
+		if ($t->compare('insert', '!=', 'insert linestart')) {
+			$t->insert('insert', "\n");
+		}
+		# set flag so we know at least one print happened in this eval
+		$isStartOfCommand = 0;
+	}
+
+	while (@_) {
+		$t->insert('end', shift, 'output');
+	}
+
+	$t->see('insert');
+
+	$t->markSet('limit', 'insert'); # don't interpret print as an input command
+}
+
+sub PRINTF
+{
+ my $w = shift;
+ $w->PRINT(sprintf(shift,@_));
+}
+
+###
+### Utility function
+###
+
+sub _o
+  {
+    my $w = shift;
+    my $what = shift;
+
+    $what =~ s/^\s+//;
+    $what =~ s/\s+$//;
+    my (@opt) = split " ", $what;
+
+    print 'o(', join('|', @opt), ")\n";
+    require Tk::Pretty;
+
+    # check for regexp
+    if ($opt[0] =~ s|^/(.*)/$|$1|)
+      {
+	print "options matching /$opt[0]/:\n";
+        foreach ($w->configure())
+          {
+            print Tk::Pretty::Pretty($_),"\n" if $_->[0] =~ /\Q$opt[0]\E/;
+          }
+        return;
+    }
+
+    # list of options (allow as bar words)
+    foreach (@opt)
+      {
+	s/^['"]//;
+	s/,$//;
+	s/['"]$//;
+	s/^([^-])/-$1/;
+      }
+    if (length $what)
+      {
+       foreach (@opt)
+          {
+            print Tk::Pretty::Pretty($w->configure($_)),"\n";
+          }
+      }
+    else
+      {
+        foreach ($w->configure()) { print Tk::Pretty::Pretty($_),"\n" }
+      }
+  }
+
+sub _p {
+    foreach (@_) { print $_, "|\n"; }
+}
+
+use vars qw($u_init %u_last $u_cnt);
+$u_init = 0;
+%u_last = ();
+sub _u {
+    my $module = shift;
+    if (defined($module) and $module ne '') {
+	$module = "Tk/".ucfirst($module).".pm" unless $module =~ /^Tk/;
+	print " --- Loading $module ---\n";
+	require "$module";
+	print $@ if $@;
+    } else {
+        %u_last = () if defined $module;
+	$u_cnt = 0;
+	foreach (sort keys %INC) {
+	    next if exists $u_last{$_};
+            $u_cnt++;
+            $u_last{$_} = 1;
+	    #next if m,^/, and m,\.ix$,; # Ignore autoloader files
+	    #next if m,\.ix$,; # Ignore autoloader files
+
+	    if (length($_) < 20 ) {
+		printf "%-20s -> %s\n", $_, $INC{$_};
+	    } else {
+		print "$_ -> $INC{$_}\n";
+	    }
+        }
+	print STDERR "No modules loaded since last 'u' command (or startup)\n"
+		unless $u_cnt;
+    }
+}
+
+sub _d
+  {
+    require Data::Dumper;
+    local $Data::Dumper::Deparse;
+    $Data::Dumper::Deparse = 1;
+    print Data::Dumper::Dumper(@_);
+  }
+
+sub _h
+  {
+    print <<'EOT';
+
+  ? or h          print this message
+  d arg,...       calls Data::Dumper::Dumper
+  p arg,...       print args, each on a line and "|\n"
+  o $w /regexp/   print options of widget matching regexp
+  o $w [opt ...]  print (all) options of widget
+  u xxx           xxx = string : load Tk::Xxx
+			       = ''     : list all modules loaded
+			       = undef  : list modules loaded since last u call
+				              (or after ptksh startup)
+
+  Press <Up> (the "up arrow" key) for command history
+  Press <Escape> to leave command history window
+  Type "exit" to quit (saves history)
+  Type \<Return> for continuation of command to following line
+
+EOT
+}
+
+
+# Substitute our special commands into the command line
+sub PtkshCommand {
+	$_ = shift;
+
+	foreach ($_) {
+		last if s/^\?\s*$/Tk::ptksh::_h /;
+		last if s/^h\s*$/Tk::ptksh::_h /;
+		last if s/^u(\s+|$)/Tk::ptksh::_u /;
+		last if s/^d\s+/Tk::ptksh::_d /;
+		last if s/^u\s+(\S+)/Tk::ptksh::_u('$1')/;
+		last if s/^p\s+(.*)$/Tk::ptksh::_p $1;/;
+		last if s/^o\s+(\S+)\s*?$/Tk::ptksh::_o $1;/;
+		last if s/^o\s+(\S+)\s*,?\s+(.*)?$/Tk::ptksh::_o $1, '$2';/;
+    }
+    %u_last = %INC unless $u_init++;
+
+    # print STDERR "Command is: $_\n";
+
+    $_;
+}
+
+###
+### Save History -- use Data::Dumper to preserve multiline commands
+###
+
+END {
+	if ($HISTFILE) {  # because this is probably perl -c if $HISTFILE is not set
+		$#hist-- if $hist[-1] =~ /^(q$|x$|\s*exit\b)/; # chop off the exit command
+
+	    @hist = @hist[($#hist-$HISTSAVE)..($#hist)] if $#hist > $HISTSAVE;
+
+		if( open HIST, ">$HISTFILE" ) {
+			while ($_ = shift(@hist)) {
+				s/\n/\\\n/mg;
+				print HIST "$_\n";
+			}
+			close HIST;
+		} else {
+			print STDERR "Error: Unable to open history file '$HISTFILE'\n";
+		}
+	}
+}
+
+1;  # just in case we decide to be "use"'able in the future.

Perl/bin/ptksh.bat

@@ -0,0 +1,722 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl -w
+#line 15
+#
+# PTKSH 2.0
+#
+# A graphical user interface for testing Perl/Tk commands and scripts.
+#
+# VERSION HISTORY:
+# ...truncated earlier stuff...
+# 4/23/98  V1.7    Achim Bohnet  -- some fixes to "o" command
+# 6/08/98  V2.01  M. Beller -- merge in GUI code for "wish"-like interface
+#
+# 2.01d1 6/6/98 First development version
+#
+# 2.01d2 6/7/98
+#  - apply A.B. patch for pod and -option
+#  - fix "use of uninitialized variable" in END{ } block (for -c option)
+#  - support h and ? only for help
+#  - misc. pod fixes (PITFALLS)
+#  - use default fonts and default colors  ## NOT YET--still working on it
+#  - get rid of Data::Dumper for history
+#
+# 2.01d3 6/8/98
+#  - Remove "use Data::Dumper" line
+#  - Put in hack for unix vs. win32 window manager focus problem
+#  - Achim's pod and histfile patch
+#
+# 2.01d4 6/18/98
+#  - Slaven's patch to make <Home> work properly
+#  - Add help message to banner (per Steve Lydie)
+#  - Fix horizontal scrolling (turn off wrapping in console window)
+#  - Clarify <Up> in docs and help means "up arrow"
+#  - Use HOMEDRIVE/HOMEPATH on Win32
+#
+
+=head1 NAME
+
+ptksh - Perl/Tk script to provide a graphical user interface for testing Perl/Tk
+commands and scripts.
+
+=head1 SYNOPSIS
+
+  % ptksh  ?scriptfile?
+  ... version information ...
+  ptksh> $b=$mw->Button(-text=>'Hi',-command=>sub{print 'Hi'})
+  ptksh> $b->pack
+  ptksh> o $b
+  ... list of options ...
+  ptksh> help
+  ... help information ...
+  ptksh> exit
+  %
+
+
+=head1 DESCRIPTION
+
+ptksh is a perl/Tk shell to enter perl commands
+interactively.  When one starts ptksh a L<MainWindow|Tk::MainWindow>
+is automaticly created, along with a ptksh command window.
+One can access the main window by typing commands using the
+variable $mw at the 'ptksh> ' prompt of the command window.
+
+ptksh supports command line editing and history.  Just type "<Up>" at
+the command prompt to see a history list.  The last 50 commands entered
+are saved, then reloaded into history list the next time you start ptksh.
+
+ptksh supports some convenient commands for inspecting Tk widgets.  See below.
+
+To exit ptksh use: C<exit>.
+
+ptksh is B<*not*> a full symbolic debugger.
+To debug perl/Tk programs at a low level use the more powerful
+L<perl debugger|perldebug>.  (Just enter ``O tk'' on debuggers
+command line to start the Tk eventloop.)
+
+=head1 FEATURES
+
+=head2 History
+
+Press <Up> (the Up Arrow) in the perlwish window to obtain a gui-based history list.
+Press <Enter> on any history line to enter it into the perlwish window.
+Then hit return.  So, for example, repeat last command is <Up><Enter><Enter>.
+You can quit the history window with <Escape>.  NOTE: history is only saved
+if exit is "graceful" (i.e. by the "exit" command from the console or by
+quitting all main windows--NOT by interrupt).
+
+=head2 Debugging Support
+
+ptksh provides some convenience function to make browsing
+in perl/Tk widget easier:
+
+=over 4
+
+=item B<?>, or B<h>
+
+displays a short help summary.
+
+=item B<d> ?I<args>, ...?
+
+Dumps recursively arguments to stdout. (see L<Data::Dumper>).
+You must have <Data::Dumper> installed to support this feature.
+
+=item B<p> ?I<arg>, ...?
+
+appends "|\n" to each of it's arguments and prints it.
+If value is B<undef>, '(undef)' is printed to stdout.
+
+=item B<o> I<$widget> ?I<-option> ...?
+
+prints the option(s) of I<$widget> one on each line.
+If no options are given all options of the widget are
+listed.  See L<Tk::options> for more details on the
+format and contents of the returned list.
+
+=item B<o> I<$widget> B</>I<regexp>B</>
+
+Lists options of I<$widget> matching the
+L<regular expression|perlre> I<regexp>.
+
+=item B<u> ?I<class>?
+
+If no argument is given it lists the modules loaded
+by the commands you executed or since the last time you
+called C<u>.
+
+If argument is the empty string lists all modules that are
+loaded by ptksh.
+
+If argument is a string, ``text'' it tries to do a ``use Tk::Text;''.
+
+=back
+
+=head2 Packages
+
+Ptksh compiles into package Tk::ptksh.  Your code is eval'ed into package
+main.  The coolness of this is that your eval code should not interfere with
+ptksh itself.
+
+=head2 Multiline Commands
+
+ptksh will accept multiline commands.  Simply put a "\" character immediately
+before the newline, and ptksh will continue your command onto the next line.
+
+=head2 Source File Support
+
+If you have a perl/Tk script that you want to do debugging on, try running the
+command
+
+  ptksh> do 'myscript';
+
+   -- or  (at shell command prompt) --
+
+  % ptksh myscript
+
+Then use the perl/Tk commands to try out different operations on your script.
+
+=head1 ENVIRONMENT
+
+Looks for your .ptksh_history in the directory specified by
+the $HOME environment variable ($HOMEPATH on Win32 systems).
+
+=head1 FILES
+
+=over 4
+
+=item F<.ptksh_init>
+
+If found in current directory it is read in an evaluated
+after the mainwindow I<$mw> is created. F<.ptksh_init>
+can contain any valid perl code.
+
+=item F<~/.ptksh_history>
+
+Contains the last 50 lines entered in ptksh session(s).
+
+=back
+
+=head1 PITFALLS
+
+It is best not to use "my" in the commands you type into ptksh.
+For example "my $v" will make $v local just to the command or commands
+entered until <Return> is pressed.
+For a related reason, there are no file-scopy "my" variables in the
+ptksh code itself (else the user might trounce on them by accident).
+
+=head1 BUGS
+
+B<Tk::MainLoop> function interactively entered or sourced in a
+init or script file will block ptksh.
+
+=head1 SEE ALSO
+
+L<Tk|Tk>
+L<perldebug|perldebug>
+
+=head1 VERSION
+
+VERSION 2.02
+
+=head1 AUTHORS
+
+Mike Beller <beller@penvision.com>,
+Achim Bohnet <ach@mpe.mpg.de>
+
+Copyright (c) 1996 - 1998 Achim Bohnet and Mike Beller. All rights reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+package Tk::ptksh;
+require 5.004;
+use strict;
+use Tk;
+
+##### Constants
+
+use vars qw($NAME $VERSION $FONT @FONT $WIN32 $HOME $HISTFILE $HISTSAVE $PROMPT $INITFILE);
+
+$NAME = 'ptksh';
+$VERSION = '2.02';
+$WIN32 = 1 if $^O =~ /Win32/;
+$HOME = $WIN32 ? ($ENV{HOMEDRIVE} . $ENV{HOMEPATH}) || 'C:\\' : $ENV{HOME} . "/";
+@FONT = ($WIN32 ? (-font => 'systemfixed') : () );
+#@FONT = ($WIN32 ? (-font => ['courier', 9, 'normal']) : () );
+$HISTFILE = "${HOME}.${NAME}_history";
+$HISTSAVE = 50;
+$INITFILE = ".${NAME}_init";
+$PROMPT = "$NAME> ";
+
+sub Win32Fix { my $p = shift; $p =~ s'\\'/'g; $p =~ s'/$''; return $p }
+
+use vars qw($mw $st $t @hist $hist $list $isStartOfCommand);
+
+# NOTE: mainwindow creation order seems to impact who gets focus, and
+# order is different on Win32 & *nix!!  So hack is to create the windows
+# in an order dependent on the OS!
+
+$mw = Tk::MainWindow->new unless $WIN32;  # &&& hack to work around focus problem
+
+##### set up user's main window
+package main;
+$main::mw = Tk::MainWindow->new;
+$main::mw->title('$mw');
+$main::mw->geometry("+1+1");
+package Tk::ptksh;
+
+##### Set up ptksh windows
+$mw = Tk::MainWindow->new if $WIN32;  # &&& hack to work around focus problem
+$mw->title($NAME);
+$st = $mw->Scrolled('Text', -scrollbars => 'osoe',
+				-wrap => 'none',
+				-width => 80, -height => 25, @FONT);
+$t = $st->Subwidget('scrolled');
+$st->pack(-fill => 'both', -expand => 'true');
+$mw->bind('<Map>', sub {Center($mw);} );
+
+# Event bindings
+$t->bindtags([$t, ref($t), $t->toplevel, 'all']); # take first crack at events
+$t->bind('<Return>', \&EvalInput);
+$t->bind('<BackSpace>', \&BackSpace);
+$t->bind('<Escape>', \&HistKill);
+$t->bind('<Up>', \&History);
+$t->bind('<Control-a>', \&BeginLine);
+$t->bind('<Home>', \&BeginLine);
+$t->bind('<Any-KeyPress>', [\&Key, Tk::Ev('K'), Tk::Ev('A')]);
+
+# Set up different colors for the various window outputs
+#$t->tagConfigure('prompt', -underline => 'true');
+$t->tagConfigure('prompt', -foreground => 'blue');
+$t->tagConfigure('result', -foreground => 'purple');
+$t->tagConfigure('error', -foreground => 'red');
+$t->tagConfigure('output', -foreground => 'blue');
+
+# The tag 'limit' is the beginning of the input command line
+$t->markSet('limit', 'insert');
+$t->markGravity('limit', 'left');
+
+# redirect stdout
+#tie (*STDOUT, 'Tk::Text', $t);
+tie (*STDOUT, 'Tk::ptksh');
+#tie (*STDERR, 'Tk::ptksh');
+
+# Print banner
+print "$NAME V$VERSION";
+print " perl V$] Tk V$Tk::VERSION  MainWindow -> \$mw\n";
+print "\n\t\@INC:\n";
+foreach (@INC) { print "\t  $_\n" };
+print "Type 'h<Return>' at the prompt for help\n";
+
+##### Read .ptkshinit
+if ( -r $INITFILE)
+  {
+    print "Reading $INITFILE ...\n";
+    package main;
+    do $Tk::ptksh::INITFILE;
+    package Tk::ptksh;
+  }
+
+###### Source the file if given as argument 0
+if (defined($ARGV[0]) && -r $ARGV[0])
+  {
+    print "Reading $ARGV[0] ...\n";
+    package main;
+    do $ARGV[0];
+    package Tk::ptksh;
+  }
+
+##### Read history
+@hist = ();
+if ( -r $HISTFILE and open(HIST, $HISTFILE) ) {
+	print "Reading history ...\n";
+	my $c = "";
+	while (<HIST>) {
+		chomp;
+		$c .= $_;
+		if ($_ !~ /\\$/) { #end of command if no trailing "\"
+			push @hist, $c;
+			$c = "";
+		} else {
+			chop $c;	# kill trailing "\"
+			$c .= "\n";
+		}
+	}
+    close HIST;
+}
+
+##### Initial prompt
+Prompt($PROMPT);
+$Tk::ptksh::mw->focus;
+$t->focus;
+#$mw->after(1000, sub {print STDERR "now\n"; $mw->focus; $t->focus;});
+
+##### Now enter main loop
+MainLoop();
+
+####### Callbacks/etc.
+
+# EvalInput -- Eval the input area (between 'limit' and 'insert')
+#              in package main;
+use vars qw($command $result); # use globals instead of "my" to avoid conflict w/ 'eval'
+sub EvalInput {
+	# If return is hit when not inside the command entry range, reprompt
+	if ($t->compare('insert', '<=', 'limit')) {
+		$t->markSet('insert', 'end');
+		Prompt($PROMPT);
+		Tk->break;
+	}
+
+	# Support multi-line commands
+	if ($t->get('insert-1c', 'insert') eq "\\") {
+		$t->insert('insert', "\n");
+		$t->insert('insert', "> ", 'prompt'); # must use this pattern for continue
+		$t->see('insert');
+		Tk->break;
+	}
+
+	# Get the command and strip out continuations
+	$command = $t->get('limit','end');
+	$t->markSet('insert','end');
+	$command =~ s/\\\n>\s/\n/mg;
+
+	# Eval it
+	if ( $command !~ /^\s*$/) {
+		chomp $command;
+		push(@hist, $command)
+			unless @hist && ($command eq $hist[$#hist]); #could elim more redundancy
+
+		$t->insert('insert', "\n");
+
+		$isStartOfCommand = 1;
+
+		$command = PtkshCommand($command);
+
+		exit if ($command eq 'exit');
+
+		package main;
+		no strict;
+		$Tk::ptksh::result = eval "local \$^W=0; $Tk::ptksh::command;";
+		use strict;
+		package Tk::ptksh;
+
+		if ($t->compare('insert', '!=', 'insert linestart')) {
+			$t->insert('insert', "\n");
+		}
+		if ($@) {
+			$t->insert('insert', '## ' . $@, 'error');
+		} else {
+			$result = "" if !defined($result);
+			$t->insert('insert', '# ' . $result, 'result');
+		}
+	}
+
+	Prompt($PROMPT);
+
+	Tk->break;
+}
+
+sub Prompt {
+	my $pr = shift;
+
+	if ($t->compare('insert', '!=', 'insert linestart')) {
+		$t->insert('insert', "\n");
+	}
+
+	$t->insert('insert', $pr, 'prompt');
+	$t->see('insert');
+	$t->markSet('limit', 'insert');
+
+}
+
+sub BackSpace {
+	if ($t->tagNextrange('sel', '1.0', 'end')) {
+		$t->delete('sel.first', 'sel.last');
+		} elsif ($t->compare('insert', '>', 'limit')) {
+			$t->delete('insert-1c');
+			$t->see('insert');
+		}
+		Tk->break;
+}
+
+sub BeginLine {
+       $t->SetCursor('limit');
+       $t->break;
+}
+
+sub Key {
+	my ($self, $k, $a) = @_;
+	#print "key event: ", $k, "\n";
+	if ($t->compare('insert', '<', 'limit')) {
+		$t->markSet('insert', 'end');
+	}
+	#$t->break; #for testing bindtags
+}
+
+sub History {
+	Tk->break if defined($hist);
+
+	$hist = $mw->Toplevel;
+	$hist->title('History');
+	$list = $hist->ScrlListbox(-scrollbars => 'oe',
+              -width => 30, -height => 10, @FONT)->pack;
+	Center($hist);
+	$list->insert('end', @hist);
+	$list->see('end');
+	$list->activate('end');
+	$hist->bind('<Double-1>', \&HistPick);
+	$hist->bind('<Return>', \&HistPick);
+	$hist->bind('<Escape>', \&HistKill);
+	$hist->bind('<Map>', sub {Center($hist);} );
+	$hist->bind('<Destroy>', \&HistDestroy);
+	$hist->focus;
+	$list->focus;
+	$hist->grab;
+	Tk->break;
+}
+
+sub HistPick {
+	my $item = $list->get('active');
+	return if (!$item);
+	$t->markSet('insert', 'end');
+	$t->insert('insert',$item);
+	$t->see('insert');
+	$mw->focus;
+	$t->focus;
+	HistKill();
+}
+
+sub HistKill {
+	if ($hist) {
+		$hist->grabRelease;
+		$hist->destroy;
+	}
+}
+
+# Called from destroy event mapping
+sub HistDestroy {
+	if (defined($hist) && (shift == $hist)) {
+		$hist = undef;
+		$mw->focus;
+		$t->focus;
+	}
+}
+
+sub LastCommand {
+	if ($t->compare('insert', '==', 'limit')) {
+		$t->insert('insert', $hist[$#hist]);
+		$t->break;
+	}
+}
+
+# Center a toplevel on screen or above parent
+sub Center {
+	my $w = shift;
+	my ($x, $y);
+
+	if ($w->parent) {
+		#print STDERR $w->screenwidth, " ", $w->width, "\n";
+		$x = $w->parent->x + ($w->parent->width - $w->width)/2;
+		$y = $w->parent->y + ($w->parent->height - $w->height)/2;
+	} else {
+		#print STDERR $w->screenwidth, " ", $w->width, "\n";
+		$x = ($w->screenwidth - $w->width)/2;
+		$y = ($w->screenheight - $w->height)/2;
+	}
+	$x = int($x);
+	$y = int($y);
+	my $g = "+$x+$y";
+	#print STDERR "Setting geometry to $g\n";
+	$w->geometry($g);
+}
+
+# To deal with "TIE".
+# We have to make sure the prints don't go into the command entry range.
+
+sub TIEHANDLE {	# just to capture the tied calls
+	my $self = [];
+	return bless $self;
+
+}
+
+sub PRINT {
+	my ($bogus) = shift;
+
+	$t->markSet('insert', 'end');
+
+	if ($isStartOfCommand) {  # Then no prints have happened in this command yet so...
+		if ($t->compare('insert', '!=', 'insert linestart')) {
+			$t->insert('insert', "\n");
+		}
+		# set flag so we know at least one print happened in this eval
+		$isStartOfCommand = 0;
+	}
+
+	while (@_) {
+		$t->insert('end', shift, 'output');
+	}
+
+	$t->see('insert');
+
+	$t->markSet('limit', 'insert'); # don't interpret print as an input command
+}
+
+sub PRINTF
+{
+ my $w = shift;
+ $w->PRINT(sprintf(shift,@_));
+}
+
+###
+### Utility function
+###
+
+sub _o
+  {
+    my $w = shift;
+    my $what = shift;
+
+    $what =~ s/^\s+//;
+    $what =~ s/\s+$//;
+    my (@opt) = split " ", $what;
+
+    print 'o(', join('|', @opt), ")\n";
+    require Tk::Pretty;
+
+    # check for regexp
+    if ($opt[0] =~ s|^/(.*)/$|$1|)
+      {
+	print "options matching /$opt[0]/:\n";
+        foreach ($w->configure())
+          {
+            print Tk::Pretty::Pretty($_),"\n" if $_->[0] =~ /\Q$opt[0]\E/;
+          }
+        return;
+    }
+
+    # list of options (allow as bar words)
+    foreach (@opt)
+      {
+	s/^['"]//;
+	s/,$//;
+	s/['"]$//;
+	s/^([^-])/-$1/;
+      }
+    if (length $what)
+      {
+       foreach (@opt)
+          {
+            print Tk::Pretty::Pretty($w->configure($_)),"\n";
+          }
+      }
+    else
+      {
+        foreach ($w->configure()) { print Tk::Pretty::Pretty($_),"\n" }
+      }
+  }
+
+sub _p {
+    foreach (@_) { print $_, "|\n"; }
+}
+
+use vars qw($u_init %u_last $u_cnt);
+$u_init = 0;
+%u_last = ();
+sub _u {
+    my $module = shift;
+    if (defined($module) and $module ne '') {
+	$module = "Tk/".ucfirst($module).".pm" unless $module =~ /^Tk/;
+	print " --- Loading $module ---\n";
+	require "$module";
+	print $@ if $@;
+    } else {
+        %u_last = () if defined $module;
+	$u_cnt = 0;
+	foreach (sort keys %INC) {
+	    next if exists $u_last{$_};
+            $u_cnt++;
+            $u_last{$_} = 1;
+	    #next if m,^/, and m,\.ix$,; # Ignore autoloader files
+	    #next if m,\.ix$,; # Ignore autoloader files
+
+	    if (length($_) < 20 ) {
+		printf "%-20s -> %s\n", $_, $INC{$_};
+	    } else {
+		print "$_ -> $INC{$_}\n";
+	    }
+        }
+	print STDERR "No modules loaded since last 'u' command (or startup)\n"
+		unless $u_cnt;
+    }
+}
+
+sub _d
+  {
+    require Data::Dumper;
+    local $Data::Dumper::Deparse;
+    $Data::Dumper::Deparse = 1;
+    print Data::Dumper::Dumper(@_);
+  }
+
+sub _h
+  {
+    print <<'EOT';
+
+  ? or h          print this message
+  d arg,...       calls Data::Dumper::Dumper
+  p arg,...       print args, each on a line and "|\n"
+  o $w /regexp/   print options of widget matching regexp
+  o $w [opt ...]  print (all) options of widget
+  u xxx           xxx = string : load Tk::Xxx
+			       = ''     : list all modules loaded
+			       = undef  : list modules loaded since last u call
+				              (or after ptksh startup)
+
+  Press <Up> (the "up arrow" key) for command history
+  Press <Escape> to leave command history window
+  Type "exit" to quit (saves history)
+  Type \<Return> for continuation of command to following line
+
+EOT
+}
+
+
+# Substitute our special commands into the command line
+sub PtkshCommand {
+	$_ = shift;
+
+	foreach ($_) {
+		last if s/^\?\s*$/Tk::ptksh::_h /;
+		last if s/^h\s*$/Tk::ptksh::_h /;
+		last if s/^u(\s+|$)/Tk::ptksh::_u /;
+		last if s/^d\s+/Tk::ptksh::_d /;
+		last if s/^u\s+(\S+)/Tk::ptksh::_u('$1')/;
+		last if s/^p\s+(.*)$/Tk::ptksh::_p $1;/;
+		last if s/^o\s+(\S+)\s*?$/Tk::ptksh::_o $1;/;
+		last if s/^o\s+(\S+)\s*,?\s+(.*)?$/Tk::ptksh::_o $1, '$2';/;
+    }
+    %u_last = %INC unless $u_init++;
+
+    # print STDERR "Command is: $_\n";
+
+    $_;
+}
+
+###
+### Save History -- use Data::Dumper to preserve multiline commands
+###
+
+END {
+	if ($HISTFILE) {  # because this is probably perl -c if $HISTFILE is not set
+		$#hist-- if $hist[-1] =~ /^(q$|x$|\s*exit\b)/; # chop off the exit command
+
+	    @hist = @hist[($#hist-$HISTSAVE)..($#hist)] if $#hist > $HISTSAVE;
+
+		if( open HIST, ">$HISTFILE" ) {
+			while ($_ = shift(@hist)) {
+				s/\n/\\\n/mg;
+				print HIST "$_\n";
+			}
+			close HIST;
+		} else {
+			print STDERR "Error: Unable to open history file '$HISTFILE'\n";
+		}
+	}
+}
+
+1;  # just in case we decide to be "use"'able in the future.
+
+__END__
+:endofperl

Perl/bin/reloc_perl

@@ -0,0 +1,187 @@
+#!perl -w
+
+use strict;
+use ActiveState::RelocateTree qw(relocate spongedir rel2abs);
+use Config;
+use File::Basename qw(dirname);
+use Getopt::Std;
+use vars qw(
+    $opt_a $opt_b $opt_d $opt_e $opt_f $opt_i $opt_t $opt_r $opt_v
+    *OLDERR
+);
+
+my $logname;
+
+BEGIN {
+    # If we're being run via wperl, redirect the output streams to a log file.
+    if ($^O eq 'MSWin32' and $^X =~ /\bwperl(.exe)?\z/i) {
+	my $tmp = $ENV{TEMP} || $ENV{tmp} || "$ENV{SystemDrive}/" || "c:/temp";
+	$logname = "$tmp/ActivePerlInstall.log";
+	open(STDERR, ">> $logname");
+	open(STDOUT, ">&STDERR");
+    }
+}
+
+my $frompath_default = $Config{prefix};
+
+getopts('abde:f:itrv') or usage('');
+
+my $topath      = shift || usage('');
+my $frompath    = shift || $frompath_default;
+if ($topath eq "~") {
+    $topath = dirname(dirname($^X));
+}
+# MSI insists on handing us paths with backslashes at the end
+if ($^O eq 'MSWin32') {
+    $topath =~ s{\\\z}{};
+    $frompath =~ s{\\\z}{};
+}
+my $destpath    = $opt_e || $topath;
+my $filelist    = $opt_f || '';
+
+usage("$destpath is longer than $frompath")
+    if length($destpath) > length($frompath) and ! $opt_a;
+usage("$destpath is longer than " . spongedir('thisperl'))
+    if length($destpath) > length(spongedir('thisperl')) and ! $opt_t;
+
+if (-d $topath) {
+    if (not -d $frompath) {
+	#warn "Will do inplace edit of `$topath'\n";
+	$opt_i++;
+    }
+}
+elsif ($opt_i) {
+    usage("Directory `$topath' doesn't exist, can't do inplace edit");
+}
+
+sub usage {
+    (my $progname = $0) =~ s,.*[\\/],,;
+    my $msg = shift || "";
+    print STDERR <<EOT;
+$msg
+Usage: $progname [options] topath [frompath]
+
+Recognized options:
+
+    -a          allow topath to be longer than frompath
+    -b          don't delete backups after edit
+    -d          delete source tree after relocation
+    -e path     edit files to contain this path instead of topath
+    -f logfile  write log of the modified files
+    -i          edit perl installation at topath in-place
+    -t          only edit text files
+    -r          do not run ranlib on *.a files that were edited
+    -v          turn on verbosity
+
+The frompath defaults to '$frompath_default'.
+Run 'perldoc $progname' for further information.
+
+EOT
+    exit(1);
+}
+
+relocate(
+    to		=> $topath,
+    from	=> $frompath,
+    replace	=> $destpath,
+    verbose	=> $opt_v,
+    filelist	=> $filelist,
+    ranlib	=> (not $opt_r),
+    textonly	=> $opt_t,
+    savebaks	=> $opt_b,
+    inplace	=> $opt_i,
+    killorig	=> $opt_d,
+    usenlink	=> 0, # don't use nlink: broken on HP-UX.
+);
+
+__END__
+
+=head1 NAME
+
+reloc_perl - copy a perl installation to a new location
+
+=head1 SYNOPSIS
+
+  reloc_perl [-a] [-b] [-d] [-e path] [-f file] [-i] [-t] [-r] [-v]
+             topath [frompath]
+
+=head1 DESCRIPTION
+
+The B<reloc_perl> program will copy a perl installation wholesale to a
+new location.  During the copy it edits path names in the copied files
+to reflect the new location.
+
+The I<topath> is the file system location where the perl installation
+should be copied to.  This location should normally not already
+exists.  A directory will be created at I<topath> and then populated
+with the F<bin>, F<lib>, F<html> and F<man> directories of the perl
+installation.
+
+The perl installation copied is the one where B<reloc_perl> itself
+resides, but this can be overridden by providing a I<frompath>.
+Running B<reloc_perl> without arguments will show what this path is,
+as well as a short usage message.
+
+=head1 OPTIONS
+
+The following options are recognized by the C<reloc_perl> program:
+
+=over 5
+
+=item B<-a>
+
+The B<reloc_perl> program will refuse to copy if I<topath> is longer
+than I<frompath>.  This option overrides this restriction.  The
+I<topath> must still be shorter than the path built into the perl
+binary.
+
+=item B<-b>
+
+Don't delete the backups created during the edits performed in I<topath>.
+
+=item B<-d>
+
+Delete the perl installation that was copied.  Use with care!
+
+=item B<-e> I<path>
+
+Edit files to contain this path instead of the I<topath>.  This allow
+relocation to a different location than where the files themselves are
+copied.
+
+=item B<-f> I<logfile>
+
+Creates I<logfile> and writes the full path name of
+each file that was modified (one line per file).
+
+=item B<-i>
+
+Edit perl installation at I<topath> in-place.  Makes no attempt to
+move tree and the B<-d> is ignored.  This option is assumed if
+I<topath> exists, is a directory, and I<frompath> doesn't exist.
+
+=item B<-t>
+
+Only edit the text files.  When this option is used, the restriction
+that I<topath> must not be longer than I<frompath> is relaxed.
+
+=item B<-r>
+
+Do not run F<ranlib> any F<*.a> files that were edited.
+
+=item B<-v>
+
+Print a trace of what's going on.
+
+=back
+
+=head1 SEE ALSO
+
+L<ActiveState::RelocateTree>
+
+=head1 COPYRIGHT
+
+Copyright 1999-2001 ActiveState Software Inc.  All rights reserved.
+
+=cut
+

Perl/bin/reloc_perl.bat

@@ -0,0 +1,203 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl -w
+#line 15
+
+use strict;
+use ActiveState::RelocateTree qw(relocate spongedir rel2abs);
+use Config;
+use File::Basename qw(dirname);
+use Getopt::Std;
+use vars qw(
+    $opt_a $opt_b $opt_d $opt_e $opt_f $opt_i $opt_t $opt_r $opt_v
+    *OLDERR
+);
+
+my $logname;
+
+BEGIN {
+    # If we're being run via wperl, redirect the output streams to a log file.
+    if ($^O eq 'MSWin32' and $^X =~ /\bwperl(.exe)?\z/i) {
+	my $tmp = $ENV{TEMP} || $ENV{tmp} || "$ENV{SystemDrive}/" || "c:/temp";
+	$logname = "$tmp/ActivePerlInstall.log";
+	open(STDERR, ">> $logname");
+	open(STDOUT, ">&STDERR");
+    }
+}
+
+my $frompath_default = $Config{prefix};
+
+getopts('abde:f:itrv') or usage('');
+
+my $topath      = shift || usage('');
+my $frompath    = shift || $frompath_default;
+if ($topath eq "~") {
+    $topath = dirname(dirname($^X));
+}
+# MSI insists on handing us paths with backslashes at the end
+if ($^O eq 'MSWin32') {
+    $topath =~ s{\\\z}{};
+    $frompath =~ s{\\\z}{};
+}
+my $destpath    = $opt_e || $topath;
+my $filelist    = $opt_f || '';
+
+usage("$destpath is longer than $frompath")
+    if length($destpath) > length($frompath) and ! $opt_a;
+usage("$destpath is longer than " . spongedir('thisperl'))
+    if length($destpath) > length(spongedir('thisperl')) and ! $opt_t;
+
+if (-d $topath) {
+    if (not -d $frompath) {
+	#warn "Will do inplace edit of `$topath'\n";
+	$opt_i++;
+    }
+}
+elsif ($opt_i) {
+    usage("Directory `$topath' doesn't exist, can't do inplace edit");
+}
+
+sub usage {
+    (my $progname = $0) =~ s,.*[\\/],,;
+    my $msg = shift || "";
+    print STDERR <<EOT;
+$msg
+Usage: $progname [options] topath [frompath]
+
+Recognized options:
+
+    -a          allow topath to be longer than frompath
+    -b          don't delete backups after edit
+    -d          delete source tree after relocation
+    -e path     edit files to contain this path instead of topath
+    -f logfile  write log of the modified files
+    -i          edit perl installation at topath in-place
+    -t          only edit text files
+    -r          do not run ranlib on *.a files that were edited
+    -v          turn on verbosity
+
+The frompath defaults to '$frompath_default'.
+Run 'perldoc $progname' for further information.
+
+EOT
+    exit(1);
+}
+
+relocate(
+    to		=> $topath,
+    from	=> $frompath,
+    replace	=> $destpath,
+    verbose	=> $opt_v,
+    filelist	=> $filelist,
+    ranlib	=> (not $opt_r),
+    textonly	=> $opt_t,
+    savebaks	=> $opt_b,
+    inplace	=> $opt_i,
+    killorig	=> $opt_d,
+    usenlink	=> 0, # don't use nlink: broken on HP-UX.
+);
+
+__END__
+
+=head1 NAME
+
+reloc_perl - copy a perl installation to a new location
+
+=head1 SYNOPSIS
+
+  reloc_perl [-a] [-b] [-d] [-e path] [-f file] [-i] [-t] [-r] [-v]
+             topath [frompath]
+
+=head1 DESCRIPTION
+
+The B<reloc_perl> program will copy a perl installation wholesale to a
+new location.  During the copy it edits path names in the copied files
+to reflect the new location.
+
+The I<topath> is the file system location where the perl installation
+should be copied to.  This location should normally not already
+exists.  A directory will be created at I<topath> and then populated
+with the F<bin>, F<lib>, F<html> and F<man> directories of the perl
+installation.
+
+The perl installation copied is the one where B<reloc_perl> itself
+resides, but this can be overridden by providing a I<frompath>.
+Running B<reloc_perl> without arguments will show what this path is,
+as well as a short usage message.
+
+=head1 OPTIONS
+
+The following options are recognized by the C<reloc_perl> program:
+
+=over 5
+
+=item B<-a>
+
+The B<reloc_perl> program will refuse to copy if I<topath> is longer
+than I<frompath>.  This option overrides this restriction.  The
+I<topath> must still be shorter than the path built into the perl
+binary.
+
+=item B<-b>
+
+Don't delete the backups created during the edits performed in I<topath>.
+
+=item B<-d>
+
+Delete the perl installation that was copied.  Use with care!
+
+=item B<-e> I<path>
+
+Edit files to contain this path instead of the I<topath>.  This allow
+relocation to a different location than where the files themselves are
+copied.
+
+=item B<-f> I<logfile>
+
+Creates I<logfile> and writes the full path name of
+each file that was modified (one line per file).
+
+=item B<-i>
+
+Edit perl installation at I<topath> in-place.  Makes no attempt to
+move tree and the B<-d> is ignored.  This option is assumed if
+I<topath> exists, is a directory, and I<frompath> doesn't exist.
+
+=item B<-t>
+
+Only edit the text files.  When this option is used, the restriction
+that I<topath> must not be longer than I<frompath> is relaxed.
+
+=item B<-r>
+
+Do not run F<ranlib> any F<*.a> files that were edited.
+
+=item B<-v>
+
+Print a trace of what's going on.
+
+=back
+
+=head1 SEE ALSO
+
+L<ActiveState::RelocateTree>
+
+=head1 COPYRIGHT
+
+Copyright 1999-2001 ActiveState Software Inc.  All rights reserved.
+
+=cut
+
+
+__END__
+:endofperl

Perl/bin/runperl.bat

@@ -0,0 +1,83 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl -w
+#line 15
+$0 =~ s|\.bat||i;
+unless (-f $0) {
+    $0 =~ s|.*[/\\]||;
+    for (".", split ';', $ENV{PATH}) {
+	$_ = "." if $_ eq "";
+	$0 = "$_/$0" , goto doit if -f "$_/$0";
+    }
+    die "`$0' not found.\n";
+}
+doit: exec "perl", "-x", $0, @ARGV;
+die "Failed to exec `$0': $!";
+__END__
+
+=head1 NAME
+
+runperl.bat - "universal" batch file to run perl scripts
+
+=head1 SYNOPSIS
+
+	C:\> copy runperl.bat foo.bat
+	C:\> foo
+	[..runs the perl script `foo'..]
+	
+	C:\> foo.bat
+	[..runs the perl script `foo'..]
+	
+
+=head1 DESCRIPTION
+
+This file can be copied to any file name ending in the ".bat" suffix.
+When executed on a DOS-like operating system, it will invoke the perl
+script of the same name, but without the ".bat" suffix.  It will
+look for the script in the same directory as itself, and then in
+the current directory, and then search the directories in your PATH.
+
+It relies on the C<exec()> operator, so you will need to make sure
+that works in your perl.
+
+This method of invoking perl scripts has some advantages over
+batch-file wrappers like C<pl2bat.bat>:  it avoids duplication
+of all the code; it ensures C<$0> contains the same name as the
+executing file, without any egregious ".bat" suffix; it allows
+you to separate your perl scripts from the wrapper used to
+run them; since the wrapper is generic, you can use symbolic
+links to simply link to C<runperl.bat>, if you are serving your
+files on a filesystem that supports that.
+
+On the other hand, if the batch file is invoked with the ".bat"
+suffix, it does an extra C<exec()>.  This may be a performance
+issue.  You can avoid this by running it without specifying
+the ".bat" suffix.
+
+Perl is invoked with the -x flag, so the script must contain
+a C<#!perl> line.  Any flags found on that line will be honored.
+
+=head1 BUGS
+
+Perl is invoked with the -S flag, so it will search the PATH to find
+the script.  This may have undesirable effects.
+
+=head1 SEE ALSO
+
+perl, perlwin32, pl2bat.bat
+
+=cut
+
+
+__END__
+:endofperl

Perl/bin/splain.bat

@@ -0,0 +1,664 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!perl
+#line 15
+    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
+	if $running_under_some_shell;
+
+=head1 NAME
+
+diagnostics, splain - produce verbose warning diagnostics
+
+=head1 SYNOPSIS
+
+Using the C<diagnostics> pragma:
+
+    use diagnostics;
+    use diagnostics -verbose;
+
+    enable  diagnostics;
+    disable diagnostics;
+
+Using the C<splain> standalone filter program:
+
+    perl program 2>diag.out
+    splain [-v] [-p] diag.out
+
+Using diagnostics to get stack traces from a misbehaving script:
+
+    perl -Mdiagnostics=-traceonly my_script.pl
+
+=head1 DESCRIPTION
+
+=head2 The C<diagnostics> Pragma
+
+This module extends the terse diagnostics normally emitted by both the
+perl compiler and the perl interpreter (from running perl with a -w 
+switch or C<use warnings>), augmenting them with the more
+explicative and endearing descriptions found in L<perldiag>.  Like the
+other pragmata, it affects the compilation phase of your program rather
+than merely the execution phase.
+
+To use in your program as a pragma, merely invoke
+
+    use diagnostics;
+
+at the start (or near the start) of your program.  (Note 
+that this I<does> enable perl's B<-w> flag.)  Your whole
+compilation will then be subject(ed :-) to the enhanced diagnostics.
+These still go out B<STDERR>.
+
+Due to the interaction between runtime and compiletime issues,
+and because it's probably not a very good idea anyway,
+you may not use C<no diagnostics> to turn them off at compiletime.
+However, you may control their behaviour at runtime using the 
+disable() and enable() methods to turn them off and on respectively.
+
+The B<-verbose> flag first prints out the L<perldiag> introduction before
+any other diagnostics.  The $diagnostics::PRETTY variable can generate nicer
+escape sequences for pagers.
+
+Warnings dispatched from perl itself (or more accurately, those that match
+descriptions found in L<perldiag>) are only displayed once (no duplicate
+descriptions).  User code generated warnings a la warn() are unaffected,
+allowing duplicate user messages to be displayed.
+
+This module also adds a stack trace to the error message when perl dies.
+This is useful for pinpointing what caused the death. The B<-traceonly> (or
+just B<-t>) flag turns off the explanations of warning messages leaving just
+the stack traces. So if your script is dieing, run it again with
+
+  perl -Mdiagnostics=-traceonly my_bad_script
+
+to see the call stack at the time of death. By supplying the B<-warntrace>
+(or just B<-w>) flag, any warnings emitted will also come with a stack
+trace.
+
+=head2 The I<splain> Program
+
+While apparently a whole nuther program, I<splain> is actually nothing
+more than a link to the (executable) F<diagnostics.pm> module, as well as
+a link to the F<diagnostics.pod> documentation.  The B<-v> flag is like
+the C<use diagnostics -verbose> directive.
+The B<-p> flag is like the
+$diagnostics::PRETTY variable.  Since you're post-processing with 
+I<splain>, there's no sense in being able to enable() or disable() processing.
+
+Output from I<splain> is directed to B<STDOUT>, unlike the pragma.
+
+=head1 EXAMPLES
+
+The following file is certain to trigger a few errors at both
+runtime and compiletime:
+
+    use diagnostics;
+    print NOWHERE "nothing\n";
+    print STDERR "\n\tThis message should be unadorned.\n";
+    warn "\tThis is a user warning";
+    print "\nDIAGNOSTIC TESTER: Please enter a <CR> here: ";
+    my $a, $b = scalar <STDIN>;
+    print "\n";
+    print $x/$y;
+
+If you prefer to run your program first and look at its problem
+afterwards, do this:
+
+    perl -w test.pl 2>test.out
+    ./splain < test.out
+
+Note that this is not in general possible in shells of more dubious heritage, 
+as the theoretical 
+
+    (perl -w test.pl >/dev/tty) >& test.out
+    ./splain < test.out
+
+Because you just moved the existing B<stdout> to somewhere else.
+
+If you don't want to modify your source code, but still have on-the-fly
+warnings, do this:
+
+    exec 3>&1; perl -w test.pl 2>&1 1>&3 3>&- | splain 1>&2 3>&- 
+
+Nifty, eh?
+
+If you want to control warnings on the fly, do something like this.
+Make sure you do the C<use> first, or you won't be able to get
+at the enable() or disable() methods.
+
+    use diagnostics; # checks entire compilation phase 
+	print "\ntime for 1st bogus diags: SQUAWKINGS\n";
+	print BOGUS1 'nada';
+	print "done with 1st bogus\n";
+
+    disable diagnostics; # only turns off runtime warnings
+	print "\ntime for 2nd bogus: (squelched)\n";
+	print BOGUS2 'nada';
+	print "done with 2nd bogus\n";
+
+    enable diagnostics; # turns back on runtime warnings
+	print "\ntime for 3rd bogus: SQUAWKINGS\n";
+	print BOGUS3 'nada';
+	print "done with 3rd bogus\n";
+
+    disable diagnostics;
+	print "\ntime for 4th bogus: (squelched)\n";
+	print BOGUS4 'nada';
+	print "done with 4th bogus\n";
+
+=head1 INTERNALS
+
+Diagnostic messages derive from the F<perldiag.pod> file when available at
+runtime.  Otherwise, they may be embedded in the file itself when the
+splain package is built.   See the F<Makefile> for details.
+
+If an extant $SIG{__WARN__} handler is discovered, it will continue
+to be honored, but only after the diagnostics::splainthis() function 
+(the module's $SIG{__WARN__} interceptor) has had its way with your
+warnings.
+
+There is a $diagnostics::DEBUG variable you may set if you're desperately
+curious what sorts of things are being intercepted.
+
+    BEGIN { $diagnostics::DEBUG = 1 } 
+
+
+=head1 BUGS
+
+Not being able to say "no diagnostics" is annoying, but may not be
+insurmountable.
+
+The C<-pretty> directive is called too late to affect matters.
+You have to do this instead, and I<before> you load the module.
+
+    BEGIN { $diagnostics::PRETTY = 1 } 
+
+I could start up faster by delaying compilation until it should be
+needed, but this gets a "panic: top_level" when using the pragma form
+in Perl 5.001e.
+
+While it's true that this documentation is somewhat subserious, if you use
+a program named I<splain>, you should expect a bit of whimsy.
+
+=head1 AUTHOR
+
+Tom Christiansen <F<tchrist@mox.perl.com>>, 25 June 1995.
+
+=cut
+
+use strict;
+use 5.006;
+use Carp;
+$Carp::Internal{__PACKAGE__.""}++;
+
+our $VERSION = 1.15;
+our $DEBUG;
+our $VERBOSE;
+our $PRETTY;
+our $TRACEONLY = 0;
+our $WARNTRACE = 0;
+
+use Config;
+my($privlib, $archlib) = @Config{qw(privlibexp archlibexp)};
+if ($^O eq 'VMS') {
+    require VMS::Filespec;
+    $privlib = VMS::Filespec::unixify($privlib);
+    $archlib = VMS::Filespec::unixify($archlib);
+}
+my @trypod = (
+	   "$archlib/pod/perldiag.pod",
+	   "$privlib/pod/perldiag-$Config{version}.pod",
+	   "$privlib/pod/perldiag.pod",
+	   "$archlib/pods/perldiag.pod",
+	   "$privlib/pods/perldiag-$Config{version}.pod",
+	   "$privlib/pods/perldiag.pod",
+	  );
+# handy for development testing of new warnings etc
+unshift @trypod, "./pod/perldiag.pod" if -e "pod/perldiag.pod";
+(my $PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0];
+
+if ($^O eq 'MacOS') {
+    # just updir one from each lib dir, we'll find it ...
+    ($PODFILE) = grep { -e } map { "$_:pod:perldiag.pod" } @INC;
+}
+
+
+$DEBUG ||= 0;
+my $WHOAMI = ref bless [];  # nobody's business, prolly not even mine
+
+local $| = 1;
+local $_;
+
+my $standalone;
+my(%HTML_2_Troff, %HTML_2_Latin_1, %HTML_2_ASCII_7);
+
+CONFIG: {
+    our $opt_p = our $opt_d = our $opt_v = our $opt_f = '';
+
+    unless (caller) {
+	$standalone++;
+	require Getopt::Std;
+	Getopt::Std::getopts('pdvf:')
+	    or die "Usage: $0 [-v] [-p] [-f splainpod]";
+	$PODFILE = $opt_f if $opt_f;
+	$DEBUG = 2 if $opt_d;
+	$VERBOSE = $opt_v;
+	$PRETTY = $opt_p;
+    }
+
+    if (open(POD_DIAG, $PODFILE)) {
+	warn "Happy happy podfile from real $PODFILE\n" if $DEBUG;
+	last CONFIG;
+    } 
+
+    if (caller) {
+	INCPATH: {
+	    for my $file ( (map { "$_/$WHOAMI.pm" } @INC), $0) {
+		warn "Checking $file\n" if $DEBUG;
+		if (open(POD_DIAG, $file)) {
+		    while (<POD_DIAG>) {
+			next unless
+			    /^__END__\s*# wish diag dbase were more accessible/;
+			print STDERR "podfile is $file\n" if $DEBUG;
+			last INCPATH;
+		    }
+		}
+	    } 
+	}
+    } else { 
+	print STDERR "podfile is <DATA>\n" if $DEBUG;
+	*POD_DIAG = *main::DATA;
+    }
+}
+if (eof(POD_DIAG)) { 
+    die "couldn't find diagnostic data in $PODFILE @INC $0";
+}
+
+
+%HTML_2_Troff = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A\\*'",	#   capital A, acute accent
+    # etc
+
+);
+
+%HTML_2_Latin_1 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"\xC1"	#   capital A, acute accent
+
+    # etc
+);
+
+%HTML_2_ASCII_7 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A"	#   capital A, acute accent
+    # etc
+);
+
+our %HTML_Escapes;
+*HTML_Escapes = do {
+    if ($standalone) {
+	$PRETTY ? \%HTML_2_Latin_1 : \%HTML_2_ASCII_7; 
+    } else {
+	\%HTML_2_Latin_1; 
+    }
+}; 
+
+*THITHER = $standalone ? *STDOUT : *STDERR;
+
+my %transfmt = (); 
+my $transmo = <<EOFUNC;
+sub transmo {
+    #local \$^W = 0;  # recursive warnings we do NOT need!
+    study;
+EOFUNC
+
+my %msg;
+{
+    print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
+    local $/ = '';
+    local $_;
+    my $header;
+    my $for_item;
+    while (<POD_DIAG>) {
+
+	unescape();
+	if ($PRETTY) {
+	    sub noop   { return $_[0] }  # spensive for a noop
+	    sub bold   { my $str =$_[0];  $str =~ s/(.)/$1\b$1/g; return $str; } 
+	    sub italic { my $str = $_[0]; $str =~ s/(.)/_\b$1/g;  return $str; } 
+	    s/C<<< (.*?) >>>|C<< (.*?) >>|[BC]<(.*?)>/bold($+)/ges;
+	    s/[LIF]<(.*?)>/italic($1)/ges;
+	} else {
+	    s/C<<< (.*?) >>>|C<< (.*?) >>|[BC]<(.*?)>/$+/gs;
+	    s/[LIF]<(.*?)>/$1/gs;
+	} 
+	unless (/^=/) {
+	    if (defined $header) { 
+		if ( $header eq 'DESCRIPTION' && 
+		    (   /Optional warnings are enabled/ 
+		     || /Some of these messages are generic./
+		    ) )
+		{
+		    next;
+		}
+		s/^/    /gm;
+		$msg{$header} .= $_;
+	 	undef $for_item;	
+	    }
+	    next;
+	} 
+	unless ( s/=item (.*?)\s*\z//) {
+
+	    if ( s/=head1\sDESCRIPTION//) {
+		$msg{$header = 'DESCRIPTION'} = '';
+		undef $for_item;
+	    }
+	    elsif( s/^=for\s+diagnostics\s*\n(.*?)\s*\z// ) {
+		$for_item = $1;
+	    } 
+	    next;
+	}
+
+	if( $for_item ) { $header = $for_item; undef $for_item } 
+	else {
+	    $header = $1;
+	    while( $header =~ /[;,]\z/ ) {
+		<POD_DIAG> =~ /^\s*(.*?)\s*\z/;
+		$header .= ' '.$1;
+	    }
+	}
+
+	# strip formatting directives from =item line
+	$header =~ s/[A-Z]<(.*?)>/$1/g;
+
+        my @toks = split( /(%l?[dx]|%c|%(?:\.\d+)?s)/, $header );
+	if (@toks > 1) {
+            my $conlen = 0;
+            for my $i (0..$#toks){
+                if( $i % 2 ){
+                    if(      $toks[$i] eq '%c' ){
+                        $toks[$i] = '.';
+                    } elsif( $toks[$i] eq '%d' ){
+                        $toks[$i] = '\d+';
+                    } elsif( $toks[$i] eq '%s' ){
+                        $toks[$i] = $i == $#toks ? '.*' : '.*?';
+                    } elsif( $toks[$i] =~ '%.(\d+)s' ){
+                        $toks[$i] = ".{$1}";
+                     } elsif( $toks[$i] =~ '^%l*x$' ){
+                        $toks[$i] = '[\da-f]+';
+                   }
+                } elsif( length( $toks[$i] ) ){
+                    $toks[$i] =~ s/^.*$/\Q$&\E/;
+                    $conlen += length( $toks[$i] );
+                }
+            }  
+            my $lhs = join( '', @toks );
+	    $transfmt{$header}{pat} =
+              "    s{^$lhs}\n     {\Q$header\E}s\n\t&& return 1;\n";
+            $transfmt{$header}{len} = $conlen;
+	} else {
+            $transfmt{$header}{pat} =
+	      "    m{^\Q$header\E} && return 1;\n";
+            $transfmt{$header}{len} = length( $header );
+	} 
+
+	print STDERR "$WHOAMI: Duplicate entry: \"$header\"\n"
+	    if $msg{$header};
+
+	$msg{$header} = '';
+    } 
+
+
+    close POD_DIAG unless *main::DATA eq *POD_DIAG;
+
+    die "No diagnostics?" unless %msg;
+
+    # Apply patterns in order of decreasing sum of lengths of fixed parts
+    # Seems the best way of hitting the right one.
+    for my $hdr ( sort { $transfmt{$b}{len} <=> $transfmt{$a}{len} }
+                  keys %transfmt ){
+        $transmo .= $transfmt{$hdr}{pat};
+    }
+    $transmo .= "    return 0;\n}\n";
+    print STDERR $transmo if $DEBUG;
+    eval $transmo;
+    die $@ if $@;
+}
+
+if ($standalone) {
+    if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" } 
+    while (defined (my $error = <>)) {
+	splainthis($error) || print THITHER $error;
+    } 
+    exit;
+} 
+
+my $olddie;
+my $oldwarn;
+
+sub import {
+    shift;
+    $^W = 1; # yup, clobbered the global variable; 
+	     # tough, if you want diags, you want diags.
+    return if defined $SIG{__WARN__} && ($SIG{__WARN__} eq \&warn_trap);
+
+    for (@_) {
+
+	/^-d(ebug)?$/ 	   	&& do {
+				    $DEBUG++;
+				    next;
+				   };
+
+	/^-v(erbose)?$/ 	&& do {
+				    $VERBOSE++;
+				    next;
+				   };
+
+	/^-p(retty)?$/ 		&& do {
+				    print STDERR "$0: I'm afraid it's too late for prettiness.\n";
+				    $PRETTY++;
+				    next;
+			       };
+
+	/^-t(race)?$/ 		&& do {
+				    $TRACEONLY++;
+				    next;
+			       };
+	/^-w(arntrace)?$/ 		&& do {
+				    $WARNTRACE++;
+				    next;
+			       };
+
+	warn "Unknown flag: $_";
+    } 
+
+    $oldwarn = $SIG{__WARN__};
+    $olddie = $SIG{__DIE__};
+    $SIG{__WARN__} = \&warn_trap;
+    $SIG{__DIE__} = \&death_trap;
+} 
+
+sub enable { &import }
+
+sub disable {
+    shift;
+    return unless $SIG{__WARN__} eq \&warn_trap;
+    $SIG{__WARN__} = $oldwarn || '';
+    $SIG{__DIE__} = $olddie || '';
+} 
+
+sub warn_trap {
+    my $warning = $_[0];
+    if (caller eq $WHOAMI or !splainthis($warning)) {
+	if ($WARNTRACE) {
+	    print STDERR Carp::longmess($warning);
+	} else {
+	    print STDERR $warning;
+	}
+    } 
+    goto &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap;
+};
+
+sub death_trap {
+    my $exception = $_[0];
+
+    # See if we are coming from anywhere within an eval. If so we don't
+    # want to explain the exception because it's going to get caught.
+    my $in_eval = 0;
+    my $i = 0;
+    while (my $caller = (caller($i++))[3]) {
+      if ($caller eq '(eval)') {
+	$in_eval = 1;
+	last;
+      }
+    }
+
+    splainthis($exception) unless $in_eval;
+    if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; } 
+    &$olddie if defined $olddie and $olddie and $olddie ne \&death_trap;
+
+    return if $in_eval;
+
+    # We don't want to unset these if we're coming from an eval because
+    # then we've turned off diagnostics.
+
+    # Switch off our die/warn handlers so we don't wind up in our own
+    # traps.
+    $SIG{__DIE__} = $SIG{__WARN__} = '';
+
+    # Have carp skip over death_trap() when showing the stack trace.
+    local($Carp::CarpLevel) = 1;
+
+    confess "Uncaught exception from user code:\n\t$exception";
+	# up we go; where we stop, nobody knows, but i think we die now
+	# but i'm deeply afraid of the &$olddie guy reraising and us getting
+	# into an indirect recursion loop
+};
+
+my %exact_duplicate;
+my %old_diag;
+my $count;
+my $wantspace;
+sub splainthis {
+    return 0 if $TRACEONLY;
+    local $_ = shift;
+    local $\;
+    ### &finish_compilation unless %msg;
+    s/\.?\n+$//;
+    my $orig = $_;
+    # return unless defined;
+
+    # get rid of the where-are-we-in-input part
+    s/, <.*?> (?:line|chunk).*$//;
+
+    # Discard 1st " at <file> line <no>" and all text beyond
+    # but be aware of messsages containing " at this-or-that"
+    my $real = 0;
+    my @secs = split( / at / );
+    $_ = $secs[0];
+    for my $i ( 1..$#secs ){
+        if( $secs[$i] =~ /.+? (?:line|chunk) \d+/ ){
+            $real = 1;
+            last;
+        } else {
+            $_ .= ' at ' . $secs[$i];
+	}
+    }
+    
+    # remove parenthesis occurring at the end of some messages 
+    s/^\((.*)\)$/$1/;
+
+    if ($exact_duplicate{$orig}++) {
+	return &transmo;
+    } else {
+	return 0 unless &transmo;
+    }
+
+    $orig = shorten($orig);
+    if ($old_diag{$_}) {
+	autodescribe();
+	print THITHER "$orig (#$old_diag{$_})\n";
+	$wantspace = 1;
+    } else {
+	autodescribe();
+	$old_diag{$_} = ++$count;
+	print THITHER "\n" if $wantspace;
+	$wantspace = 0;
+	print THITHER "$orig (#$old_diag{$_})\n";
+	if ($msg{$_}) {
+	    print THITHER $msg{$_};
+	} else {
+	    if (0 and $standalone) { 
+		print THITHER "    **** Error #$old_diag{$_} ",
+			($real ? "is" : "appears to be"),
+			" an unknown diagnostic message.\n\n";
+	    }
+	    return 0;
+	} 
+    }
+    return 1;
+} 
+
+sub autodescribe {
+    if ($VERBOSE and not $count) {
+	print THITHER &{$PRETTY ? \&bold : \&noop}("DESCRIPTION OF DIAGNOSTICS"),
+		"\n$msg{DESCRIPTION}\n";
+    } 
+} 
+
+sub unescape { 
+    s {
+            E<  
+            ( [A-Za-z]+ )       
+            >   
+    } { 
+         do {   
+             exists $HTML_Escapes{$1}
+                ? do { $HTML_Escapes{$1} }
+                : do {
+                    warn "Unknown escape: E<$1> in $_";
+                    "E<$1>";
+                } 
+         } 
+    }egx;
+}
+
+sub shorten {
+    my $line = $_[0];
+    if (length($line) > 79 and index($line, "\n") == -1) {
+	my $space_place = rindex($line, ' ', 79);
+	if ($space_place != -1) {
+	    substr($line, $space_place, 1) = "\n\t";
+	} 
+    } 
+    return $line;
+} 
+
+
+1 unless $standalone;  # or it'll complain about itself
+__END__ # wish diag dbase were more accessible
+
+__END__
+:endofperl

Perl/bin/stubmaker.bat

@@ -0,0 +1,43 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/bin/env perl 
+#line 15
+#!d:\perl\bin\perl.exe 
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+print "Accessing...\n";
+my $schema = SOAP::Schema
+  -> schema(shift or die "Usage: $0 <URL with schema description> [<service> [<port>]]\n")
+  -> parse(@ARGV);
+
+print "Writing...\n";
+foreach (keys %{$schema->services}) {
+  my $file = "./$_.pm";
+  print("$file exists, skipped...\n"), next if -s $file;
+  open(F, ">$file") or die $!;
+  print F $schema->stub($_);
+  close(F) or die $!;
+  print "$file done\n";
+}
+
+# try
+# > perl stubmaker.pl http://www.xmethods.net/sd/StockQuoteService.wsdl
+
+# then
+# > perl "-MStockQuoteService qw(:all)" -le "print getQuote('MSFT')" 
+
+__END__
+:endofperl

Perl/bin/stubmaker.pl

@@ -0,0 +1,27 @@
+#!/bin/env perl 
+#!d:\perl\bin\perl.exe 
+
+# -- SOAP::Lite -- soaplite.com -- Copyright (C) 2001 Paul Kulchenko --
+
+use SOAP::Lite;
+
+print "Accessing...\n";
+my $schema = SOAP::Schema
+  -> schema(shift or die "Usage: $0 <URL with schema description> [<service> [<port>]]\n")
+  -> parse(@ARGV);
+
+print "Writing...\n";
+foreach (keys %{$schema->services}) {
+  my $file = "./$_.pm";
+  print("$file exists, skipped...\n"), next if -s $file;
+  open(F, ">$file") or die $!;
+  print F $schema->stub($_);
+  close(F) or die $!;
+  print "$file done\n";
+}
+
+# try
+# > perl stubmaker.pl http://www.xmethods.net/sd/StockQuoteService.wsdl
+
+# then
+# > perl "-MStockQuoteService qw(:all)" -le "print getQuote('MSFT')" 

Perl/bin/tkjpeg

@@ -0,0 +1,67 @@
+#!/usr/local/bin/perl -w
+use strict;
+use Tk;
+use Tk::JPEG;
+use Getopt::Std;
+eval { require Tk::PNG; };
+
+my $mw  = MainWindow->new();
+print "vis=",$mw->visual," d=",$mw->depth,"\n";
+my ($vis) = grep(!/\b8\b/,grep(/truecolor/,$mw->visualsavailable));
+my @args = ();
+if ($vis)
+ {
+  # print $vis,"\n";
+  $mw->destroy;
+  $mw = MainWindow->new(-visual => $vis);
+ }
+else
+ {
+  @args = (-palette => '4/4/4');
+ }
+# print "vis=",$mw->visual," d=",$mw->depth,' "',join('" "',$mw->visualsavailable),"\"\n";
+my %opt;
+getopts('f:',\%opt);
+if ($opt{'f'})
+ {
+  push(@args,'-format' => $opt{'f'});
+ }
+unless (@ARGV)
+ {
+  warn "usage $0 [-f format] <imagefile>\n";
+  exit 1;
+ }
+my $file = shift;
+my $image = $mw->Photo(-file => $file, @args);
+#print join(' ',$image->formats),"\n";
+print "w=",$image->width," h=",$image->height,"\n";
+$mw->Label(-image => $image)->pack(-expand => 1, -fill => 'both');
+$mw->Button(-text => 'Quit', -command => [destroy => $mw])->pack;
+MainLoop;
+
+__END__
+
+=head1 NAME
+
+tkjpeg - simple JPEG viewer using perl/Tk
+
+=head1 SYNOPSIS
+
+  tkjpeg imagefile.jpg
+
+=head1 DESCRIPTION
+
+Very simplistic image viewer that loads JPEG image, (well actually
+anything for which Photo has a handler) and puts it into a
+Label for display.
+
+It tries to find a fullcolour visual to use if display is deeper than
+8-bit. (On 8-bit it uses a 4/4/4 palette.)
+
+=head1 AUTHOR
+
+Nick Ing-Simmons <nick@ing-simmons.net>
+
+=cut
+
+

Perl/bin/tkjpeg.bat

@@ -0,0 +1,83 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/local/bin/perl -w
+#line 15
+use strict;
+use Tk;
+use Tk::JPEG;
+use Getopt::Std;
+eval { require Tk::PNG; };
+
+my $mw  = MainWindow->new();
+print "vis=",$mw->visual," d=",$mw->depth,"\n";
+my ($vis) = grep(!/\b8\b/,grep(/truecolor/,$mw->visualsavailable));
+my @args = ();
+if ($vis)
+ {
+  # print $vis,"\n";
+  $mw->destroy;
+  $mw = MainWindow->new(-visual => $vis);
+ }
+else
+ {
+  @args = (-palette => '4/4/4');
+ }
+# print "vis=",$mw->visual," d=",$mw->depth,' "',join('" "',$mw->visualsavailable),"\"\n";
+my %opt;
+getopts('f:',\%opt);
+if ($opt{'f'})
+ {
+  push(@args,'-format' => $opt{'f'});
+ }
+unless (@ARGV)
+ {
+  warn "usage $0 [-f format] <imagefile>\n";
+  exit 1;
+ }
+my $file = shift;
+my $image = $mw->Photo(-file => $file, @args);
+#print join(' ',$image->formats),"\n";
+print "w=",$image->width," h=",$image->height,"\n";
+$mw->Label(-image => $image)->pack(-expand => 1, -fill => 'both');
+$mw->Button(-text => 'Quit', -command => [destroy => $mw])->pack;
+MainLoop;
+
+__END__
+
+=head1 NAME
+
+tkjpeg - simple JPEG viewer using perl/Tk
+
+=head1 SYNOPSIS
+
+  tkjpeg imagefile.jpg
+
+=head1 DESCRIPTION
+
+Very simplistic image viewer that loads JPEG image, (well actually
+anything for which Photo has a handler) and puts it into a
+Label for display.
+
+It tries to find a fullcolour visual to use if display is deeper than
+8-bit. (On 8-bit it uses a 4/4/4 palette.)
+
+=head1 AUTHOR
+
+Nick Ing-Simmons <nick@ing-simmons.net>
+
+=cut
+
+
+
+__END__
+:endofperl

Perl/bin/tkx-ed

@@ -0,0 +1,267 @@
+#!/usr/bin/perl -w
+
+# tkx-ed - Simple text editor
+
+use strict;
+
+use Tkx;
+use File::Basename qw(basename);
+
+(my $PROGNAME = $0) =~ s,.*[\\/],,;
+my $IS_AQUA = Tkx::tk_windowingsystem() eq "aqua";
+
+Tkx::package_require("BWidget");
+
+eval {
+    Tkx::package_require("style");
+    Tkx::style__use("as", -priority => 70);
+};
+if ($@) {
+    $@ =~ s/ at .*//;
+    warn "Using plain look: $@";
+}
+
+# state
+my $file = "";
+
+# set up main window
+my $mw = Tkx::widget->new(".");
+my $sw = $mw->new_ScrolledWindow();
+$sw->g_pack(
+    -fill => "both",
+    -expand => 1,
+);
+
+my($t, $tw);
+eval {
+    Tkx::package_require("ctext");
+    # A ctext's true text widget is a subwidget
+    $t = $sw->new_ctext();
+    $tw = $t->_kid("t");
+};
+if ($@) {
+    # fallback is the standard widget
+    $@ =~ s/ at .*//;
+    warn "Using plain text: $@";
+    $t = $sw->new_text();
+    $tw = $t;
+}
+$t->configure(
+    -bd => 1,
+    -undo => 1,
+    -wrap => "none",
+);
+
+$sw->setwidget($t);
+
+$mw->configure(-menu => mk_menu($mw));
+
+if (@ARGV) {
+    Tkx::after_idle([\&load, $ARGV[0]])
+}
+else {
+    new();
+}
+
+Tkx::MainLoop();
+exit;
+
+sub mk_menu {
+    my $mw = shift;
+    Tkx::option_add("*Menu.tearOff", 0);
+    my $m = $mw->new_menu();
+    my $fm = $m->new_menu();
+    my $em = $m->new_menu();
+    my $hm = $m->new_menu();
+
+    my $control = ($^O eq "darwin") ? "Command" : "Control";
+    my $ctrl    = ($^O eq "darwin") ? "Command-" : "Ctrl+";
+
+    $m->add_cascade(
+	-label => "File",
+	-menu => $fm,
+    );
+    $m->add_cascade(
+	-label => "Edit",
+	-menu => $em,
+    );
+    $m->add_cascade(
+	-label => "Help",
+	-menu => $hm,
+    );
+
+    # File menu
+    $fm->add_command(
+        -label => "New",
+	-accelerator => $ctrl . "N",
+        -command => \&new,
+    );
+    Tkx::bind("all", "<$control-n>", \&new);
+    $fm->add_command(
+        -label => "Open...",
+	-accelerator => $ctrl . "O",
+        -command => \&my_open,
+    );
+    Tkx::bind("all", "<$control-o>", \&my_open);
+    $fm->add_command(
+        -label => "Save",
+	-accelerator => $ctrl . "S",
+        -command => \&save,
+    );
+    Tkx::bind("all", "<$control-s>", \&save);
+    $fm->add_command(
+        -label => "Save As...",
+        -command => \&save_as,
+    );
+    unless ($IS_AQUA) {
+	$fm->add_command(
+	    -label => "Exit",
+	    -underline => 1,
+	    -accelerator => $ctrl . "Q",
+	    -command => [\&Tkx::destroy, $mw],
+	    );
+	Tkx::bind("all", "<$control-q>", [\&Tkx::destroy, $mw]);
+    }
+
+    # Edit menu
+    $em->add_command(
+	-label => "Cut",
+	-command => [\&Tkx::event_generate, $tw, "<<Cut>>"]
+    );
+    $em->add_command(
+	-label => "Copy",
+	-command => [\&Tkx::event_generate, $tw, "<<Copy>>"],
+    );
+    $em->add_command(
+	-label => "Paste",
+	-command => [\&Tkx::event_generate, $tw, "<<Paste>>"],
+    );
+
+    # Help menu
+
+    $hm->add_command(
+        -label => "View $PROGNAME source",
+        -command => sub { load(__FILE__) },
+    );
+
+    my $about_menu = $hm;
+    if ($IS_AQUA) {
+	# On Mac OS we want about box to appear in the application
+	# menu.  Anything added to a menu with the name "apple" will
+	# appear in this menu.
+    	$about_menu = $m->new_menu(
+	    -name => "apple",
+    	);
+    	$m->add_cascade(
+    	     -menu => $about_menu,
+    	);
+    }
+    $about_menu->add_command(
+	-label => "About $PROGNAME",
+        -command => sub {
+	    Tkx::tk___messageBox(
+	        -parent => $mw,
+                -title => "About \u$PROGNAME",
+                -type => "ok",
+                -icon => "info",
+                -message => "$PROGNAME v$Tkx::VERSION\n" .
+                            "Copyright 2005 ActiveState. " .
+                            "All rights reserved.",
+            );
+        },
+    );
+
+    return $m;
+}
+
+sub new {
+    $t->delete("1.0", "end");
+    set_file("");
+}
+
+sub my_open {
+    my $f = Tkx::tk___getOpenFile(
+        -parent => $mw,
+    );
+    load($f) if length $f;
+}
+
+sub load {
+    my $f = shift;
+    open(my $fh, "<:utf8", $f) || die "Can't open '$file': $!";
+    $t->delete("1.0", "end");
+    $t->insert("end", scalar do { local $/; <$fh> });
+    set_file($f);
+}
+
+sub set_file {
+    $file = shift;
+    update_title();
+}
+
+sub save {
+    return save_as() unless length $file;
+    _save($file);
+}
+
+sub save_as {
+    my $f = Tkx::tk___getSaveFile(
+        -parent => $mw,
+    );
+    if (length $f) {
+        _save($f);
+        set_file($f);
+    }
+}
+
+sub _save {
+    my $f = shift;
+    open(my $fh, ">", $f) || die "Can't open '$file': $!";
+    print $fh $t->get("1.0", "end - 1 char");
+    close($fh) || die "Can't write '$file': $!";
+}
+
+sub update_title {
+    my $title;
+    if (length $file) {
+	$title = basename($file);
+    }
+    else {
+	$title = "<no name>";
+    }
+    $title .= " - " . basename($0);
+    $mw->g_wm_title($title);
+}
+
+__END__
+
+=head1 NAME
+
+tkx-ed - Simple editor
+
+=head1 SYNOPSIS
+
+ tkx-ed [<file>]
+
+=head1 DESCRIPTION
+
+The F<tkx-ed> program is a simple text editor implemented with the
+C<Tkx> toolkit.  Its main purpose is to demonstrate how this kind of
+application is written, so please take a look at its source code.
+
+When the editor starts up it shows a blank page where you can start
+entering text directly.
+
+If a file name is passed on the command line then the editor will
+visit this file initially.
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Copyright 2005 ActiveState.  All rights reserved.
+
+=head1 SEE ALSO
+
+L<Tkx>

Perl/bin/tkx-ed.bat

@@ -0,0 +1,283 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl -w
+#line 15
+
+# tkx-ed - Simple text editor
+
+use strict;
+
+use Tkx;
+use File::Basename qw(basename);
+
+(my $PROGNAME = $0) =~ s,.*[\\/],,;
+my $IS_AQUA = Tkx::tk_windowingsystem() eq "aqua";
+
+Tkx::package_require("BWidget");
+
+eval {
+    Tkx::package_require("style");
+    Tkx::style__use("as", -priority => 70);
+};
+if ($@) {
+    $@ =~ s/ at .*//;
+    warn "Using plain look: $@";
+}
+
+# state
+my $file = "";
+
+# set up main window
+my $mw = Tkx::widget->new(".");
+my $sw = $mw->new_ScrolledWindow();
+$sw->g_pack(
+    -fill => "both",
+    -expand => 1,
+);
+
+my($t, $tw);
+eval {
+    Tkx::package_require("ctext");
+    # A ctext's true text widget is a subwidget
+    $t = $sw->new_ctext();
+    $tw = $t->_kid("t");
+};
+if ($@) {
+    # fallback is the standard widget
+    $@ =~ s/ at .*//;
+    warn "Using plain text: $@";
+    $t = $sw->new_text();
+    $tw = $t;
+}
+$t->configure(
+    -bd => 1,
+    -undo => 1,
+    -wrap => "none",
+);
+
+$sw->setwidget($t);
+
+$mw->configure(-menu => mk_menu($mw));
+
+if (@ARGV) {
+    Tkx::after_idle([\&load, $ARGV[0]])
+}
+else {
+    new();
+}
+
+Tkx::MainLoop();
+exit;
+
+sub mk_menu {
+    my $mw = shift;
+    Tkx::option_add("*Menu.tearOff", 0);
+    my $m = $mw->new_menu();
+    my $fm = $m->new_menu();
+    my $em = $m->new_menu();
+    my $hm = $m->new_menu();
+
+    my $control = ($^O eq "darwin") ? "Command" : "Control";
+    my $ctrl    = ($^O eq "darwin") ? "Command-" : "Ctrl+";
+
+    $m->add_cascade(
+	-label => "File",
+	-menu => $fm,
+    );
+    $m->add_cascade(
+	-label => "Edit",
+	-menu => $em,
+    );
+    $m->add_cascade(
+	-label => "Help",
+	-menu => $hm,
+    );
+
+    # File menu
+    $fm->add_command(
+        -label => "New",
+	-accelerator => $ctrl . "N",
+        -command => \&new,
+    );
+    Tkx::bind("all", "<$control-n>", \&new);
+    $fm->add_command(
+        -label => "Open...",
+	-accelerator => $ctrl . "O",
+        -command => \&my_open,
+    );
+    Tkx::bind("all", "<$control-o>", \&my_open);
+    $fm->add_command(
+        -label => "Save",
+	-accelerator => $ctrl . "S",
+        -command => \&save,
+    );
+    Tkx::bind("all", "<$control-s>", \&save);
+    $fm->add_command(
+        -label => "Save As...",
+        -command => \&save_as,
+    );
+    unless ($IS_AQUA) {
+	$fm->add_command(
+	    -label => "Exit",
+	    -underline => 1,
+	    -accelerator => $ctrl . "Q",
+	    -command => [\&Tkx::destroy, $mw],
+	    );
+	Tkx::bind("all", "<$control-q>", [\&Tkx::destroy, $mw]);
+    }
+
+    # Edit menu
+    $em->add_command(
+	-label => "Cut",
+	-command => [\&Tkx::event_generate, $tw, "<<Cut>>"]
+    );
+    $em->add_command(
+	-label => "Copy",
+	-command => [\&Tkx::event_generate, $tw, "<<Copy>>"],
+    );
+    $em->add_command(
+	-label => "Paste",
+	-command => [\&Tkx::event_generate, $tw, "<<Paste>>"],
+    );
+
+    # Help menu
+
+    $hm->add_command(
+        -label => "View $PROGNAME source",
+        -command => sub { load(__FILE__) },
+    );
+
+    my $about_menu = $hm;
+    if ($IS_AQUA) {
+	# On Mac OS we want about box to appear in the application
+	# menu.  Anything added to a menu with the name "apple" will
+	# appear in this menu.
+    	$about_menu = $m->new_menu(
+	    -name => "apple",
+    	);
+    	$m->add_cascade(
+    	     -menu => $about_menu,
+    	);
+    }
+    $about_menu->add_command(
+	-label => "About $PROGNAME",
+        -command => sub {
+	    Tkx::tk___messageBox(
+	        -parent => $mw,
+                -title => "About \u$PROGNAME",
+                -type => "ok",
+                -icon => "info",
+                -message => "$PROGNAME v$Tkx::VERSION\n" .
+                            "Copyright 2005 ActiveState. " .
+                            "All rights reserved.",
+            );
+        },
+    );
+
+    return $m;
+}
+
+sub new {
+    $t->delete("1.0", "end");
+    set_file("");
+}
+
+sub my_open {
+    my $f = Tkx::tk___getOpenFile(
+        -parent => $mw,
+    );
+    load($f) if length $f;
+}
+
+sub load {
+    my $f = shift;
+    open(my $fh, "<:utf8", $f) || die "Can't open '$file': $!";
+    $t->delete("1.0", "end");
+    $t->insert("end", scalar do { local $/; <$fh> });
+    set_file($f);
+}
+
+sub set_file {
+    $file = shift;
+    update_title();
+}
+
+sub save {
+    return save_as() unless length $file;
+    _save($file);
+}
+
+sub save_as {
+    my $f = Tkx::tk___getSaveFile(
+        -parent => $mw,
+    );
+    if (length $f) {
+        _save($f);
+        set_file($f);
+    }
+}
+
+sub _save {
+    my $f = shift;
+    open(my $fh, ">", $f) || die "Can't open '$file': $!";
+    print $fh $t->get("1.0", "end - 1 char");
+    close($fh) || die "Can't write '$file': $!";
+}
+
+sub update_title {
+    my $title;
+    if (length $file) {
+	$title = basename($file);
+    }
+    else {
+	$title = "<no name>";
+    }
+    $title .= " - " . basename($0);
+    $mw->g_wm_title($title);
+}
+
+__END__
+
+=head1 NAME
+
+tkx-ed - Simple editor
+
+=head1 SYNOPSIS
+
+ tkx-ed [<file>]
+
+=head1 DESCRIPTION
+
+The F<tkx-ed> program is a simple text editor implemented with the
+C<Tkx> toolkit.  Its main purpose is to demonstrate how this kind of
+application is written, so please take a look at its source code.
+
+When the editor starts up it shows a blank page where you can start
+entering text directly.
+
+If a file name is passed on the command line then the editor will
+visit this file initially.
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Copyright 2005 ActiveState.  All rights reserved.
+
+=head1 SEE ALSO
+
+L<Tkx>
+
+__END__
+:endofperl