Index: /for-distributions/trunk/DistDates
===================================================================
--- /for-distributions/trunk/DistDates	(revision 14265)
+++ /for-distributions/trunk/DistDates	(revision 14265)
@@ -0,0 +1,22 @@
+gsdl-2_35-distribution	Thu May 17 17:02:47 NZST 2001
+gsdl-2_35a-distribution	Thu Jun 14 10:27:07 NZST 2001
+gsdl-2_35b-distribution	Mon Jun 18 13:48:39 NZST 2001
+gsdl-2_35c-distribution	Tue Jun 19 15:38:19 NZST 2001
+gsdl-2_36-distribution	Thu Jul  5 15:29:53 NZST 2001
+gsdl-2_37-distribution-cdrom	Wed Nov 28 09:51:47 NZDT 2001
+gsdl-2_38-distribution	Fri May 17 12:18:13 NZST 2002
+gsdl-2_39-distribution	Mon Mar 10 11:53:56 NZDT 2003
+gsdl-2_40-distribution	Tue Jul  1 14:47:13 NZST 2003
+gsdl-2_41-distribution	Tue Dec  9 16:45:00 NZDT 2003
+gsdl-2_50-distribution	Wed Apr  7 13:54:07 NZST 2004
+gsdl-2_51-distribution	Thu Jun 17 16:23:09 NZST 2004
+gsdl-2_52-distribution	Wed Oct 20 17:27:23 NZDT 2004
+gsdl-2_53-distribution	Wed Mar  2 10:45:16 NZDT 2005
+gsdl-2_60-distribution	Wed Apr 13 13:47:29 NZST 2005
+gsdl-2_61-distribution	Tue Aug  2 13:39:01 NZST 2005
+gsdl-2_62-distribution	Thu Oct  6 12:30:14 NZDT 2005
+gsdl-2_63-distribution	Thu Feb  2 11:51:28 NZDT 2006
+gsdl-2_70-distribution	Mon Apr  3 20:10:31 NZDT 2006
+gsdl-2_70u-distribution	Mon May  1 09:52:54 NZST 2006
+gsdl-2_70w-distribution	Thu Jun  1 16:33:25 NZST 2006
+gsdl-2_71-distribution	Wed Oct 11 11:08:18 NZDT 2006
Index: /for-distributions/trunk/bin/script/create_distributions.pl
===================================================================
--- /for-distributions/trunk/bin/script/create_distributions.pl	(revision 14265)
+++ /for-distributions/trunk/bin/script/create_distributions.pl	(revision 14265)
@@ -0,0 +1,828 @@
+#!/usr/bin/perl -w
+
+
+BEGIN {
+    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
+    unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
+}
+
+
+# create_distributions.pl creates the following distribution source directories
+# from the gsdl directory pointed to by $GSDLHOME (although it uses the 
+# main CVS repository to get the latest source code distribution).
+
+# CDROM - main distribution source: gsdl-x.xx-cdrom
+# UNIX - some additional unix specific stuff: gsdl-x.xx-unix
+# These first two rely on InstallShield X installer to create the actual distributions (Windows/LInux/Mac, web and CD-ROM)
+# Source - a source distribution, which just needs to be tarred and gzipped up.
+
+#    creates ChangeLog using `cvs2cl.pl -P -F trunk -r -S -l "-d'date<tomorrow'"
+#    where date of last distribution is read from the last line of 
+#    $GSDLHOME/DistDates or from -ChangeLogDate command line option
+#    should use something like cvs2cl.pl ... -l "-r'last_tag' -r'this_tag'" but
+#    I can't get cvs to ignore files which contain neither last_tag or this_tag
+#    so ChangeLog contains lots of ancient stuff 
+
+#    creates a copy of everything in cvs repository in $tmpdir
+
+#    edits /tmp/gsdl/etc/VERSION, /tmp/gsdl/src/w32server/fnord.cpp
+#    and /tmp/gsdl/cgi-bin/gsdlsite.cfg to use new version number
+#    and default GSDLHOME
+
+# temporary working directory
+my $tmpdir = '/tmp/';
+
+# docs directory - up-to-date copy of everything to go in the docs directory 
+# (including the README.txt) is expected to live here
+my $docs_dir = '/home/nzdl/gsdl-docs';
+
+my $for_distributions_dir = '/home/nzdl/for-distributions';
+
+# where the windows binaries live (including library.exe and server.exe)
+# this currently relies on being a directory ending in "windows"
+my $winbin = "$ENV{'GSDLHOME'}/bin/windows";
+
+# ditto for linux binaries (don't forget getpw)
+my $linuxbin = "$ENV{'GSDLHOME'}/bin/linux";
+
+# ditto for Mac OS/X binaries
+my $macosxbin = "$ENV{'GSDLHOME'}/bin/darwin";
+
+my $cvsanon = ':pserver:cvs_anon@cvs.scms.waikato.ac.nz:2402/usr/local/global-cvs/gsdl-src';
+
+
+use strict;
+use parsargv;
+use util;
+
+use Cwd;
+
+
+sub print_usage {
+    print STDERR "\n";
+    print STDERR "create_distributions.pl: Packages up Greenstone distributions.\n\n";
+    print STDERR "  usage: $0 [options]\n\n";
+    print STDERR "  options:\n";
+    print STDERR "   -tmpdir                temporary directory to use instead of $tmpdir\n";
+    print STDERR "   -output_dir            directory to output distributions to\n";
+    print STDERR "   -version_num           version number of distribution (x.xx)\n";
+    print STDERR "   -cvs_tag               cvs tag from which to create distributions\n";
+    print STDERR "                          - if not set latest versions will be used.\n";
+    print STDERR "   -unesco                create unesco style release, i.e. only 4 languages enabled\n";
+    print STDERR "   -NoChangeLog           don't create ChangeLog\n";
+    print STDERR "   -UseExistingLog        use $ENV{'GSDLHOME'}/ChangeLog rather than creating one\n";
+    print STDERR "   -ChangeLogDate         date from which to begin ChangeLog - note that ChangeLog\n";
+    print STDERR "                          will always run from date to most recent commits, even if\n";
+    print STDERR "                          cvs_tag is for a previous revision\n\n";
+}
+
+&main ();
+
+my $newtmpdir;
+my $version_num;
+my $cvs_tag;
+my $unesco;
+my $nochangelog;
+my $useexistinglog;
+my $changelogdate;
+my $output_dir;
+
+sub main
+{
+    if (!parsargv::parse(\@ARGV, 
+			 'tmpdir/.*/', \$newtmpdir,
+			 'version_num/\d\.\d\d[a-z]?', \$version_num,
+			 'cvs_tag/.*/', \$cvs_tag,
+			 'unesco', \$unesco,
+			 'NoChangeLog', \$nochangelog,
+			 'UseExistingLog', \$useexistinglog,
+			 'ChangeLogDate/.*/', \$changelogdate,
+			 'output_dir/.*/', \$output_dir)) {
+	&print_usage();
+	die "\n";
+    }
+
+    $tmpdir = $newtmpdir if (defined $newtmpdir && -d $newtmpdir);
+    $output_dir = "." unless $output_dir =~ /\w/;
+    mkdir ($output_dir, 0777) unless -d $output_dir;
+
+    if ($cvs_tag !~ /\w/) {
+	$cvs_tag = $version_num;
+	$cvs_tag =~ s/\./\_/g;
+	$cvs_tag = "gsdl-" . $cvs_tag . "-distribution";
+    }
+
+    &create_changelog() unless ($nochangelog || $useexistinglog);
+    
+    # Export gsdl to $tmpdir
+    print STDERR "\nexporting gsdl to $tmpdir\n\n";
+    chdir($tmpdir);
+    `cvs -d $cvsanon export -D "1 second ago" gsdl`;
+    # use something like the following if you want a previous version
+    #`cvs -d $cvsanon export -r gsdl-2_70-distribution-branch gsdl`; 
+    
+    # Export gli to $tmpdir/gli
+    print STDERR "\nexporting gli to " . &util::filename_cat($tmpdir, "gsdl") . "\n\n";
+    chdir(&util::filename_cat($tmpdir, "gsdl"));
+    `cvs -d $cvsanon export -D "1 second ago" gli`;
+    # use something like the following if you want a previous version
+    #`cvs -d $cvsanon export -r gsdl-2_70-distribution-branch gli`;
+    
+    # Compile gli
+    &compile_gli();
+    
+    # Remove bits used by none of the distributions
+    &util::rm(&util::filename_cat($tmpdir, "gsdl", "packages", "cpan", "XML-Parser-2.27.tar.gz"));
+    
+    # copy ChangeLog into $tmpdir/gsdl
+    &util::cp(&util::filename_cat($ENV{'GSDLHOME'}, "ChangeLog"), 
+	      &util::filename_cat($tmpdir, "gsdl")) unless $nochangelog;
+    
+    # edit the VERSION and fnord.cpp files
+    &edit_files();
+    
+    &create_unix_distribution();
+    &create_source_distribution();
+    &create_cdrom_distribution();
+}
+
+
+sub compile_gli
+{
+    print STDERR "\ncompiling gli...\n";
+    chdir(&util::filename_cat($tmpdir, "gsdl", "gli"));
+    `./makegli.sh`;
+    
+    # JAR up the gli, then delete the class files
+    print STDERR "jarring gli...\n";
+    `./makejar.sh`;
+    &util::rm_r(&util::filename_cat($tmpdir, "gsdl", "gli", "jar"));
+    &util::rm(&util::filename_cat($tmpdir, "gsdl", "gli", "metadata.zip"));
+    &util::rm_r(&util::filename_cat($tmpdir, "gsdl", "gli", "classes", "org"));
+    
+    # Move the GLIServer.jar file created by makejar.sh into bin/java
+    &util::mv(&util::filename_cat($tmpdir, "gsdl", "gli", "GLIServer.jar"), 
+	      &util::filename_cat($tmpdir, "gsdl", "bin", "java"));
+
+    # Make the gli-client.zip file
+    chdir($tmpdir);
+    
+    # take a copy of GLI directory
+    &util::cp_r(&util::filename_cat($tmpdir, "gsdl", "gli"), $tmpdir);
+    
+    my $client_dirname = "gli-client-" . $version_num;
+    rename ("gli", $client_dirname);
+    chdir(&util::filename_cat($tmpdir, $client_dirname));
+
+    
+    # delete unnecessary stuff
+    `rm -rf clean.* document.* gems.* gli*.sh gli*.bat make*.sh make*.bat lib src`;
+    # make sure permissions are ok
+    `chmod a+x client-gli.sh client-gli.bat`;
+    chdir($tmpdir);
+    
+    # zip up the client
+    &zip($client_dirname, $client_dirname, $tmpdir, 1);
+    
+    # Move the zip file to the destination directory
+    
+    &util::cp(&util::filename_cat($tmpdir, "$client_dirname.zip"), $output_dir);
+    &util::rm_r(&util::filename_cat($tmpdir, $client_dirname));
+    &util::rm(&util::filename_cat($tmpdir, "$client_dirname.zip"));
+
+}
+
+sub create_unix_distribution
+{
+    print STDERR "Creating Unix distribution...\n";
+
+    my $unix_dist_dir = &util::filename_cat($output_dir, "gsdl-" . $version_num . "-unix");
+    mkdir ($unix_dist_dir, 0777);
+
+    # Web release has a slightly customised version of Install.sh
+    &util::cp(&util::filename_cat($tmpdir, "gsdl", "Install.sh"), $unix_dist_dir);
+    my $Install_sh_file = &util::filename_cat($unix_dist_dir, "Install.sh");
+    open (INSTALL_SH, $Install_sh_file) || die "Failed to open $Install_sh_file\n";
+    my $found = 0; my $line = ""; my $file = "";
+    while (defined ($line = <INSTALL_SH>)) {
+	if ($line =~ /^iscdrom=\"/) {
+	    $line = "iscdrom=\"no\"\n";
+	    $found = 1;
+	}
+	$file .= $line;
+    }
+    close INSTALL_SH;
+
+    if ($found != 1) {
+	die "Error while editing $Install_sh_file\n";
+    }
+
+    open (INSTALL_SH, ">$Install_sh_file") || die;
+    print INSTALL_SH $file;
+    close INSTALL_SH;
+}
+
+
+sub create_source_distribution
+{
+    print STDERR "Creating Source distribution...\n";
+
+    my $source_dist_dir = &util::filename_cat($output_dir, "gsdl-" . $version_num . "-src");
+    mkdir($source_dist_dir, 0777);
+
+    my $gsdldir = &util::filename_cat ($source_dist_dir, "gsdl");
+
+    # Copy the entire contents of the exported GSDL directory
+    my $tmpgsdldir = &util::filename_cat($tmpdir, "gsdl");
+    `cp -r $tmpgsdldir $source_dist_dir`;
+
+    # We want the COPYING file in the source distribution too
+    &util::cp(&util::filename_cat($docs_dir, "COPYING"), $gsdldir);
+
+    # We shouldn't distribute the GLI applet signed by us
+    if (-e &util::filename_cat($source_dist_dir, "gsdl", "bin", "java", "SignedGatherer.jar")) {
+	&util::rm(&util::filename_cat($source_dist_dir, "gsdl", "bin", "java", "SignedGatherer.jar"));
+    }
+
+    # We don't want the compiled GLI classes in the source distribution (or the GS3 scripts)
+    &util::rm(&util::filename_cat($source_dist_dir, "gsdl", "gli", ".greenstonestore"));
+    &util::rm(&util::filename_cat($source_dist_dir, "gsdl", "gli", "GLI.jar"));
+    &util::rm(&util::filename_cat($source_dist_dir, "gsdl", "gli", "gli4gs3.bat"));
+    &util::rm(&util::filename_cat($source_dist_dir, "gsdl", "gli", "gli4gs3.sh"));
+
+}
+
+
+sub create_cdrom_distribution
+{
+    print STDERR "Creating CD-ROM distribution...\n";
+
+    my $cdrom_dist_dir = &util::filename_cat ($output_dir, "gsdl-" . $version_num . "-cdrom");
+    mkdir ($cdrom_dist_dir, 0777);
+
+    # docs directory
+    &install_docs ($cdrom_dist_dir, 0);
+
+    # gsdl directory
+    &install_gsdl ($cdrom_dist_dir);
+
+    # gli directory (in gsdl)
+    &install_gli($cdrom_dist_dir, "cdrom");
+
+    # src directory
+    &install_src ($cdrom_dist_dir, "cdrom");
+
+    # Windows directory
+    &install_windows_specific ($cdrom_dist_dir, 1);
+
+    # Unix directory
+    &install_unix_specific ($cdrom_dist_dir);
+
+    # for the cd-rom we want to include the unbuilt bits of the demo collection too
+    #my $demodir = &util::filename_cat($cdrom_dist_dir, "gsdl", "collect", "demo");
+    #my $tmpdemo = &util::filename_cat($tmpdir, "gsdl", "collect", "demo");
+    #die "oops, no demo dir\n" unless -d $demodir;
+    #&util::cp (&util::filename_cat ($tmpdemo, "demo.col"), $demodir);
+    #&util::cp_r (&util::filename_cat ($tmpdemo, "import"), $demodir);
+    #&util::cp_r (&util::filename_cat ($tmpdemo, "metadata"), $demodir);
+
+    # collect directory, with documented example collections 
+    my $cdrom_collect_dir = &util::filename_cat ($cdrom_dist_dir, "collect");
+    mkdir($cdrom_collect_dir, 0777);
+
+    my $source_collect_dir = &util::filename_cat($for_distributions_dir, "collect");
+    my $target_collect_dir = &util::filename_cat($cdrom_dist_dir, "collect");
+
+    &util::cp_r(&util::filename_cat($source_collect_dir, "MARC-e"), $target_collect_dir);
+    &util::cp_r(&util::filename_cat($source_collect_dir, "authen-e"), $target_collect_dir);
+    &util::cp_r(&util::filename_cat($source_collect_dir, "cltbib-e"), $target_collect_dir);
+    &util::cp_r(&util::filename_cat($source_collect_dir, "cltext-e"), $target_collect_dir);
+    &util::cp_r(&util::filename_cat($source_collect_dir, "dls-e"), $target_collect_dir);
+    &util::cp_r(&util::filename_cat($source_collect_dir, "garish"), $target_collect_dir);
+    &util::cp_r(&util::filename_cat($source_collect_dir, "gsarch-e"), $target_collect_dir);
+    &util::cp_r(&util::filename_cat($source_collect_dir, "image-e"), $target_collect_dir);
+    &util::cp_r(&util::filename_cat($source_collect_dir, "isis-e"), $target_collect_dir);
+    &util::cp_r(&util::filename_cat($source_collect_dir, "oai-e"), $target_collect_dir);
+    &util::cp_r(&util::filename_cat($source_collect_dir, "wrdpdf-e"), $target_collect_dir);
+    &util::cp_r(&util::filename_cat($source_collect_dir, "dspace-e"), $target_collect_dir);
+    &util::cp_r(&util::filename_cat($source_collect_dir, "style-e"), $target_collect_dir);
+    &util::cp_r(&util::filename_cat($source_collect_dir, "pagedimg-e"), $target_collect_dir);
+
+    # Make sure the whole thing is user-writeable
+    `chmod -R u+rw $cdrom_dist_dir`;
+}
+
+
+# isweb is 1 if it's one of the web distributions (i.e. if we don't
+# want to install the manuals) - this shouldn't be called at all for
+# windows web installation as it doesn't use docs at all (not much 
+# point for self-extracting exe).
+sub install_docs {
+    my ($install_dir, $isweb) = @_;
+
+    # COPYING, README*.txt and Support.htm
+    &util::cp (&util::filename_cat($docs_dir, "COPYING"), $install_dir);
+    &util::cp (&util::filename_cat($docs_dir, "READMEen.txt"), $install_dir);
+    &util::cp (&util::filename_cat($docs_dir, "READMEes.txt"), $install_dir);
+    &util::cp (&util::filename_cat($docs_dir, "READMEfr.txt"), $install_dir);
+    &util::cp (&util::filename_cat($docs_dir, "READMEru.txt-cp1251"), $install_dir);
+    &util::cp (&util::filename_cat($docs_dir, "READMEru.txt-koi8-r"), $install_dir);
+    &util::cp (&util::filename_cat($docs_dir, "Support.htm"), $install_dir);
+
+    &force_windows_line_endings(&util::filename_cat($install_dir, "COPYING"));
+    &force_windows_line_endings(&util::filename_cat($install_dir, "READMEen.txt"));
+    &force_windows_line_endings(&util::filename_cat($install_dir, "READMEes.txt"));
+    &force_windows_line_endings(&util::filename_cat($install_dir, "READMEfr.txt"));
+
+    # The web distributions don't have any of the manuals
+    return if ($isweb);
+
+    # docs directory, but not any of the Word files or Latex files
+    &util::cp_r (&util::filename_cat($docs_dir, "docs"), $install_dir);
+    my $en_docs = &util::filename_cat ($install_dir, "docs", "english", "*.doc");
+    `rm $en_docs`;
+    my $es_docs = &util::filename_cat ($install_dir, "docs", "spanish", "*.doc");
+    `rm $es_docs`;
+    my $ru_docs = &util::filename_cat ($install_dir, "docs", "russian", "*.doc");
+    `rm $ru_docs`;
+    my $fr_latex = &util::filename_cat ($install_dir, "docs", "french", "latex");
+    `rm -r $fr_latex`;
+}
+
+
+sub install_gsdl {
+    my ($install_dir) = @_;
+
+    my $gsdldir = &util::filename_cat ($install_dir, "gsdl");
+    mkdir ($gsdldir, 0777);
+
+    my $gsdlbindir = &util::filename_cat ($gsdldir, "bin");
+    mkdir ($gsdlbindir, 0777);
+    &util::cp_r (&util::filename_cat ($tmpdir, "gsdl", "bin", "script"), $gsdlbindir);
+    &util::cp_r (&util::filename_cat ($tmpdir, "gsdl", "bin", "java"), $gsdlbindir);
+    &util::cp_r (&util::filename_cat ($tmpdir, "gsdl", "cgi-bin"), $gsdldir);
+    &util::cp_r (&util::filename_cat ($tmpdir, "gsdl", "collect"), $gsdldir);
+    &util::cp_r (&util::filename_cat ($tmpdir, "gsdl", "etc"), $gsdldir);
+
+    #Get the modified main.cfg file with only core language interfaces enabled
+    if ($unesco) {
+	&util::cp(&util::filename_cat($for_distributions_dir, "etc", "main.cfg"), &util::filename_cat($gsdldir, "etc"));
+    }
+    # Make sure everything in bin/script is executable
+    my $bin_script_dir = &util::filename_cat($gsdldir, "bin", "script");
+    `chmod a+x $bin_script_dir/*`;
+
+    # Make sure cgi scripts are executable
+    my $gliserver_script = &util::filename_cat($gsdldir, "cgi-bin", "gliserver.pl");
+    `chmod a+x $gliserver_script`;
+    # should we be doing these ones - usability feedback scripts ??
+    #my $perl_script = &util::filename_cat($gsdldir, "cgi-bin", "perl.cgi");
+    #`chmod a+x $perl_script`;
+    #my $readresults_script = &util::filename_cat($gsdldir, "cgi-bin", "readresults.cgi");
+    #`chmod a+x $readresults_script`;
+    #my $trackreport_script = &util::filename_cat($gsdldir, "cgi-bin", "trackreport.cgi");
+    #`chmod a+x $trackreport_script`;
+
+    &force_windows_line_endings(&util::filename_cat($gsdldir, "cgi-bin", "gsdlsite.cfg"));
+    &force_windows_line_endings(&util::filename_cat($gsdldir, "etc", "main.cfg"));
+    &force_windows_line_endings(&util::filename_cat($gsdldir, "etc", "oai.cfg"));
+
+    # Make sure certain files in the etc directory are writeable by everyone
+    my $error_txt_file = &util::filename_cat($gsdldir, "etc", "error.txt");
+    `chmod a+w $error_txt_file`;
+    my $history_db_file = &util::filename_cat($gsdldir, "etc", "history.db");
+    `chmod a+w $history_db_file`;
+    my $key_db_file = &util::filename_cat($gsdldir, "etc", "key.db");
+    `chmod a+w $key_db_file`;
+    my $main_cfg_file = &util::filename_cat($gsdldir, "etc", "main.cfg");
+    `chmod a+w $main_cfg_file`;
+    my $usage_txt_file = &util::filename_cat($gsdldir, "etc", "usage.txt");
+    `chmod a+w $usage_txt_file`;
+    my $users_db_file = &util::filename_cat($gsdldir, "etc", "users.db");
+    `chmod a+rw $users_db_file`;  # Readable too
+
+    # We shouldn't distribute the GLI applet signed by us
+    if (-e &util::filename_cat($gsdlbindir, "java", "SignedGatherer.jar")) {
+	&util::rm(&util::filename_cat($gsdlbindir, "java", "SignedGatherer.jar"));
+    }
+
+    &util::cp_r (&util::filename_cat ($tmpdir, "gsdl", "images"), $gsdldir);
+    &util::cp_r(&util::filename_cat ($tmpdir, "gsdl", "macros"), $gsdldir);
+    &util::cp_r (&util::filename_cat ($tmpdir, "gsdl", "mappings"), $gsdldir);
+    &util::cp_r (&util::filename_cat ($tmpdir, "gsdl", "perllib"), $gsdldir);
+
+    # Rename perllib/strings.properties to perllib/strings_en.properties
+    my $stringsrbfile = &util::filename_cat ($gsdldir, "perllib", "strings.properties");
+    &util::cp ($stringsrbfile, &util::filename_cat ($gsdldir, "perllib", "strings_en.properties"));
+    &util::rm ($stringsrbfile);
+    `touch $stringsrbfile`;
+
+    # Untar Ping.tgz and XML-Parser.tar.gz
+    my $wd = cwd;
+    chdir (&util::filename_cat($gsdldir, "perllib", "cpan"));
+    `tar xvzf Ping.tgz`;
+    unlink ("Ping.tgz");
+    &util::cp(&util::filename_cat($for_distributions_dir, "perllib", "cpan", "XML-Parser.tar.gz"),
+	      &util::filename_cat($gsdldir, "perllib", "cpan"));
+    `tar xvzf XML-Parser.tar.gz`;
+    unlink ("XML-Parser.tar.gz");
+    chdir ($wd);
+
+    # make sure that modelcol collection contains all the right 
+    # empty directories
+    my $modelindex = &util::filename_cat ($gsdldir, "collect", "modelcol", "index");
+    &util::mk_all_dir ($modelindex) unless -d $modelindex;
+    my $modelbuilding = &util::filename_cat ($gsdldir, "collect", "modelcol", "building");
+    &util::mk_all_dir ($modelbuilding) unless -d $modelbuilding;
+    my $modelarchives = &util::filename_cat ($gsdldir, "collect", "modelcol", "archives");
+    &util::mk_all_dir ($modelarchives) unless -d $modelarchives;
+    my $modelimport = &util::filename_cat ($gsdldir, "collect", "modelcol", "import");
+    &util::mk_all_dir ($modelimport) unless -d $modelimport;
+    my $modelperllib = &util::filename_cat ($gsdldir, "collect", "modelcol", "perllib");
+    &util::mk_all_dir ($modelperllib) unless -d $modelperllib;
+    my $modelimages = &util::filename_cat ($gsdldir, "collect", "modelcol", "images");
+    &util::mk_all_dir ($modelimages) unless -d $modelimages;
+
+    # demo collection needs to be pre-built
+    my $collectdir = &util::filename_cat ($gsdldir, "collect");
+    &util::rm_r (&util::filename_cat($collectdir, "demo"));
+    if (!&get_built_collection ("demo", $collectdir)) {
+	die "Couldn't get built version of demo collection\n";
+    }
+#******
+    if ($unesco) {
+	# Get modified version of demo collect.cfg file with only core language strings
+	&util::cp(&util::filename_cat($for_distributions_dir, "collect", "demo", "etc", "collect.cfg"),
+		  &util::filename_cat($collectdir, "demo", "etc"));
+    }
+}
+
+
+sub install_gli
+{
+    my ($install_dir, $type) = @_;
+
+    # Copy the Greenstone Librarian Interface
+    my $source_dir = &util::filename_cat($tmpdir, "gsdl", "gli");
+    my $target_dir = &util::filename_cat($install_dir, "gsdl");
+    &util::cp_r($source_dir, $target_dir);
+
+    my $gli_dir = &util::filename_cat($target_dir, "gli");
+    &force_windows_line_endings(&util::filename_cat($gli_dir, "READMEen.txt"));
+    &force_windows_line_endings(&util::filename_cat($gli_dir, "READMEes.txt"));
+    &force_windows_line_endings(&util::filename_cat($gli_dir, "READMEfr.txt"));
+
+    # Make Unix scripts executable
+    `chmod a+x $gli_dir/*.sh`;
+
+    # Copy dictionary.properties to dictionary_en.properties to prevent problems with non-English machines
+    &util::cp(&util::filename_cat($gli_dir, "classes", "dictionary.properties"),
+	      &util::filename_cat($gli_dir, "classes", "dictionary_en.properties"));
+
+    if ($unesco) {
+	# Copy the customised languages.xml file with only core languages enabled
+	&util::cp(&util::filename_cat($for_distributions_dir, "gli", "classes", "xml", "languages.xml"),
+		  &util::filename_cat($gli_dir, "classes", "xml"));
+    }
+    # Remove unwanted stuff - all distributions
+    &util::rm(&util::filename_cat($gli_dir, ".greenstonestore"));
+
+    # Don't need Greenstone 3 scripts
+    &util::rm(&util::filename_cat($gli_dir, "gli4gs3.bat"));
+    &util::rm(&util::filename_cat($gli_dir, "gli4gs3.sh"));
+
+    # Remove unwanted stuff - Unix distributions
+    if ($type eq "unix") {
+	# Don't need Windows scripts
+	&util::rm(&util::filename_cat($gli_dir, "clean.bat"));
+	&util::rm(&util::filename_cat($gli_dir, "document.bat"));
+	&util::rm(&util::filename_cat($gli_dir, "gems.bat"));
+	&util::rm(&util::filename_cat($gli_dir, "gli.bat"));
+	&util::rm(&util::filename_cat($gli_dir, "makegli.bat"));
+
+	# Don't need Windows utilities
+	&util::rm_r(&util::filename_cat($gli_dir, "winutil"));
+
+	# Don't need Windows README file
+	&util::rm(&util::filename_cat($gli_dir, "READMEru.txt-cp1251"));
+
+	# Rename Unix README file
+	&util::cp(&util::filename_cat($gli_dir, "READMEru.txt-koi8-r"),
+		  &util::filename_cat($gli_dir, "READMEru.txt"));
+	&util::rm(&util::filename_cat($gli_dir, "READMEru.txt-koi8-r"));
+    }
+
+    # Remove unwanted stuff - Windows distributions
+    if ($type eq "windows") {
+	# Don't need Unix scripts
+	&util::rm(&util::filename_cat($gli_dir, "clean.sh"));
+	&util::rm(&util::filename_cat($gli_dir, "document.sh"));
+	&util::rm(&util::filename_cat($gli_dir, "gems.sh"));
+	&util::rm(&util::filename_cat($gli_dir, "gli.sh"));
+	&util::rm(&util::filename_cat($gli_dir, "makegli.sh"));
+	&util::rm(&util::filename_cat($gli_dir, "makejar.sh"));
+    }
+}
+
+
+sub install_src {
+    my ($install_dir, $type) = @_;
+
+    my $srcdir = &util::filename_cat ($install_dir, "src");
+    my $srcwindir = &util::filename_cat ($srcdir, "Windows");
+    my $srcunixdir = &util::filename_cat ($srcdir, "Unix");
+    mkdir ($srcdir, 0777);
+    &util::cp_r (&util::filename_cat ($tmpdir, "gsdl", "lib"), $srcdir);
+    &util::cp_r (&util::filename_cat ($tmpdir, "gsdl", "packages"), $srcdir);
+    &util::cp_r (&util::filename_cat ($tmpdir, "gsdl", "src"), $srcdir);
+    &util::cp (&util::filename_cat ($tmpdir, "gsdl", "Install.txt"), $srcdir);
+    &force_windows_line_endings(&util::filename_cat($srcdir, "Install.txt"));
+
+    if ($type ne "unix") {
+	mkdir ($srcwindir, 0777);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "setup.bat"), $srcwindir);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "win32.mak"), $srcwindir);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "WIN32cfg.h"), $srcwindir);
+    }
+
+    if ($type ne "windows") {
+	mkdir ($srcunixdir, 0777);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "Makefile.in"), $srcunixdir);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "acconfig.h"), $srcunixdir);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "aclocal.m4"), $srcunixdir);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "config.h.in"), $srcunixdir);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "configtest.pl"), $srcunixdir);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "configure"), $srcunixdir);
+	# make sure configure and setup scripts are executable
+	my $configure_script = &util::filename_cat ($srcunixdir , "configure");
+	`chmod a+x $configure_script`;
+
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "configure.in"), $srcunixdir);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "config.sub"), $srcunixdir);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "config.guess"), $srcunixdir);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "install-sh"), $srcunixdir);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "setup.bash"), $srcunixdir);
+	&util::cp (&util::filename_cat ($tmpdir, "gsdl", "setup.csh"), $srcunixdir);
+	`chmod a+x $srcunixdir/setup.*`;
+
+	# get all the configure scripts
+	`cd $srcdir; find -name "configure" -exec chmod a+x {} \\; ; cd -`
+	
+    }
+}
+
+sub install_windows_specific {
+    my ($install_dir, $cd_rom) = @_;
+
+    my $windir = &util::filename_cat ($install_dir, "Windows");
+    my $winbindir = &util::filename_cat ($windir, "bin");
+    mkdir ($windir, 0777);
+    mkdir ($winbindir, 0777);
+    &util::cp_r ($winbin, $winbindir);
+
+    # make sure there aren't any CVS directories laying around
+    &remove_cvs_dirs ($windir);
+}
+
+sub install_unix_specific {
+    my ($install_dir) = @_;
+
+    my $unixdir = &util::filename_cat ($install_dir, "Unix");
+    my $unixbindir = &util::filename_cat ($unixdir, "bin");
+    mkdir ($unixdir, 0777);
+    mkdir ($unixbindir, 0777);
+    &util::cp (&util::filename_cat($tmpdir, "gsdl", "Install.sh"), $unixdir);
+
+    # make sure Install.sh is executable
+    my $install_sh = &util::filename_cat($unixdir, "Install.sh");
+    `chmod a+x $install_sh`;
+
+    # Get Linux binaries, and make sure they're all executable
+    &util::cp_r ($linuxbin, $unixbindir);
+    my $linuxbindir = &util::filename_cat($unixbindir, 'linux');
+    `chmod -R a+x $linuxbindir`;
+
+    # remove the non-static mgquery_old program from distributions
+    &util::rm(&util::filename_cat($linuxbindir, "mgquery_old"));
+
+    # Get Mac OS/X binaries, and make sure they're all executable
+    &util::cp_r ($macosxbin, $unixbindir);
+    my $macosxbindir = &util::filename_cat($unixbindir, 'darwin');
+    `chmod -R a+x $macosxbindir`;
+
+    # make sure there aren't any CVS directories laying around
+    &remove_cvs_dirs ($unixdir);
+}
+
+
+# gets all the right bits of a built collection from 
+# $GSDLHOME/collect and copies them to $collect_dir
+# returns 1 if successful, 0 if not
+sub get_built_collection {
+    my ($colname, $collect_dir) = @_;
+
+    my $from_dir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $colname);
+    if (!-d $from_dir) {
+	print STDERR "\nERROR: No collection at $from_dir\n";
+	return 0;
+    }
+    
+    my $to_dir = &util::filename_cat ($collect_dir, $colname);
+    mkdir ($to_dir, 0777) unless -d $to_dir;
+    
+    # get the built indexes
+    my $index_dir = &util::filename_cat ($from_dir, "index");
+    if (-d $index_dir) {
+	# if build.cfg exists we'll assume collection is built ok
+	if (-e &util::filename_cat ($index_dir, "build.cfg")) {
+	    &util::cp_r ($index_dir, $to_dir);
+	} else {
+	    print STDERR "\nERROR: no build.cfg at $index_dir (collection not built?)\n";
+	    rmdir ($to_dir);
+	    return 0;
+	}
+    } else {
+	print STDERR "\nERROR: collection at $from_dir appears unbuilt (no index directory)\n";
+	return 0;
+    }
+    &util::cp_r ($index_dir, $to_dir);
+    
+    # get the collect.cfg file
+    mkdir (&util::filename_cat($to_dir, "etc"), 0777);
+    &util::cp (&util::filename_cat($from_dir, "etc", "collect.cfg"),
+	       &util::filename_cat($to_dir, "etc"));
+
+    # get the .col file
+    &util::cp (&util::filename_cat($from_dir, "$colname.col"),
+	       $to_dir);
+    # get any other directories - import, metadata, images, macros, perllib
+    my $from_import = &util::filename_cat ($from_dir, "import");
+    &util::cp_r ($from_import, $to_dir) if -d $from_import;
+    my $from_metadata = &util::filename_cat ($from_dir, "metadata");
+    &util::cp_r ($from_metadata, $to_dir) if -d $from_metadata;
+    my $from_images = &util::filename_cat ($from_dir, "images");
+    &util::cp_r ($from_images, $to_dir) if -d $from_images;
+    my $from_macros = &util::filename_cat ($from_dir, "macros");
+    &util::cp_r ($from_macros, $to_dir) if -d $from_macros;
+    my $from_perllib = &util::filename_cat ($from_dir, "perllib");
+    &util::cp_r ($from_perllib, $to_dir) if -d $from_perllib;
+
+    # make sure there aren't any CVS directories laying around
+    &remove_cvs_dirs ($to_dir);
+
+    return 1;
+}
+
+sub force_windows_line_endings
+{
+    my ($filepath) = @_;
+
+    open(IN, "<$filepath");
+    my $text = join('', <IN>);
+    close(IN);
+
+    $text =~ s/\n\x0A/\n\x0D\x0A/g;
+    $text =~ s/([^\x0D])\x0A/$1\x0D\x0A/g;
+
+    open(OUT, ">$filepath");
+    print OUT "$text";
+    close(OUT);
+}
+
+
+sub create_changelog {
+
+    my ($tag, $date, $file);
+
+    my $datefile = &util::filename_cat ($for_distributions_dir, "DistDates");
+    if ($changelogdate !~ /\w/) {
+	# get date from for-distributions/DistDates (and update DistDates)
+	open (DATES, $datefile) || die "can't open $datefile\n";
+	my $line = "";
+	while (defined ($line = <DATES>)) {
+	    if ($line =~ /\w/) {
+		($tag, $date) = $line =~ /^(\S+)\t(.*)$/;
+		$changelogdate = $date unless ($tag eq $cvs_tag);
+	    }
+	    $file .= $line;
+	}
+	close DATES;
+    }
+
+    if ((!defined $tag) || ($tag ne $cvs_tag)) {
+	open (DATES, ">$datefile") || die;
+	print DATES $file if defined $file;
+	print DATES "$cvs_tag\t" . `date`;
+	close DATES;
+    }
+
+    print STDERR "Creating ChangeLog from $changelogdate to most recent\n";
+
+    chdir($ENV{'GSDLHOME'});
+    my $cmd = "$for_distributions_dir/bin/script/cvs2cl.pl -P -F trunk -r -S -l \"-d'$changelogdate<tomorrow'\"";
+    system ($cmd);
+}
+
+# simply recurses directory structure beginning at $dir
+# and deletes any CVS administrative directories it comes 
+# across
+sub remove_cvs_dirs {
+    my ($dir) = @_;
+
+    if (!-d $dir) {return;}
+
+    opendir (DIR, $dir) || die;
+    my @files = readdir DIR;
+    closedir DIR;
+
+    foreach my $file (@files) {
+	next if $file =~ /^\.\.?$/;
+	my $fullpath = &util::filename_cat ($dir, $file);
+	if (-d $fullpath) {
+	    if ($file eq "CVS") {
+		&util::rm_r ($fullpath);
+	    } else {
+		&remove_cvs_dirs ($fullpath);
+	    }
+	}
+    }
+}
+
+# mode is 0 to create .zip and .tgz, 1 to create .zip only, and 2 to create
+# .tgz only
+sub zip {
+    my ($zip_to, $zip_from, $dir, $mode) = @_; 
+
+    chdir ($dir);
+
+    if ($mode != 2) {
+	my $to = $zip_to . ".zip";
+	unlink ($to) if -e $to;
+	print STDERR "zipping up $to\n";
+	`zip -r $to $zip_from`;
+    }
+    if ($mode != 1) {
+	my $to = $zip_to . ".tgz";
+	unlink ($to) if -e $to;
+	print STDERR "tarring and gzipping $to\n";
+	print STDERR "tar cvzf $to $zip_from\n";
+	system ("tar cvzf $to $zip_from");
+    }
+}
+
+sub edit_files {
+    # edit VERSION file
+    my $version_file = &util::filename_cat ($tmpdir, "gsdl", "etc" , "VERSION");
+    open (VERSION, $version_file) || die "failed to open $version_file\n";
+    my $found = 0; my $line = ""; my $file = "";
+    while (defined ($line = <VERSION>)) {
+	if ($line =~ s/(gsdl version: )x\.xx/$1$version_num/) {
+	    $found ++;
+	} elsif ($line =~ s/(cvs tag: )gsdl-x_xx-distribution/$1$cvs_tag/) {
+	    $found ++;
+	}
+	$file .= $line;
+    }
+    close VERSION;
+    if ($found != 2) {
+	die "error while editing $version_file\n";
+    } 
+    
+    open (VERSION, ">$version_file") || die;
+    print VERSION $file;
+    close VERSION;
+    
+    # edit gsdlconf.h
+    my $gsdlconf_file = &util::filename_cat ($tmpdir, "gsdl", "lib", "gsdlconf.h");
+    open (GSDLCONF, $gsdlconf_file) || die;
+    $found = 0; $line = ""; $file = "";
+    while (defined ($line = <GSDLCONF>)) {
+	if ($line =~ s/(\#define GSDL_VERSION \")x\.xx(\")/$1$version_num$2/) {
+	    $found ++;
+	}
+	$file .= $line;
+    }
+    close GSDLCONF;
+    if (!$found) {
+	die "error while editing $gsdlconf_file\n";
+    } 
+    
+    open (GSDLCONF, ">$gsdlconf_file") || die;
+    print GSDLCONF $file;
+    close GSDLCONF;
+}
+
+END {
+    # remove any temporary files we created
+    print STDERR "\ndeleting temporary files\n";
+    my $tmp_gsdlsite_file = &util::filename_cat ($tmpdir, "gsdlsite.cfg");
+    if (-e $tmp_gsdlsite_file) {
+	print STDERR "$tmp_gsdlsite_file\n";
+	unlink($tmp_gsdlsite_file);
+    }
+    my $tmp_gsdlhome = &util::filename_cat ($tmpdir, "gsdl");
+    if (-d $tmp_gsdlhome) {
+	print STDERR "$tmp_gsdlhome\n";
+	&util::rm_r ($tmp_gsdlhome);
+    }
+}
Index: /for-distributions/trunk/bin/script/cvs2cl.pl
===================================================================
--- /for-distributions/trunk/bin/script/cvs2cl.pl	(revision 14265)
+++ /for-distributions/trunk/bin/script/cvs2cl.pl	(revision 14265)
@@ -0,0 +1,1485 @@
+
+#!/bin/sh
+exec perl -w -x $0 ${1+"$@"} # -*- mode: perl; perl-indent-level: 2; -*-
+#!perl -w
+
+##############################################################
+###                                                        ###
+### cvs2cl.pl: produce ChangeLog(s) from `cvs log` output. ###
+###                                                        ###
+##############################################################
+
+## $Revision$
+## $Date$
+## $Author$
+##
+##   (C) 1999 Karl Fogel <kfogel@red-bean.com>, under the GNU GPL.
+##
+##   (Extensively hacked on by Melissa O'Neill <oneill@cs.sfu.ca>.)
+##
+## cvs2cl.pl is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## cvs2cl.pl is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You may have received a copy of the GNU General Public License
+## along with cvs2cl.pl; see the file COPYING.  If not, write to the
+## Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+## Boston, MA 02111-1307, USA.
+
+use strict;
+use Text::Wrap;
+use Time::Local;
+use File::Basename;
+
+# The Plan:
+#
+# Read in the logs for multiple files, spit out a nice ChangeLog that
+# mirrors the information entered during `cvs commit'.
+#
+# The problem presents some challenges. In an ideal world, we could
+# detect files with the same author, log message, and checkin time --
+# each <filelist, author, time, logmessage> would be a changelog entry.
+# We'd sort them; and spit them out.  Unfortunately, CVS is *not atomic*
+# so checkins can span a range of times.  Also, the directory structure
+# could be hierarchical.
+#
+# Another question is whether we really want to have the ChangeLog
+# exactly reflect commits. An author could issue two related commits,
+# with different log entries, reflecting a single logical change to the
+# source. GNU style ChangeLogs group these under a single author/date.
+# We try to do the same.
+#
+# So, we parse the output of `cvs log', storing log messages in a
+# multilevel hash that stores the mapping:
+#   directory => author => time => message => filelist
+# As we go, we notice "nearby" commit times and store them together
+# (i.e., under the same timestamp), so they appear in the same log
+# entry.
+#
+# When we've read all the logs, we twist this mapping into
+# a time => author => message => filelist mapping for each directory.
+#
+# If we're not using the `--distributed' flag, the directory is always
+# considered to be `./', even as descend into subdirectories.
+
+############### Globals ################
+
+# What we run to generate it:
+my $Log_Source_Command = "cvs log";
+
+# In case we have to print it out:
+my $VERSION = '$Revision$';
+$VERSION =~ s/\S+\s+(\S+)\s+\S+/$1/;
+
+## Vars set by options:
+
+# Print debugging messages?
+my $Debug = 0;
+
+# Just show version and exit?
+my $Print_Version = 0;
+
+# Just print usage message and exit?
+my $Print_Usage = 0;
+
+# Single top-level ChangeLog, or one per subdirectory?
+my $Distributed = 0;
+
+# What file should we generate (defaults to "ChangeLog")?
+my $Log_File_Name = "ChangeLog";
+
+# Expand usernames to email addresses based on a map file?
+my $User_Map_File = "";
+
+# Output to a file or to stdout?
+my $Output_To_Stdout = 0;
+
+# Eliminate empty log messages?
+my $Prune_Empty_Msgs = 0;
+
+# Don't call Text::Wrap on the body of the message
+my $No_Wrap = 0;
+
+# Separates header from log message
+my $After_Header = " ";
+
+# Format more for programs than for humans.
+my $XML_Output = 0;
+
+# Show times in UTC instead of local time
+my $UTC_Times = 0;
+
+# Show day of week in output?
+my $Show_Day_Of_Week = 0;
+
+# Show revision numbers in output?
+my $Show_Revisions = 0;
+
+# Show tags (symbolic names) in output?
+my $Show_Tags = 0;
+
+# Show branches by symbolic name in output?
+my $Show_Branches = 0;
+
+# Show only revisions on these branches or their ancestors.
+my @Follow_Branches;
+
+# Don't bother with files matching this regexp.
+my @Ignore_Files;
+
+# How exactly we match entries.  We definitely want "o",
+# and user might add "i" by using --case-insensitive option.
+my $Case_Insensitive = 0;
+
+# Maybe only show log messages matching a certain regular expression.
+my $Regexp_Gate = "";
+
+# Pass this global option string along to cvs, to the left of `log':
+my $Global_Opts = "";
+
+# Pass this option string along to the cvs log subcommand:
+my $Command_Opts = "";
+
+# Read log output from stdin instead of invoking cvs log?
+my $Input_From_Stdin = 0;
+
+# Max checkin duration. CVS checkin is not atomic, so we may have checkin
+# times that span a range of time. We assume that checkins will last no
+# longer than $Max_Checkin_Duration seconds, and that similarly, no
+# checkins will happen from the same users with the same message less
+# than $Max_Checkin_Duration seconds apart.
+my $Max_Checkin_Duration = 180;
+
+# What to put at the front of [each] ChangeLog.
+my $ChangeLog_Header = "";
+
+## end vars set by options.
+
+# In 'cvs log' output, one long unbroken line of equal signs separates
+# files:
+my $file_separator = "======================================="
+                   . "======================================";
+
+# In 'cvs log' output, a shorter line of dashes separates log messages
+# within a file:
+my $logmsg_separator = "----------------------------";
+
+############### End globals ############
+
+&parse_options ();
+&derive_change_log ();
+
+### Everything below is subroutine definitions. ###
+
+# Fills up a ChangeLog structure in the current directory.
+sub derive_change_log ()
+{
+  # See "The Plan" above for a full explanation.
+
+  my %grand_poobah;
+
+  my $file_full_path;
+  my $time;
+  my $revision;
+  my $author;
+  my $msg_txt;
+  my $detected_file_separator;
+
+  # We might be expanding usernames
+  my %usermap;
+
+  # In general, it's probably not very maintainable to use state
+  # variables like this to tell the loop what it's doing at any given
+  # moment, but this is only the first one, and if we never have more
+  # than a few of these, it's okay.
+  my $collecting_symbolic_names = 0;
+  my %symbolic_names;    # Where tag names get stored.
+  my %branch_names;      # We'll grab branch names while we're at it.
+  my %branch_numbers;    # Save some revisions for @Follow_Branches
+  my @branch_roots;      # For showing which files are branch ancestors.
+
+  if (! $Input_From_Stdin) {
+    open (LOG_SOURCE, "$Log_Source_Command |")
+        or die "unable to run \"${Log_Source_Command}\"";
+  }
+  else {
+    open (LOG_SOURCE, "-") or die "unable to open stdin for reading";
+  }
+
+  %usermap = &maybe_read_user_map_file ();
+
+  while (<LOG_SOURCE>)
+  {
+    # If on a new file and don't see filename, skip until we find it, and
+    # when we find it, grab it.
+    if ((! (defined $file_full_path)) and /^Working file: (.*)/) {
+      $file_full_path = $1;
+      if (@Ignore_Files) {
+        my $base;
+        ($base, undef, undef) = fileparse ($file_full_path);
+        # Ouch, I wish trailing operators in regexps could be
+        # evaluated on the fly!
+        if ($Case_Insensitive) {
+          if (grep ($file_full_path =~ m|$_|i, @Ignore_Files)) {
+            undef $file_full_path;
+          }
+        }
+        elsif (grep ($file_full_path =~ m|$_|, @Ignore_Files)) {
+          undef $file_full_path;
+        }
+      }
+      next;
+    }
+
+    # Just spin wheels if no file defined yet.
+    next if (! $file_full_path);
+
+    # Collect tag names in case we're asked to print them in the output.
+    if (/^symbolic names:$/) {
+      $collecting_symbolic_names = 1;
+      next;  # There's no more info on this line, so skip to next
+    }
+    if ($collecting_symbolic_names)
+    {
+      # All tag names are listed with whitespace in front in cvs log
+      # output; so if see non-whitespace, then we're done collecting.
+      if (/^\S/) {
+        $collecting_symbolic_names = 0;
+      }
+      else    # we're looking at a tag name, so parse & store it
+      {
+        # According to the Cederqvist manual, in node "Tags", tag
+        # names must start with an uppercase or lowercase letter and
+        # can contain uppercase and lowercase letters, digits, `-',
+        # and `_'.  However, it's not our place to enforce that, so
+        # we'll allow anything CVS hands us to be a tag:
+        /^\s([^:]+): ([\d.]+)$/;
+        my $tag_name = $1;
+        my $tag_rev  = $2;
+
+        # You can always tell a branch by the ".0." as the
+        # second-to-last digit in the revision number.
+        if ($tag_rev =~ /(\d+\.(\d+\.)+)0.(\d+)/) {
+          my $real_branch_rev = $1 . $3;
+          $branch_names{$real_branch_rev} = $tag_name;
+          if (@Follow_Branches) {
+            if (grep ($_ eq $tag_name, @Follow_Branches)) {
+              $branch_numbers{$tag_name} = $real_branch_rev;
+            }
+          }
+        }
+        else {
+          # Else it's just a regular (non-branch) tag.
+          push (@{$symbolic_names{$tag_rev}}, $tag_name);
+        }
+      }
+    }
+    # End of code for collecting tag names.
+
+    # If have file name, but not revision, and see revision, then grab
+    # it.  (We collect unconditionally, even though we may or may not
+    # ever use it.)
+    if ((! (defined $revision)) and (/^revision (\d+\.[\d.]+)/))
+    {
+      $revision = $1;
+
+      if (@Follow_Branches)
+      {
+        foreach my $branch (@Follow_Branches)
+        {
+          # Special case for following trunk revisions
+          if (($branch =~ /^trunk$/i) and ($revision =~ /^[0-9]+\.[0-9]+$/))
+          {
+            goto dengo;
+          }
+
+          my $branch_number = $branch_numbers{$branch};
+          if ($branch_number)
+          {
+            # Are we on one of the follow branches or an ancestor of
+            # same?
+            #
+            # If this revision is a prefix of the branch number, or
+            # possibly is less in the minormost number, OR if this
+            # branch number is a prefix of the revision, then yes.
+            # Otherwise, no.
+            #
+            # So below, we determine if any of those conditions are
+            # met.
+
+            # Trivial case: is this revision on the branch?
+            # (Compare this way to avoid regexps that screw up Emacs
+            # indentation, argh.)
+            if ((substr ($revision, 0, ((length ($branch_number)) + 1)))
+                eq ($branch_number . "."))
+            {
+              goto dengo;
+            }
+            # Non-trivial case: check if rev is ancestral to branch
+            elsif ((length ($branch_number)) > (length ($revision)))
+            {
+              $revision =~ /^([\d\.]+)(\d+)$/;
+              my $r_left = $1;          # still has the trailing "."
+              my $r_end = $2;
+
+              $branch_number =~ /^([\d\.]+)(\d+)\.\d+$/;
+              my $b_left = $1;  # still has trailing "."
+              my $b_mid  = $2;   # has no trailing "."
+
+              if (($r_left eq $b_left)
+                  && ($r_end <= $b_mid))
+              {
+                goto dengo;
+              }
+            }
+          }
+        }
+      }
+      else    # (! @Follow_Branches)
+      {
+        next;
+      }
+
+      # Else we are following branches, but this revision isn't on the
+      # path.  So skip it.
+      undef $revision;
+    dengo:
+      next;
+    }
+
+    # If we don't have a revision right now, we couldn't possibly
+    # be looking at anything useful.
+    if (! (defined ($revision))) {
+      $detected_file_separator = /^$file_separator$/o;
+      if ($detected_file_separator) {
+        # No revisions for this file; can happen, e.g. "cvs log -d DATE"
+        goto CLEAR;
+      }
+      else {
+        next;
+      }
+    }
+
+    # If have file name but not date and author, and see date or
+    # author, then grab them:
+    unless (defined $time) {
+      if (/^date: .*/)
+      {
+        ($time, $author) = &parse_date_and_author ($_);
+        if (defined ($usermap{$author}) and $usermap{$author}) {
+          $author = $usermap{$author};
+        }
+      }
+      else {
+        $detected_file_separator = /^$file_separator$/o;
+        if ($detected_file_separator) {
+          # No revisions for this file; can happen, e.g. "cvs log -d DATE"
+          goto CLEAR;
+        }
+      }
+      # If the date/time/author hasn't been found yet, we couldn't
+      # possibly care about anything we see.  So skip:
+      next;
+    }
+
+    # A "branches: ..." line here indicates that one or more branches
+    # are rooted at this revision.  If we're showing branches, then we
+    # want to show that fact as well, so we collect all the branches
+    # that this is the latest ancestor of and store them in
+    # @branch_roots.  Just for reference, the format of the line we're
+    # seeing at this point is:
+    #
+    #    branches:  1.5.2;  1.5.4;  ...;
+    #
+    # Okay, here goes:
+
+    if (/^branches:\s+(.*);$/)
+    {
+      if ($Show_Branches)
+      {
+        my $lst = $1;
+        $lst =~ s/(1\.)+1;|(1\.)+1$//;  # ignore the trivial branch 1.1.1
+        if ($lst) {
+          @branch_roots = split (/;\s+/, $lst);
+        }
+        else {
+          undef @branch_roots;
+        }
+        next;
+      }
+      else
+      {
+        # Ugh.  This really bothers me.  Suppose we see a log entry
+        # like this:
+        #
+        #    ----------------------------
+        #    revision 1.1
+        #    date: 1999/10/17 03:07:38;  author: jrandom;  state: Exp;
+        #    branches:  1.1.2;
+        #    Intended first line of log message begins here.
+        #    ----------------------------
+        #
+        # The question is, how we can tell the difference between that
+        # log message and a *two*-line log message whose first line is
+        #
+        #    "branches:  1.1.2;"
+        #
+        # See the problem?  The output of "cvs log" is inherently
+        # ambiguous.
+        #
+        # For now, we punt: we liberally assume that people don't
+        # write log messages like that, and just toss a "branches:"
+        # line if we see it but are not showing branches.  I hope no
+        # one ever loses real log data because of this.
+        next;
+      }
+    }
+
+    # If have file name, time, and author, then we're just grabbing
+    # log message texts:
+    $detected_file_separator = /^$file_separator$/o;
+    if ($detected_file_separator && ! (defined $revision)) {
+      # No revisions for this file; can happen, e.g. "cvs log -d DATE"
+      goto CLEAR;
+    }
+    unless ($detected_file_separator || /^$logmsg_separator$/o)
+    {
+      $msg_txt .= $_;   # Normally, just accumulate the message...
+      next;
+    }
+    # ... until a msg separator is encountered:
+    # Ensure the message contains something:
+    if ((! $msg_txt)
+        || ($msg_txt =~ /^\s*\.\s*$|^\s*$/)
+        || ($msg_txt =~ /\*\*\* empty log message \*\*\*/)) {
+      if ($Prune_Empty_Msgs) {
+        goto CLEAR;
+      }
+      # else
+      $msg_txt = "[no log message]\n";
+    }
+
+    ### Store it all in the Grand Poobah:
+    {
+      my $dir_key;        # key into %grand_poobah
+      my %qunk;           # complicated little jobbie, see below
+
+      # Each revision of a file has a little data structure (a `qunk')
+      # associated with it.  That data structure holds not only the
+      # file's name, but any additional information about the file
+      # that might be needed in the output, such as the revision
+      # number, tags, branches, etc.  The reason to have these things
+      # arranged in a data structure, instead of just appending them
+      # textually to the file's name, is that we may want to do a
+      # little rearranging later as we write the output.  For example,
+      # all the files on a given tag/branch will go together, followed
+      # by the tag in parentheses (so trunk or otherwise non-tagged
+      # files would go at the end of the file list for a given log
+      # message).  This rearrangement is a lot easier to do if we
+      # don't have to reparse the text.
+      #
+      # A qunk looks like this:
+      #
+      #   {
+      #     filename    =>    "hello.c",
+      #     revision    =>    "1.4.3.2",
+      #     time        =>    a timegm() return value (moment of commit)
+      #     tags        =>    [ "tag1", "tag2", ... ],
+      #     branch      =>    "branchname" # There should be only one, right?
+      #     branchroots =>    [ "branchtag1", "branchtag2", ... ]
+      #   }
+
+      if ($Distributed) {
+        # Just the basename, don't include the path.
+        ($qunk{'filename'}, $dir_key, undef) = fileparse ($file_full_path);
+      }
+      else {
+        $dir_key = "./";
+        $qunk{'filename'} = $file_full_path;
+      }
+
+      # This may someday be used in a more sophisticated calculation
+      # of what other files are involved in this commit.  For now, we
+      # don't use it, because the common-commit-detection algorithm is
+      # hypothesized to be "good enough" as it stands.
+      $qunk{'time'} = $time;
+
+      # We might be including revision numbers and/or tags and/or
+      # branch names in the output.  Most of the code from here to
+      # loop-end deals with organizing these in qunk.
+
+      $qunk{'revision'} = $revision;
+
+      # Grab the branch, even though we may or may not need it:
+      $qunk{'revision'} =~ /([\d.]+)\d+/;
+      my $branch_prefix = $1;
+      $branch_prefix =~ s/\.$//;  # strip off final dot
+      if ($branch_names{$branch_prefix}) {
+        $qunk{'branch'} = $branch_names{$branch_prefix};
+      }
+
+      # If there's anything in the @branch_roots array, then this
+      # revision is the root of at least one branch.  We'll display
+      # them as branch names instead of revision numbers, the
+      # substitution for which is done directly in the array:
+      if (@branch_roots) {
+        my @roots = map { $branch_names{$_} } @branch_roots;
+        $qunk{'branchroots'} = \@roots;
+      }
+
+      # Save tags too.
+      if (defined ($symbolic_names{$revision})) {
+        $qunk{'tags'} = $symbolic_names{$revision};
+        delete $symbolic_names{$revision};
+      }
+
+      # Add this file to the list
+      # (We use many spoonfuls of autovivication magic. Hashes and arrays
+      # will spring into existence if they aren't there already.)
+
+      &debug ("(pushing log msg for ${dir_key}$qunk{'filename'})\n");
+
+      # Store with the files in this commit.  Later we'll loop through
+      # again, making sure that revisions with the same log message
+      # and nearby commit times are grouped together as one commit.
+      push (@{$grand_poobah{$dir_key}{$author}{$time}{$msg_txt}}, \%qunk);
+    }
+
+  CLEAR:
+    # Make way for the next message
+    undef $msg_txt;
+    undef $time;
+    undef $revision;
+    undef $author;
+    undef @branch_roots;
+
+    # Maybe even make way for the next file:
+    if ($detected_file_separator) {
+      undef $file_full_path;
+      undef %branch_names;
+    }
+  }
+
+  close (LOG_SOURCE);
+
+  ### Process each ChangeLog
+
+  while (my ($dir,$authorhash) = each %grand_poobah)
+  {
+    &debug ("DOING DIR: $dir\n");
+
+    # Here we twist our hash around, from being
+    #   author => time => message => filelist
+    # in %$authorhash to
+    #   time => author => message => filelist
+    # in %changelog.
+    #
+    # This is also where we merge entries.  The algorithm proceeds
+    # through the timeline of the changelog with a sliding window of
+    # $Max_Checkin_Duration seconds; within that window, entries that
+    # have the same log message are merged.
+    #
+    # (To save space, we zap %$authorhash after we've copied
+    # everything out of it.)
+
+    my %changelog;
+    while (my ($author,$timehash) = each %$authorhash)
+    {
+      my $lasttime;
+      my %stamptime;
+      foreach my $time (sort {$main::a <=> $main::b} (keys %$timehash))
+      {
+        my $msghash = $timehash->{$time};
+        while (my ($msg,$qunklist) = each %$msghash)
+        {
+          my $stamptime = $stamptime{$msg};
+          if ((defined $stamptime)
+              and (($time - $stamptime) < $Max_Checkin_Duration)
+              and (defined $changelog{$stamptime}{$author}{$msg}))
+          {
+            push(@{$changelog{$stamptime}{$author}{$msg}}, @$qunklist);
+          }
+          else {
+            $changelog{$time}{$author}{$msg} = $qunklist;
+            $stamptime{$msg} = $time;
+          }
+        }
+      }
+    }
+    undef (%$authorhash);
+
+    ### Now we can write out the ChangeLog!
+
+    my ($logfile_here, $logfile_bak, $tmpfile);
+
+    if (! $Output_To_Stdout) {
+      $logfile_here =  $dir . $Log_File_Name;
+      $logfile_here =~ s/^\.\/\//\//;   # fix any leading ".//" problem
+      $tmpfile      = "${logfile_here}.cvs2cl$$.tmp";
+      $logfile_bak  = "${logfile_here}.bak";
+
+      open (LOG_OUT, ">$tmpfile") or die "Unable to open \"$tmpfile\"";
+    }
+    else {
+      open (LOG_OUT, ">-") or die "Unable to open stdout for writing";
+    }
+
+    print LOG_OUT $ChangeLog_Header;
+
+    if ($XML_Output) {
+      print LOG_OUT "<?xml version=\"1.0\"?>\n\n<changelog>\n\n";
+    }
+
+    foreach my $time (sort {$main::b <=> $main::a} (keys %changelog))
+    {
+      my $authorhash = $changelog{$time};
+      while (my ($author,$mesghash) = each %$authorhash)
+      {
+        while (my ($msg,$qunklist) = each %$mesghash)
+        {
+          my $files               = &pretty_file_list ($qunklist);
+          my $logtext             = &pretty_msg_text ($msg);
+          my $header_line;          # date and author
+          my $body;                 # see below
+          my $wholething;           # $header_line + $body
+
+          # Set up the date/author line.
+          # kff todo: do some more XML munging here, on the header
+          # part of the entry:
+          my ($ignore,$min,$hour,$mday,$mon,$year,$wday)
+              = $UTC_Times ? gmtime($time) : localtime($time);
+
+          # XML output includes everything else, we might as well make
+          # it always include Day Of Week too, for consistency.
+          if ($Show_Day_Of_Week or $XML_Output) {
+            $wday = ("Sunday", "Monday", "Tuesday", "Wednesday",
+                     "Thursday", "Friday", "Saturday")[$wday];
+            $wday = ($XML_Output) ? "<weekday>${wday}</weekday>\n" : " $wday";
+          }
+          else {
+            $wday = "";
+          }
+
+          if ($XML_Output) {
+            $author = &xml_escape ($author);
+            $header_line =
+                sprintf ("<date>%4u-%02u-%02u</date>\n"
+                         . "${wday}"
+                         . "<time>%02u:%02u</time>\n"
+                         . "<author>%s</author>\n",
+                         $year+1900, $mon+1, $mday, $hour, $min, $author);
+          }
+          else {
+            $header_line =
+                sprintf ("%4u-%02u-%02u${wday} %02u:%02u  %s\n\n",
+                         $year+1900, $mon+1, $mday, $hour, $min, $author);
+          }
+
+          # Reshape the body according to user preferences.
+          if ($XML_Output) {
+            $body = $files . $logtext;
+          }
+          elsif ($No_Wrap) {
+            $files = wrap ("\t", "      ", "$files");
+            $logtext =~ s/\n(.*)/\n\t$1/g;
+            unless ($After_Header eq " ") {
+              $logtext =~ s/^(.*)/\t$1/g;
+            }
+            $body = $files . $After_Header . $logtext;
+          }
+          else {
+            $body = $files . $After_Header . $logtext;
+            $body = wrap ("\t", "        ", "$body");
+          }
+
+          $wholething = $header_line . $body;
+
+          if ($XML_Output) {
+            $wholething = "<entry>\n${wholething}</entry>\n";
+          }
+
+          # One last check: make sure it passes the regexp test, if the
+          # user asked for that.  We have to do it here, so that the
+          # test can match against information in the header as well
+          # as in the text of the log message.
+
+          # How annoying to duplicate so much code just because I
+          # can't figure out a way to evaluate scalars on the trailing
+          # operator portion of a regular expression.  Grrr.
+          if ($Case_Insensitive) {
+            unless ($Regexp_Gate && ($wholething !~ /$Regexp_Gate/oi)) {
+              print LOG_OUT "${wholething}\n";
+            }
+          }
+          else {
+            unless ($Regexp_Gate && ($wholething !~ /$Regexp_Gate/o)) {
+              print LOG_OUT "${wholething}\n";
+            }
+          }
+        }
+      }
+    }
+
+    if ($XML_Output) {
+      print LOG_OUT "</changelog>\n";
+    }
+
+    close (LOG_OUT);
+
+    if (! $Output_To_Stdout)
+    {
+      if (-f $logfile_here) {
+        rename ($logfile_here, $logfile_bak);
+      }
+      rename ($tmpfile, $logfile_here);
+    }
+  }
+}
+
+sub parse_date_and_author ()
+{
+  # Parses the date/time and author out of a line like:
+  #
+  # date: 1999/02/19 23:29:05;  author: apharris;  state: Exp;
+
+  my $line = shift;
+
+  my ($year, $mon, $mday, $hours, $min, $secs, $author) = $line =~
+      m#(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);\s+author:\s+([^;]+);#
+          or  die "Couldn't parse date ``$line''";
+  die "Bad date or Y2K issues" unless ($year > 1969 and $year < 2258);
+  # Kinda arbitrary, but useful as a sanity check
+  my $time = timegm($secs,$min,$hours,$mday,$mon-1,$year-1900);
+
+  return ($time, $author);
+}
+
+# Here we take a bunch of qunks and convert them into printed
+# summary that will include all the information the user asked for.
+sub pretty_file_list ()
+{
+  my $qunksref = shift;
+  my @qunkrefs = @$qunksref;
+  my @filenames;
+  my $beauty = "";          # The accumulating header string for this entry.
+  my %non_unanimous_tags;   # Tags found in a proper subset of qunks
+  my %unanimous_tags;       # Tags found in all qunks
+  my %all_branches;         # Branches found in any qunk
+  my $common_dir;           # Dir of all files, or "" if no common dir
+  my $fbegun = 0;           # Did we begin printing filenames yet?
+
+  # First, loop over the qunks gathering all the tag/branch names.
+  # We'll put them all in non_unanimous_tags, and take out the
+  # unanimous ones later.
+  foreach my $qunkref (@qunkrefs)
+  {
+    # Keep track of whether all the files in this commit were in the
+    # same directory, and memorize it if so.  We can make the output a
+    # little more compact by mentioning the directory only once.
+    if ((scalar (@qunkrefs)) > 1)
+    {
+      if (! (defined ($common_dir))) {
+        my ($base, $dir);
+        ($base, $dir, undef) = fileparse ($$qunkref{'filename'});
+
+        if (($dir eq "./") || ($dir eq ".\\")) {
+          $common_dir = "";
+        }
+        else {
+          $common_dir = $dir;
+        }
+
+        ($dir eq "./") ? ($common_dir = "") : ($common_dir = $dir);
+      }
+      elsif ($common_dir) {
+        $common_dir = &common_path_prefix ($$qunkref{'filename'}, $common_dir);
+      }
+    }
+    else  # only one file in this entry anyway, so common dir not an issue
+    {
+      $common_dir = "";
+    }
+
+    if (defined ($$qunkref{'branch'})) {
+      $all_branches{$$qunkref{'branch'}} = 1;
+    }
+    if (defined ($$qunkref{'tags'})) {
+      foreach my $tag (@{$$qunkref{'tags'}}) {
+        $non_unanimous_tags{$tag} = 1;
+      }
+    }
+  }
+
+  # Any tag held by all qunks will be printed specially... but only if
+  # there are multiple qunks in the first place!
+  if ((scalar (@qunkrefs)) > 1) {
+    foreach my $tag (keys (%non_unanimous_tags)) {
+      my $everyone_has_this_tag = 1;
+      foreach my $qunkref (@qunkrefs) {
+        if ((! (defined ($$qunkref{'tags'})))
+            or (! (grep ($_ eq $tag, @{$$qunkref{'tags'}})))) {
+          $everyone_has_this_tag = 0;
+        }
+      }
+      if ($everyone_has_this_tag) {
+        $unanimous_tags{$tag} = 1;
+        delete $non_unanimous_tags{$tag};
+      }
+    }
+  }
+
+  if ($XML_Output)
+  {
+    # If outputting XML, then our task is pretty simple, because we
+    # don't have to detect common dir, common tags, branch prefixing,
+    # etc.  We just output exactly what we have, and don't worry about
+    # redundancy or readability.
+
+    foreach my $qunkref (@qunkrefs)
+    {
+      my $filename    = $$qunkref{'filename'};
+      my $revision    = $$qunkref{'revision'};
+      my $tags        = $$qunkref{'tags'};
+      my $branch      = $$qunkref{'branch'};
+      my $branchroots = $$qunkref{'branchroots'};
+
+      $filename = &xml_escape ($filename);   # probably paranoia
+      $revision = &xml_escape ($revision);   # definitely paranoia
+
+      $beauty .= "<file>\n";
+      $beauty .= "<name>${filename}</name>\n";
+      $beauty .= "<revision>${revision}</revision>\n";
+      if ($branch) {
+        $branch   = &xml_escape ($branch);     # more paranoia
+        $beauty .= "<branch>${branch}</branch>\n";
+      }
+      foreach my $tag (@$tags) {
+        $tag = &xml_escape ($tag);  # by now you're used to the paranoia
+        $beauty .= "<tag>${tag}</tag>\n";
+      }
+      foreach my $root (@$branchroots) {
+        $root = &xml_escape ($root);  # which is good, because it will continue
+        $beauty .= "<branchroot>${root}</branchroot>\n";
+      }
+      $beauty .= "</file>\n";
+    }
+
+    # Theoretically, we could go home now.  But as long as we're here,
+    # let's print out the common_dir and utags, as a convenience to
+    # the receiver (after all, earlier code calculated that stuff
+    # anyway, so we might as well take advantage of it).
+
+    if ((scalar (keys (%unanimous_tags))) > 1) {
+      foreach my $utag ((keys (%unanimous_tags))) {
+        $utag = &xml_escape ($utag);   # the usual paranoia
+        $beauty .= "<utag>${utag}</utag>\n";
+      }
+    }
+    if ($common_dir) {
+      $common_dir = &xml_escape ($common_dir);
+      $beauty .= "<commondir>${common_dir}</commondir>\n";
+    }
+
+    # That's enough for XML, time to go home:
+    return $beauty;
+  }
+
+  # Else not XML output, so complexly compactify for chordate
+  # consumption.  At this point we have enough global information
+  # about all the qunks to organize them non-redundantly for output.
+
+  if ($common_dir) {
+    # Note that $common_dir still has its trailing slash
+    $beauty .= "$common_dir: ";
+  }
+
+  if ($Show_Branches)
+  {
+    # For trailing revision numbers.
+    my @brevisions;
+
+    foreach my $branch (keys (%all_branches))
+    {
+      foreach my $qunkref (@qunkrefs)
+      {
+        if ((defined ($$qunkref{'branch'}))
+            and ($$qunkref{'branch'} eq $branch))
+        {
+          if ($fbegun) {
+            # kff todo: comma-delimited in XML too?  Sure.
+            $beauty .= ", ";
+          }
+          else {
+            $fbegun = 1;
+          }
+          my $fname = substr ($$qunkref{'filename'}, length ($common_dir));
+          $beauty .= $fname;
+          $$qunkref{'printed'} = 1;  # Just setting a mark bit, basically
+
+          if ($Show_Tags && (defined @{$$qunkref{'tags'}})) {
+            my @tags = grep ($non_unanimous_tags{$_}, @{$$qunkref{'tags'}});
+            if (@tags) {
+              $beauty .= " (tags: ";
+              $beauty .= join (', ', @tags);
+              $beauty .= ")";
+            }
+          }
+
+          if ($Show_Revisions) {
+            # Collect the revision numbers' last components, but don't
+            # print them -- they'll get printed with the branch name
+            # later.
+            $$qunkref{'revision'} =~ /.+\.([\d])+$/;
+            push (@brevisions, $1);
+
+            # todo: we're still collecting branch roots, but we're not
+            # showing them anywhere.  If we do show them, it would be
+            # nifty to just call them revision "0" on a the branch.
+            # Yeah, that's the ticket.
+          }
+        }
+      }
+      $beauty .= " ($branch";
+      if (@brevisions) {
+        if ((scalar (@brevisions)) > 1) {
+          $beauty .= ".[";
+          $beauty .= (join (',', @brevisions));
+          $beauty .= "]";
+        }
+        else {
+          $beauty .= ".$brevisions[0]";
+        }
+      }
+      $beauty .= ")";
+    }
+  }
+
+  # Okay; any qunks that were done according to branch are taken care
+  # of, and marked as printed.  Now print everyone else.
+
+  foreach my $qunkref (@qunkrefs)
+  {
+    next if (defined ($$qunkref{'printed'}));   # skip if already printed
+
+    if ($fbegun) {
+      $beauty .= ", ";
+    }
+    else {
+      $fbegun = 1;
+    }
+    $beauty .= substr ($$qunkref{'filename'}, length ($common_dir));
+    $$qunkref{'printed'} = 1;  # Set a mark bit.
+
+    if ($Show_Revisions || $Show_Tags)
+    {
+      my $started_addendum = 0;
+
+      if ($Show_Revisions) {
+        $started_addendum = 1;
+        $beauty .= " (";
+        $beauty .= "$$qunkref{'revision'}";
+      }
+      if ($Show_Tags && (defined $$qunkref{'tags'})) {
+        my @tags = grep ($non_unanimous_tags{$_}, @{$$qunkref{'tags'}});
+        if ((scalar (@tags)) > 0) {
+          if ($started_addendum) {
+            $beauty .= ", ";
+          }
+          else {
+            $beauty .= " (tags: ";
+          }
+          $beauty .= join (', ', @tags);
+          $started_addendum = 1;
+        }
+      }
+      if ($started_addendum) {
+        $beauty .= ")";
+      }
+    }
+  }
+
+  # Unanimous tags always come last.
+  if ($Show_Tags && %unanimous_tags)
+  {
+    $beauty .= " (utags: ";
+    $beauty .= join (', ', keys (%unanimous_tags));
+    $beauty .= ")";
+  }
+
+  # todo: still have to take care of branch_roots?
+
+  $beauty = "* $beauty:";
+
+  return $beauty;
+}
+
+sub common_path_prefix ()
+{
+  my $path1 = shift;
+  my $path2 = shift;
+
+  my ($dir1, $dir2);
+  (undef, $dir1, undef) = fileparse ($path1);
+  (undef, $dir2, undef) = fileparse ($path2);
+
+  # Transmogrify Windows filenames to look like Unix.
+  # (It is far more likely that someone is running cvs2cl.pl under
+  # Windows than that they would genuinely have backslashes in their
+  # filenames.)
+  $dir1 =~ tr#\\#/#;
+  $dir2 =~ tr#\\#/#;
+
+  my $accum1 = "";
+  my $accum2 = "";
+  my $last_common_prefix = "";
+
+  while ($accum1 eq $accum2)
+  {
+    $last_common_prefix = $accum1;
+    last if ($accum1 eq $dir1);
+    my ($tmp1) = split (/\//, (substr ($dir1, length ($accum1))));
+    my ($tmp2) = split (/\//, (substr ($dir2, length ($accum2))));
+    $accum1 .= "$tmp1/" if ((defined ($tmp1)) and $tmp1);
+    $accum2 .= "$tmp2/" if ((defined ($tmp2)) and $tmp2);
+  }
+
+  return $last_common_prefix;
+}
+
+sub pretty_msg_text ()
+{
+  my $text = shift;
+
+  # Strip out carriage returns (as they probably result from DOSsy editors).
+  $text =~ s/\r\n/\n/g;
+
+  # If it *looks* like two newlines, make it *be* two newlines:
+  $text =~ s/\n\s*\n/\n\n/g;
+
+  if ($XML_Output)
+  {
+    $text = &xml_escape ($text);
+    $text = "<msg>${text}</msg>\n";
+  }
+  elsif (! $No_Wrap)
+  {
+    # Strip off lone newlines, but only for lines that don't begin with
+    # whitespace or a mail-quoting character, since we want to preserve
+    # that kind of formatting.  Also don't strip newlines that follow a
+    # period; we handle those specially next.
+    1 while ($text =~ s/(^|\n)([^>\s].*[^.\n])\n([^>\n])/$1$2 $3/g);
+
+    # If a newline follows a period, make sure that when we bring up the
+    # bottom sentence, it begins with two spaces.
+    1 while ($text =~ s/(^|\n)([^>\s].*)\n([^>\n])/$1$2  $3/g);
+  }
+
+  return $text;
+}
+
+sub xml_escape ()
+{
+  my $txt = shift;
+  $txt =~ s/&/&amp;/g;
+  $txt =~ s/</&lt;/g;
+  $txt =~ s/>/&gt;/g;
+  return $txt;
+}
+
+sub maybe_read_user_map_file ()
+{
+  my %expansions;
+
+  if ($User_Map_File)
+  {
+    open (MAPFILE, "<$User_Map_File")
+        or die ("Unable to open $User_Map_File ($!)");
+
+    while (<MAPFILE>)
+    {
+      my ($username, $expansion) = split ':';
+      chomp $expansion;
+      $expansion =~ s/^'(.*)'$/$1/;
+      $expansion =~ s/^"(.*)"$/$1/;
+
+      # If it looks like the expansion has a real name already, then
+      # we toss the username we got from CVS log.  Otherwise, keep
+      # it to use in combination with the email address.
+
+      if ($expansion =~ /^\s*<{0,1}\S+@.*/) {
+        # Also, add angle brackets if none present
+        if (! ($expansion =~ /<\S+@\S+>/)) {
+          $expansions{$username} = "$username <$expansion>";
+        }
+        else {
+          $expansions{$username} = "$username $expansion";
+        }
+      }
+      else {
+        $expansions{$username} = $expansion;
+      }
+    }
+
+    close (MAPFILE);
+  }
+
+  return %expansions;
+}
+
+sub parse_options ()
+{
+  # Check this internally before setting the global variable.
+  my $output_file;
+
+  # If this gets set, we encountered unknown options and will exit at
+  # the end of this subroutine.
+  my $exit_with_admonishment = 0;
+
+  while (my $arg = shift (@ARGV))
+  {
+    if ($arg =~ /^-h$|^-help$|^--help$|^--usage$|^-?$/) {
+      $Print_Usage = 1;
+    }
+    elsif ($arg =~ /^--debug$/) {        # unadvertised option, heh
+      $Debug = 1;
+    }
+    elsif ($arg =~ /^--version$/) {
+      $Print_Version = 1;
+    }
+    elsif ($arg =~ /^-g$|^--global-opts$/) {
+      my $narg = shift (@ARGV) || die "$arg needs argument.\n";
+      # Don't assume CVS is called "cvs" on the user's system:
+      $Log_Source_Command =~ s/(^\S*)/$1 $narg/;
+    }
+    elsif ($arg =~ /^-l$|^--log-opts$/) {
+      my $narg = shift (@ARGV) || die "$arg needs argument.\n";
+      $Log_Source_Command .= " $narg";
+    }
+    elsif ($arg =~ /^-f$|^--file$/) {
+      my $narg = shift (@ARGV) || die "$arg needs argument.\n";
+      $output_file = $narg;
+    }
+    elsif ($arg =~ /^-U$|^--usermap$/) {
+      my $narg = shift (@ARGV) || die "$arg needs argument.\n";
+      $User_Map_File = $narg;
+    }
+    elsif ($arg =~ /^-W$|^--window$/) {
+      my $narg = shift (@ARGV) || die "$arg needs argument.\n";
+      $Max_Checkin_Duration = $narg;
+    }
+    elsif ($arg =~ /^-I$|^--ignore$/) {
+      my $narg = shift (@ARGV) || die "$arg needs argument.\n";
+      push (@Ignore_Files, $narg);
+    }
+    elsif ($arg =~ /^-C$|^--case-insensitive$/) {
+      $Case_Insensitive = 1;
+    }
+    elsif ($arg =~ /^-R$|^--regexp$/) {
+      my $narg = shift (@ARGV) || die "$arg needs argument.\n";
+      $Regexp_Gate = $narg;
+    }
+    elsif ($arg =~ /^--stdout$/) {
+      $Output_To_Stdout = 1;
+    }
+    elsif ($arg =~ /^--version$/) {
+      $Print_Version = 1;
+    }
+    elsif ($arg =~ /^-d$|^--distributed$/) {
+      $Distributed = 1;
+    }
+    elsif ($arg =~ /^-P$|^--prune$/) {
+      $Prune_Empty_Msgs = 1;
+    }
+    elsif ($arg =~ /^-S$|^--separate-header$/) {
+      $After_Header = "\n\n";
+    }
+    elsif ($arg =~ /^--no-wrap$/) {
+      $No_Wrap = 1;
+    }
+    elsif ($arg =~ /^--gmt$|^--utc$/) {
+      $UTC_Times = 1;
+    }
+    elsif ($arg =~ /^-w$|^--day-of-week$/) {
+      $Show_Day_Of_Week = 1;
+    }
+    elsif ($arg =~ /^-r$|^--revisions$/) {
+      $Show_Revisions = 1;
+    }
+    elsif ($arg =~ /^-t$|^--tags$/) {
+      $Show_Tags = 1;
+    }
+    elsif ($arg =~ /^-b$|^--branches$/) {
+      $Show_Branches = 1;
+    }
+    elsif ($arg =~ /^-F$|^--follow$/) {
+      my $narg = shift (@ARGV) || die "$arg needs argument.\n";
+      push (@Follow_Branches, $narg);
+    }
+    elsif ($arg =~ /^--stdin$/) {
+      $Input_From_Stdin = 1;
+    }
+    elsif ($arg =~ /^--header$/) {
+      my $narg = shift (@ARGV) || die "$arg needs argument.\n";
+      $ChangeLog_Header = &slurp_file ($narg);
+      if (! defined ($ChangeLog_Header)) {
+        $ChangeLog_Header = "";
+      }
+    }
+    elsif ($arg =~ /^--xml$/) {
+      $XML_Output = 1;
+    }
+    else {
+      # Just add a filename as argument to the log command
+      $Log_Source_Command .= " $arg";
+    }
+  }
+
+  ## Check for contradictions...
+
+  if ($Output_To_Stdout && $Distributed) {
+    print STDERR "cannot pass both --stdout and --distributed\n";
+    $exit_with_admonishment = 1;
+  }
+
+  if ($Output_To_Stdout && $output_file) {
+    print STDERR "cannot pass both --stdout and --file\n";
+    $exit_with_admonishment = 1;
+  }
+
+  # Or if any other error message has already been printed out, we
+  # just leave now:
+  if ($exit_with_admonishment) {
+    &usage ();
+    exit (1);
+  }
+  elsif ($Print_Usage) {
+    &usage ();
+    exit (0);
+  }
+  elsif ($Print_Version) {
+    &version ();
+    exit (0);
+  }
+
+  ## Else no problems, so proceed.
+
+  if ($Output_To_Stdout) {
+    undef $Log_File_Name;       # not actually necessary
+  }
+  elsif ($output_file) {
+    $Log_File_Name = $output_file;
+  }
+}
+
+sub slurp_file ()
+{
+  my $filename = shift || die ("no filename passed to slurp_file()");
+  my $retstr;
+
+  open (SLURPEE, "<${filename}") or die ("unable to open $filename ($!)");
+  my $saved_sep = $/;
+  undef $/;
+  $retstr = <SLURPEE>;
+  $/ = $saved_sep;
+  close (SLURPEE);
+  return $retstr;
+}
+
+sub debug ()
+{
+  if ($Debug) {
+    my $msg = shift;
+    print STDERR $msg;
+  }
+}
+
+sub version ()
+{
+  print "cvs2cl.pl version ${VERSION}; distributed under the GNU GPL.\n";
+}
+
+sub usage ()
+{
+  &version ();
+  print <<'END_OF_INFO';
+Generate GNU-style ChangeLogs in CVS working copies.
+
+Notes about the output format(s):
+
+   The default output of cvs2cl.pl is designed to be compact, formally
+   unambiguous, but still easy for humans to read.  It is largely
+   self-explanatory, I hope; the one abbreviation that might not be
+   obvious is "utags".  That stands for "universal tags" -- a
+   universal tag is one held by all the files in a given change entry.
+
+   If you need output that's easy for a program to parse, use the
+   --xml option.  Note that with XML output, just about all available
+   information is included with each change entry, whether you asked
+   for it or not, on the theory that your parser can ignore anything
+   it's not looking for.
+
+Notes about the options and arguments (the actual options are listed
+last in this usage message):
+
+  * The -I and -F options may appear multiple times.
+
+  * To follow trunk revisions, use "-F trunk" ("-F TRUNK" also works).
+    This is okay because no would ever, ever be crazy enough to name a
+    branch "trunk", right?  Right.
+
+  * For the -U option, the UFILE should be formatted like
+    CVSROOT/users. That is, each line of UFILE looks like this
+       jrandom:jrandom@red-bean.com
+    or maybe even like this
+       jrandom:'Jesse Q. Random <jrandom@red-bean.com>'
+    Don't forget to quote the portion after the colon if necessary.
+
+  * Many people want to filter by date.  To do so, invoke cvs2cl.pl
+    like this:
+       cvs2cl.pl -l "-d'DATESPEC'"
+    where DATESPEC is any date specification valid for "cvs log -d".
+    (Note that CVS 1.10.7 and below requires there be no space between
+    -d and its argument).
+
+Options/Arguments:
+
+  -h, -help, --help, or -?     Show this usage and exit
+  --version                    Show version and exit
+  -r, --revisions              Show revision numbers in output
+  -b, --branches               Show branch names in revisions when possible
+  -t, --tags                   Show tags (symbolic names) in output
+  --stdin                      Read from stdin, don't run cvs log
+  --stdout                     Output to stdout not to ChangeLog
+  -d, --distributed            Put ChangeLogs in subdirs
+  -f FILE, --file FILE         Write to FILE instead of "ChangeLog"
+  -W SECS, --window SECS       Window of time within which log entries unify
+  -U UFILE, --usermap UFILE    Expand usernames to email addresses from UFILE
+  -R REGEXP, --regexp REGEXP   Include only entries that match REGEXP
+  -I REGEXP, --ignore REGEXP   Ignore files whose names match REGEXP
+  -C, --case-insensitive       Any regexp matching is done case-insensitively
+  -F BRANCH, --follow BRANCH   Show only revisions on or ancestral to BRANCH
+  -S, --separate-header        Blank line between each header and log message
+  --no-wrap                    Don't auto-wrap log message (recommend -S also)
+  --gmt, --utc                 Show times in GMT/UTC instead of local time
+  -w, --day-of-week            Show day of week
+  --header FILE                Get ChangeLog header from FILE ("-" means stdin)
+  --xml                        Output XML instead of ChangeLog format
+  -P, --prune                  Don't show empty log messages
+  -g OPTS, --global-opts OPTS  Invoke like this "cvs OPTS log ..."
+  -l OPTS, --log-opts OPTS     Invoke like this "cvs ... log OPTS"
+  FILE1 [FILE2 ...]            Show only log information for the named FILE(s)
+
+See http://www.red-bean.com/~kfogel/cvs2cl.shtml for maintenance and bug info.
+END_OF_INFO
+}
+
+__END__
+
+=head1 NAME
+
+cvs2cl.pl - produces GNU-style ChangeLogs in CVS working copies, by
+    running "cvs log" and parsing the output.  Shared log entries are
+    unified in an intuitive way.
+
+=head1 DESCRIPTION
+
+This script generates GNU-style ChangeLog files from CVS log
+information.  Basic usage: just run it inside a working copy and a
+ChangeLog will appear.  It requires repository access (i.e., 'cvs log'
+must work).  Run "cvs2cl.pl --help" to see more advanced options.
+
+See http://www.red-bean.com/~kfogel/cvs2cl.shtml for updates, and
+for instructions on getting anonymous CVS access to this script.
+
+Maintainer: Karl Fogel <kfogel@red-bean.com>
+Please report bugs to <cvs2cl-bugs@red-bean.com>.
+
+=head1 README
+
+This script generates GNU-style ChangeLog files from CVS log
+information.  Basic usage: just run it inside a working copy and a
+ChangeLog will appear.  It requires repository access (i.e., 'cvs log'
+must work).  Run "cvs2cl.pl --help" to see more advanced options.
+
+See http://www.red-bean.com/~kfogel/cvs2cl.shtml for updates, and
+for instructions on getting anonymous CVS access to this script.
+
+Maintainer: Karl Fogel <kfogel@red-bean.com>
+Please report bugs to <cvs2cl-bugs@red-bean.com>.
+
+=head1 PREREQUISITES
+
+This script requires C<Text::Wrap>, C<Time::Local>, and
+C<File::Basename>.
+It also seems to require C<Perl 5.004_04> or higher.
+
+=pod OSNAMES
+
+any
+
+=pod SCRIPT CATEGORIES
+
+Version_Control/CVS
+
+=cut
+
+-*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*-
+
+Note about a bug-slash-opportunity:
+-----------------------------------
+
+There's a bug in Text::Wrap, which affects cvs2cl.  This script
+reveals it:
+
+  #!/usr/bin/perl -w
+
+  use Text::Wrap;
+
+  my $test_text =
+  "This script demonstrates a bug in Text::Wrap.  The very long line
+  following this paragraph will be relocated relative to the surrounding
+  text:
+
+  ====================================================================
+
+  See?  When the bug happens, we'll get the line of equal signs below
+  this paragraph, even though it should be above.";
+
+
+  # Print out the test text with no wrapping:
+  print "$test_text";
+  print "\n";
+  print "\n";
+
+  # Now print it out wrapped, and see the bug:
+  print wrap ("\t", "        ", "$test_text");
+  print "\n";
+  print "\n";
+
+If the line of equal signs were one shorter, then the bug doesn't
+happen.  Interesting.
+
+Anyway, rather than fix this in Text::Wrap, we might as well write a
+new wrap() which has the following much-needed features:
+
+* initial indentation, like current Text::Wrap()
+* subsequent line indentation, like current Text::Wrap()
+* user chooses among: force-break long words, leave them alone, or die()?
+* preserve existing indentation: chopped chunks from an indented line
+  are indented by same (like this line, not counting the asterisk!)
+* optional list of things to preserve on line starts, default ">"
+
+Note that the last two are essentially the same concept, so unify in
+implementation and give a good interface to controlling them.
+
+And how about:
+
+Optionally, when encounter a line pre-indented by same as previous
+line, then strip the newline and refill, but indent by the same.
+Yeah...
Index: /for-distributions/trunk/bin/windows/perl/lib/AnyDBM_File.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/AnyDBM_File.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/AnyDBM_File.pm	(revision 14265)
@@ -0,0 +1,92 @@
+package AnyDBM_File;
+
+use 5.005_64;
+our @ISA = qw(NDBM_File DB_File GDBM_File SDBM_File ODBM_File) unless @ISA;
+
+my $mod;
+for $mod (@ISA) {
+    if (eval "require $mod") {
+	@ISA = ($mod);	# if we leave @ISA alone, warnings abound
+	return 1;
+    }
+}
+
+die "No DBM package was successfully found or installed";
+#return 0;
+
+=head1 NAME
+
+AnyDBM_File - provide framework for multiple DBMs
+
+NDBM_File, DB_File, GDBM_File, SDBM_File, ODBM_File - various DBM implementations
+
+=head1 SYNOPSIS
+
+    use AnyDBM_File;
+
+=head1 DESCRIPTION
+
+This module is a "pure virtual base class"--it has nothing of its own.
+It's just there to inherit from one of the various DBM packages.  It
+prefers ndbm for compatibility reasons with Perl 4, then Berkeley DB (See
+L<DB_File>), GDBM, SDBM (which is always there--it comes with Perl), and
+finally ODBM.   This way old programs that used to use NDBM via dbmopen()
+can still do so, but new ones can reorder @ISA:
+
+    BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) }
+    use AnyDBM_File;
+
+Having multiple DBM implementations makes it trivial to copy database formats:
+
+    use POSIX; use NDBM_File; use DB_File;
+    tie %newhash,  'DB_File', $new_filename, O_CREAT|O_RDWR;
+    tie %oldhash,  'NDBM_File', $old_filename, 1, 0;
+    %newhash = %oldhash;
+
+=head2 DBM Comparisons
+
+Here's a partial table of features the different packages offer:
+
+                         odbm    ndbm    sdbm    gdbm    bsd-db
+			 ----	 ----    ----    ----    ------
+ Linkage comes w/ perl   yes     yes     yes     yes     yes
+ Src comes w/ perl       no      no      yes     no      no
+ Comes w/ many unix os   yes     yes[0]  no      no      no
+ Builds ok on !unix      ?       ?       yes     yes     ?
+ Code Size               ?       ?       small   big     big
+ Database Size           ?       ?       small   big?    ok[1]
+ Speed                   ?       ?       slow    ok      fast
+ FTPable                 no      no      yes     yes     yes
+ Easy to build          N/A     N/A      yes     yes     ok[2]
+ Size limits             1k      4k      1k[3]   none    none
+ Byte-order independent  no      no      no      no      yes
+ Licensing restrictions  ?       ?       no      yes     no
+
+
+=over 4
+
+=item [0] 
+
+on mixed universe machines, may be in the bsd compat library,
+which is often shunned.
+
+=item [1] 
+
+Can be trimmed if you compile for one access method.
+
+=item [2] 
+
+See L<DB_File>. 
+Requires symbolic links.  
+
+=item [3] 
+
+By default, but can be redefined.
+
+=back
+
+=head1 SEE ALSO
+
+dbm(3), ndbm(3), DB_File(3), L<perldbmfilter>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/AutoLoader.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/AutoLoader.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/AutoLoader.pm	(revision 14265)
@@ -0,0 +1,325 @@
+package AutoLoader;
+
+use 5.005_64;
+our(@EXPORT, @EXPORT_OK, $VERSION);
+
+my $is_dosish;
+my $is_epoc;
+my $is_vms;
+my $is_macos;
+
+BEGIN {
+    require Exporter;
+    @EXPORT = @EXPORT = ();
+    @EXPORT_OK = @EXPORT_OK = qw(AUTOLOAD);
+    $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32';
+    $is_epoc = $^O eq 'epoc';
+    $is_vms = $^O eq 'VMS';
+    $is_macos = $^O eq 'MacOS';
+    $VERSION = '5.58';
+}
+
+AUTOLOAD {
+    my $sub = $AUTOLOAD;
+    my $filename;
+    # Braces used to preserve $1 et al.
+    {
+	# Try to find the autoloaded file from the package-qualified
+	# name of the sub. e.g., if the sub needed is
+	# Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is
+	# something like '/usr/lib/perl5/Getopt/Long.pm', and the
+	# autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'.
+	#
+	# However, if @INC is a relative path, this might not work.  If,
+	# for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is
+	# 'lib/Getopt/Long.pm', and we want to require
+	# 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib').
+	# In this case, we simple prepend the 'auto/' and let the
+	# C<require> take care of the searching for us.
+
+	my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/);
+	$pkg =~ s#::#/#g;
+	if (defined($filename = $INC{"$pkg.pm"})) {
+	    if ($is_macos) {
+		$pkg =~ tr#/#:#;
+		$filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s;
+	    } else {
+		$filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s;
+	    }
+
+	    # if the file exists, then make sure that it is a
+	    # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al',
+	    # or './lib/auto/foo/bar.al'.  This avoids C<require> searching
+	    # (and failing) to find the 'lib/auto/foo/bar.al' because it
+	    # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib').
+
+	    if (-r $filename) {
+		unless ($filename =~ m|^/|s) {
+		    if ($is_dosish) {
+			unless ($filename =~ m{^([a-z]:)?[\\/]}is) {
+			     $filename = "./$filename";
+			}
+		    }
+		    elsif ($is_epoc) {
+			unless ($filename =~ m{^([a-z?]:)?[\\/]}is) {
+			     $filename = "./$filename";
+			}
+		    }elsif ($is_vms) {
+			# XXX todo by VMSmiths
+			$filename = "./$filename";
+		    }
+		    elsif (!$is_macos) {
+			$filename = "./$filename";
+		    }
+		}
+	    }
+	    else {
+		$filename = undef;
+	    }
+	}
+	unless (defined $filename) {
+	    # let C<require> do the searching
+	    $filename = "auto/$sub.al";
+	    $filename =~ s#::#/#g;
+	}
+    }
+    my $save = $@;
+    eval { local $SIG{__DIE__}; require $filename };
+    if ($@) {
+	if (substr($sub,-9) eq '::DESTROY') {
+	    *$sub = sub {};
+	} else {
+	    # The load might just have failed because the filename was too
+	    # long for some old SVR3 systems which treat long names as errors.
+	    # If we can succesfully truncate a long name then it's worth a go.
+	    # There is a slight risk that we could pick up the wrong file here
+	    # but autosplit should have warned about that when splitting.
+	    if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
+		eval { local $SIG{__DIE__}; require $filename };
+	    }
+	    if ($@){
+		$@ =~ s/ at .*\n//;
+		my $error = $@;
+		require Carp;
+		Carp::croak($error);
+	    }
+	}
+    }
+    $@ = $save;
+    goto &$sub;
+}
+
+sub import {
+    my $pkg = shift;
+    my $callpkg = caller;
+
+    #
+    # Export symbols, but not by accident of inheritance.
+    #
+
+    if ($pkg eq 'AutoLoader') {
+      local $Exporter::ExportLevel = 1;
+      Exporter::import $pkg, @_;
+    }
+
+    #
+    # Try to find the autosplit index file.  Eg., if the call package
+    # is POSIX, then $INC{POSIX.pm} is something like
+    # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in
+    # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that.
+    #
+    # However, if @INC is a relative path, this might not work.  If,
+    # for example, @INC = ('lib'), then
+    # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require
+    # 'auto/POSIX/autosplit.ix' (without the leading 'lib').
+    #
+
+    (my $calldir = $callpkg) =~ s#::#/#g;
+    my $path = $INC{$calldir . '.pm'};
+    if (defined($path)) {
+	# Try absolute path name.
+	$path =~ s#^(.*)$calldir\.pm$#$1auto/$calldir/autosplit.ix#;
+	eval { require $path; };
+	# If that failed, try relative path with normal @INC searching.
+	if ($@) {
+	    $path ="auto/$calldir/autosplit.ix";
+	    eval { require $path; };
+	}
+	if ($@) {
+	    my $error = $@;
+	    require Carp;
+	    Carp::carp($error);
+	}
+    } 
+}
+
+sub unimport {
+  my $callpkg = caller;
+  eval "package $callpkg; sub AUTOLOAD;";
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+AutoLoader - load subroutines only on demand
+
+=head1 SYNOPSIS
+
+    package Foo;
+    use AutoLoader 'AUTOLOAD';   # import the default AUTOLOAD subroutine
+
+    package Bar;
+    use AutoLoader;              # don't import AUTOLOAD, define our own
+    sub AUTOLOAD {
+        ...
+        $AutoLoader::AUTOLOAD = "...";
+        goto &AutoLoader::AUTOLOAD;
+    }
+
+=head1 DESCRIPTION
+
+The B<AutoLoader> module works with the B<AutoSplit> module and the
+C<__END__> token to defer the loading of some subroutines until they are
+used rather than loading them all at once.
+
+To use B<AutoLoader>, the author of a module has to place the
+definitions of subroutines to be autoloaded after an C<__END__> token.
+(See L<perldata>.)  The B<AutoSplit> module can then be run manually to
+extract the definitions into individual files F<auto/funcname.al>.
+
+B<AutoLoader> implements an AUTOLOAD subroutine.  When an undefined
+subroutine in is called in a client module of B<AutoLoader>,
+B<AutoLoader>'s AUTOLOAD subroutine attempts to locate the subroutine in a
+file with a name related to the location of the file from which the
+client module was read.  As an example, if F<POSIX.pm> is located in
+F</usr/local/lib/perl5/POSIX.pm>, B<AutoLoader> will look for perl
+subroutines B<POSIX> in F</usr/local/lib/perl5/auto/POSIX/*.al>, where
+the C<.al> file has the same name as the subroutine, sans package.  If
+such a file exists, AUTOLOAD will read and evaluate it,
+thus (presumably) defining the needed subroutine.  AUTOLOAD will then
+C<goto> the newly defined subroutine.
+
+Once this process completes for a given function, it is defined, so
+future calls to the subroutine will bypass the AUTOLOAD mechanism.
+
+=head2 Subroutine Stubs
+
+In order for object method lookup and/or prototype checking to operate
+correctly even when methods have not yet been defined it is necessary to
+"forward declare" each subroutine (as in C<sub NAME;>).  See
+L<perlsub/"SYNOPSIS">.  Such forward declaration creates "subroutine
+stubs", which are place holders with no code.
+
+The AutoSplit and B<AutoLoader> modules automate the creation of forward
+declarations.  The AutoSplit module creates an 'index' file containing
+forward declarations of all the AutoSplit subroutines.  When the
+AutoLoader module is 'use'd it loads these declarations into its callers
+package.
+
+Because of this mechanism it is important that B<AutoLoader> is always
+C<use>d and not C<require>d.
+
+=head2 Using B<AutoLoader>'s AUTOLOAD Subroutine
+
+In order to use B<AutoLoader>'s AUTOLOAD subroutine you I<must>
+explicitly import it:
+
+    use AutoLoader 'AUTOLOAD';
+
+=head2 Overriding B<AutoLoader>'s AUTOLOAD Subroutine
+
+Some modules, mainly extensions, provide their own AUTOLOAD subroutines.
+They typically need to check for some special cases (such as constants)
+and then fallback to B<AutoLoader>'s AUTOLOAD for the rest.
+
+Such modules should I<not> import B<AutoLoader>'s AUTOLOAD subroutine.
+Instead, they should define their own AUTOLOAD subroutines along these
+lines:
+
+    use AutoLoader;
+    use Carp;
+
+    sub AUTOLOAD {
+        my $sub = $AUTOLOAD;
+        (my $constname = $sub) =~ s/.*:://;
+        my $val = constant($constname, @_ ? $_[0] : 0);
+        if ($! != 0) {
+            if ($! =~ /Invalid/ || $!{EINVAL}) {
+                $AutoLoader::AUTOLOAD = $sub;
+                goto &AutoLoader::AUTOLOAD;
+            }
+            else {
+                croak "Your vendor has not defined constant $constname";
+            }
+        }
+        *$sub = sub { $val }; # same as: eval "sub $sub { $val }";
+        goto &$sub;
+    }
+
+If any module's own AUTOLOAD subroutine has no need to fallback to the
+AutoLoader's AUTOLOAD subroutine (because it doesn't have any AutoSplit
+subroutines), then that module should not use B<AutoLoader> at all.
+
+=head2 Package Lexicals
+
+Package lexicals declared with C<my> in the main block of a package
+using B<AutoLoader> will not be visible to auto-loaded subroutines, due to
+the fact that the given scope ends at the C<__END__> marker.  A module
+using such variables as package globals will not work properly under the
+B<AutoLoader>.
+
+The C<vars> pragma (see L<perlmod/"vars">) may be used in such
+situations as an alternative to explicitly qualifying all globals with
+the package namespace.  Variables pre-declared with this pragma will be
+visible to any autoloaded routines (but will not be invisible outside
+the package, unfortunately).
+
+=head2 Not Using AutoLoader
+
+You can stop using AutoLoader by simply
+
+	no AutoLoader;
+
+=head2 B<AutoLoader> vs. B<SelfLoader>
+
+The B<AutoLoader> is similar in purpose to B<SelfLoader>: both delay the
+loading of subroutines.
+
+B<SelfLoader> uses the C<__DATA__> marker rather than C<__END__>.
+While this avoids the use of a hierarchy of disk files and the
+associated open/close for each routine loaded, B<SelfLoader> suffers a
+startup speed disadvantage in the one-time parsing of the lines after
+C<__DATA__>, after which routines are cached.  B<SelfLoader> can also
+handle multiple packages in a file.
+
+B<AutoLoader> only reads code as it is requested, and in many cases
+should be faster, but requires a mechanism like B<AutoSplit> be used to
+create the individual files.  L<ExtUtils::MakeMaker> will invoke
+B<AutoSplit> automatically if B<AutoLoader> is used in a module source
+file.
+
+=head1 CAVEATS
+
+AutoLoaders prior to Perl 5.002 had a slightly different interface.  Any
+old modules which use B<AutoLoader> should be changed to the new calling
+style.  Typically this just means changing a require to a use, adding
+the explicit C<'AUTOLOAD'> import if needed, and removing B<AutoLoader>
+from C<@ISA>.
+
+On systems with restrictions on file name length, the file corresponding
+to a subroutine may have a shorter name that the routine itself.  This
+can lead to conflicting file names.  The I<AutoSplit> package warns of
+these potential conflicts when used to split a module.
+
+AutoLoader may fail to find the autosplit files (or even find the wrong
+ones) in cases where C<@INC> contains relative paths, B<and> the program
+does C<chdir>.
+
+=head1 SEE ALSO
+
+L<SelfLoader> - an autoloader that doesn't use external files.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/AutoSplit.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/AutoSplit.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/AutoSplit.pm	(revision 14265)
@@ -0,0 +1,487 @@
+package AutoSplit;
+
+use 5.005_64;
+use Exporter ();
+use Config qw(%Config);
+use Carp qw(carp);
+use File::Basename ();
+use File::Path qw(mkpath);
+use File::Spec::Functions qw(curdir catfile);
+use strict;
+our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Verbose, $Keep, $Maxlen,
+    $CheckForAutoloader, $CheckModTime);
+
+$VERSION = "1.0305";
+@ISA = qw(Exporter);
+@EXPORT = qw(&autosplit &autosplit_lib_modules);
+@EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime);
+
+=head1 NAME
+
+AutoSplit - split a package for autoloading
+
+=head1 SYNOPSIS
+
+ autosplit($file, $dir, $keep, $check, $modtime);
+
+ autosplit_lib_modules(@modules);
+
+=head1 DESCRIPTION
+
+This function will split up your program into files that the AutoLoader
+module can handle. It is used by both the standard perl libraries and by
+the MakeMaker utility, to automatically configure libraries for autoloading.
+
+The C<autosplit> interface splits the specified file into a hierarchy 
+rooted at the directory C<$dir>. It creates directories as needed to reflect
+class hierarchy, and creates the file F<autosplit.ix>. This file acts as
+both forward declaration of all package routines, and as timestamp for the
+last update of the hierarchy.
+
+The remaining three arguments to C<autosplit> govern other options to
+the autosplitter.
+
+=over 2
+
+=item $keep
+
+If the third argument, I<$keep>, is false, then any
+pre-existing C<*.al> files in the autoload directory are removed if
+they are no longer part of the module (obsoleted functions).
+$keep defaults to 0.
+
+=item $check
+
+The
+fourth argument, I<$check>, instructs C<autosplit> to check the module
+currently being split to ensure that it does include a C<use>
+specification for the AutoLoader module, and skips the module if
+AutoLoader is not detected.
+$check defaults to 1.
+
+=item $modtime
+
+Lastly, the I<$modtime> argument specifies
+that C<autosplit> is to check the modification time of the module
+against that of the C<autosplit.ix> file, and only split the module if
+it is newer.
+$modtime defaults to 1.
+
+=back
+
+Typical use of AutoSplit in the perl MakeMaker utility is via the command-line
+with:
+
+ perl -e 'use AutoSplit; autosplit($ARGV[0], $ARGV[1], 0, 1, 1)'
+
+Defined as a Make macro, it is invoked with file and directory arguments;
+C<autosplit> will split the specified file into the specified directory and
+delete obsolete C<.al> files, after checking first that the module does use
+the AutoLoader, and ensuring that the module is not already currently split
+in its current form (the modtime test).
+
+The C<autosplit_lib_modules> form is used in the building of perl. It takes
+as input a list of files (modules) that are assumed to reside in a directory
+B<lib> relative to the current directory. Each file is sent to the 
+autosplitter one at a time, to be split into the directory B<lib/auto>.
+
+In both usages of the autosplitter, only subroutines defined following the
+perl I<__END__> token are split out into separate files. Some
+routines may be placed prior to this marker to force their immediate loading
+and parsing.
+
+=head2 Multiple packages
+
+As of version 1.01 of the AutoSplit module it is possible to have
+multiple packages within a single file. Both of the following cases
+are supported:
+
+   package NAME;
+   __END__
+   sub AAA { ... }
+   package NAME::option1;
+   sub BBB { ... }
+   package NAME::option2;
+   sub BBB { ... }
+
+   package NAME;
+   __END__
+   sub AAA { ... }
+   sub NAME::option1::BBB { ... }
+   sub NAME::option2::BBB { ... }
+
+=head1 DIAGNOSTICS
+
+C<AutoSplit> will inform the user if it is necessary to create the
+top-level directory specified in the invocation. It is preferred that
+the script or installation process that invokes C<AutoSplit> have
+created the full directory path ahead of time. This warning may
+indicate that the module is being split into an incorrect path.
+
+C<AutoSplit> will warn the user of all subroutines whose name causes
+potential file naming conflicts on machines with drastically limited
+(8 characters or less) file name length. Since the subroutine name is
+used as the file name, these warnings can aid in portability to such
+systems.
+
+Warnings are issued and the file skipped if C<AutoSplit> cannot locate
+either the I<__END__> marker or a "package Name;"-style specification.
+
+C<AutoSplit> will also emit general diagnostics for inability to
+create directories or files.
+
+=cut
+
+# for portability warn about names longer than $maxlen
+$Maxlen  = 8;	# 8 for dos, 11 (14-".al") for SYSVR3
+$Verbose = 1;	# 0=none, 1=minimal, 2=list .al files
+$Keep    = 0;
+$CheckForAutoloader = 1;
+$CheckModTime = 1;
+
+my $IndexFile = "autosplit.ix";	# file also serves as timestamp
+my $maxflen = 255;
+$maxflen = 14 if $Config{'d_flexfnam'} ne 'define';
+if (defined (&Dos::UseLFN)) {
+     $maxflen = Dos::UseLFN() ? 255 : 11;
+}
+my $Is_VMS = ($^O eq 'VMS');
+
+# allow checking for valid ': attrlist' attachments
+my $nested;
+$nested = qr{ \( (?: (?> [^()]+ ) | (??{ $nested }) )* \) }x;
+my $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x;
+my $attr_list = qr{ \s* : \s* (?: $one_attr )* }x;
+
+
+
+sub autosplit{
+    my($file, $autodir,  $keep, $ckal, $ckmt) = @_;
+    # $file    - the perl source file to be split (after __END__)
+    # $autodir - the ".../auto" dir below which to write split subs
+    # Handle optional flags:
+    $keep = $Keep unless defined $keep;
+    $ckal = $CheckForAutoloader unless defined $ckal;
+    $ckmt = $CheckModTime unless defined $ckmt;
+    autosplit_file($file, $autodir, $keep, $ckal, $ckmt);
+}
+
+
+# This function is used during perl building/installation
+# ./miniperl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ...
+
+sub autosplit_lib_modules{
+    my(@modules) = @_; # list of Module names
+
+    while(defined($_ = shift @modules)){
+    	while (m#(.*?[^:])::([^:].*)#) { # in case specified as ABC::XYZ
+	    $_ = catfile($1, $2);
+	}
+	s|\\|/|g;		# bug in ksh OS/2
+	s#^lib/##s; # incase specified as lib/*.pm
+	my($lib) = catfile(curdir(), "lib");
+	if ($Is_VMS) { # may need to convert VMS-style filespecs
+	    $lib =~ s#^\[\]#.\/#;
+	}
+	s#^$lib\W+##s; # incase specified as ./lib/*.pm
+	if ($Is_VMS && /[:>\]]/) { # may need to convert VMS-style filespecs
+	    my ($dir,$name) = (/(.*])(.*)/s);
+	    $dir =~ s/.*lib[\.\]]//s;
+	    $dir =~ s#[\.\]]#/#g;
+	    $_ = $dir . $name;
+	}
+	autosplit_file(catfile($lib, $_), catfile($lib, "auto"),
+		       $Keep, $CheckForAutoloader, $CheckModTime);
+    }
+    0;
+}
+
+
+# private functions
+
+sub autosplit_file {
+    my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time)
+	= @_;
+    my(@outfiles);
+    local($_);
+    local($/) = "\n";
+
+    # where to write output files
+    $autodir ||= catfile(curdir(), "lib", "auto");
+    if ($Is_VMS) {
+	($autodir = VMS::Filespec::unixpath($autodir)) =~ s|/\z||;
+	$filename = VMS::Filespec::unixify($filename); # may have dirs
+    }
+    unless (-d $autodir){
+	mkpath($autodir,0,0755);
+	# We should never need to create the auto dir
+	# here. installperl (or similar) should have done
+	# it. Expecting it to exist is a valuable sanity check against
+	# autosplitting into some random directory by mistake.
+	print "Warning: AutoSplit had to create top-level " .
+	    "$autodir unexpectedly.\n";
+    }
+
+    # allow just a package name to be used
+    $filename .= ".pm" unless ($filename =~ m/\.pm\z/);
+
+    open(IN, "<$filename") or die "AutoSplit: Can't open $filename: $!\n";
+    my($pm_mod_time) = (stat($filename))[9];
+    my($autoloader_seen) = 0;
+    my($in_pod) = 0;
+    my($def_package,$last_package,$this_package,$fnr);
+    while (<IN>) {
+	# Skip pod text.
+	$fnr++;
+	$in_pod = 1 if /^=\w/;
+	$in_pod = 0 if /^=cut/;
+	next if ($in_pod || /^=cut/);
+
+	# record last package name seen
+	$def_package = $1 if (m/^\s*package\s+([\w:]+)\s*;/);
+	++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/;
+	++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/;
+	last if /^__END__/;
+    }
+    if ($check_for_autoloader && !$autoloader_seen){
+	print "AutoSplit skipped $filename: no AutoLoader used\n"
+	    if ($Verbose>=2);
+	return 0;
+    }
+    $_ or die "Can't find __END__ in $filename\n";
+
+    $def_package or die "Can't find 'package Name;' in $filename\n";
+
+    my($modpname) = _modpname($def_package); 
+    if ($Is_VMS) {
+	$modpname = VMS::Filespec::unixify($modpname); # may have dirs
+    }
+
+    # this _has_ to match so we have a reasonable timestamp file
+    die "Package $def_package ($modpname.pm) does not ".
+	"match filename $filename"
+	    unless ($filename =~ m/\Q$modpname.pm\E$/ or
+		    ($^O eq 'dos') or ($^O eq 'MSWin32') or
+	            $Is_VMS && $filename =~ m/$modpname.pm/i);
+
+    my($al_idx_file) = catfile($autodir, $modpname, $IndexFile);
+
+    if ($check_mod_time){
+	my($al_ts_time) = (stat("$al_idx_file"))[9] || 1;
+	if ($al_ts_time >= $pm_mod_time){
+	    print "AutoSplit skipped ($al_idx_file newer than $filename)\n"
+		if ($Verbose >= 2);
+	    return undef;	# one undef, not a list
+	}
+    }
+
+    my($modnamedir) = catfile($autodir, $modpname);
+    print "AutoSplitting $filename ($modnamedir)\n"
+	if $Verbose;
+
+    unless (-d $modnamedir){
+	mkpath($modnamedir,0,0777);
+    }
+
+    # We must try to deal with some SVR3 systems with a limit of 14
+    # characters for file names. Sadly we *cannot* simply truncate all
+    # file names to 14 characters on these systems because we *must*
+    # create filenames which exactly match the names used by AutoLoader.pm.
+    # This is a problem because some systems silently truncate the file
+    # names while others treat long file names as an error.
+
+    my $Is83 = $maxflen==11;  # plain, case INSENSITIVE dos filenames
+
+    my(@subnames, $subname, %proto, %package);
+    my @cache = ();
+    my $caching = 1;
+    $last_package = '';
+    while (<IN>) {
+	$fnr++;
+	$in_pod = 1 if /^=\w/;
+	$in_pod = 0 if /^=cut/;
+	next if ($in_pod || /^=cut/);
+	# the following (tempting) old coding gives big troubles if a
+	# cut is forgotten at EOF:
+	# next if /^=\w/ .. /^=cut/;
+	if (/^package\s+([\w:]+)\s*;/) {
+	    $this_package = $def_package = $1;
+	}
+	if (/^sub\s+([\w:]+)(\s*(?:\(.*?\))?(?:$attr_list)?)/) {
+	    print OUT "# end of $last_package\::$subname\n1;\n"
+		if $last_package;
+	    $subname = $1;
+	    my $proto = $2 || '';
+	    if ($subname =~ s/(.*):://){
+		$this_package = $1;
+	    } else {
+		$this_package = $def_package;
+	    }
+	    my $fq_subname = "$this_package\::$subname";
+	    $package{$fq_subname} = $this_package;
+	    $proto{$fq_subname} = $proto;
+	    push(@subnames, $fq_subname);
+	    my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3));
+	    $modpname = _modpname($this_package);
+    	    my($modnamedir) = catfile($autodir, $modpname);
+	    mkpath($modnamedir,0,0777);
+	    my($lpath) = catfile($modnamedir, "$lname.al");
+	    my($spath) = catfile($modnamedir, "$sname.al");
+	    my $path;
+	    if (!$Is83 and open(OUT, ">$lpath")){
+	        $path=$lpath;
+		print "  writing $lpath\n" if ($Verbose>=2);
+	    } else {
+		open(OUT, ">$spath") or die "Can't create $spath: $!\n";
+		$path=$spath;
+		print "  writing $spath (with truncated name)\n"
+			if ($Verbose>=1);
+	    }
+	    push(@outfiles, $path);
+	    print OUT <<EOT;
+# NOTE: Derived from $filename.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package $this_package;
+
+#line $fnr "$filename (autosplit into $path)"
+EOT
+	    print OUT @cache;
+	    @cache = ();
+	    $caching = 0;
+	}
+	if($caching) {
+	    push(@cache, $_) if @cache || /\S/;
+	} else {
+	    print OUT $_;
+	}
+	if(/^\}/) {
+	    if($caching) {
+		print OUT @cache;
+		@cache = ();
+	    }
+	    print OUT "\n";
+	    $caching = 1;
+	}
+	$last_package = $this_package if defined $this_package;
+    }
+    if ($subname) {
+	print OUT @cache,"1;\n# end of $last_package\::$subname\n";
+	close(OUT);
+    }
+    close(IN);
+    
+    if (!$keep){  # don't keep any obsolete *.al files in the directory
+	my(%outfiles);
+	# @outfiles{@outfiles} = @outfiles;
+	# perl downcases all filenames on VMS (which upcases all filenames) so
+	# we'd better downcase the sub name list too, or subs with upper case
+	# letters in them will get their .al files deleted right after they're
+	# created. (The mixed case sub name won't match the all-lowercase
+	# filename, and so be cleaned up as a scrap file)
+	if ($Is_VMS or $Is83) {
+	    %outfiles = map {lc($_) => lc($_) } @outfiles;
+	} else {
+	    @outfiles{@outfiles} = @outfiles;
+	}  
+	my(%outdirs,@outdirs);
+	for (@outfiles) {
+	    $outdirs{File::Basename::dirname($_)}||=1;
+	}
+	for my $dir (keys %outdirs) {
+	    opendir(OUTDIR,$dir);
+	    foreach (sort readdir(OUTDIR)){
+		next unless /\.al\z/;
+		my($file) = catfile($dir, $_);
+		$file = lc $file if $Is83 or $Is_VMS;
+		next if $outfiles{$file};
+		print "  deleting $file\n" if ($Verbose>=2);
+		my($deleted,$thistime);  # catch all versions on VMS
+		do { $deleted += ($thistime = unlink $file) } while ($thistime);
+		carp "Unable to delete $file: $!" unless $deleted;
+	    }
+	    closedir(OUTDIR);
+	}
+    }
+
+    open(TS,">$al_idx_file") or
+	carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!";
+    print TS "# Index created by AutoSplit for $filename\n";
+    print TS "#    (file acts as timestamp)\n";
+    $last_package = '';
+    for my $fqs (@subnames) {
+	my($subname) = $fqs;
+	$subname =~ s/.*:://;
+	print TS "package $package{$fqs};\n"
+	    unless $last_package eq $package{$fqs};
+	print TS "sub $subname $proto{$fqs};\n";
+	$last_package = $package{$fqs};
+    }
+    print TS "1;\n";
+    close(TS);
+
+    _check_unique($filename, $Maxlen, 1, @outfiles);
+
+    @outfiles;
+}
+
+sub _modpname ($) {
+    my($package) = @_;
+    my $modpname = $package;
+    if ($^O eq 'MSWin32') {
+	$modpname =~ s#::#\\#g; 
+    } else {
+    	while ($modpname =~ m#(.*?[^:])::([^:].*)#) {
+	    $modpname = catfile($1, $2);
+	}
+    }
+    $modpname;
+}
+
+sub _check_unique {
+    my($filename, $maxlen, $warn, @outfiles) = @_;
+    my(%notuniq) = ();
+    my(%shorts)  = ();
+    my(@toolong) = grep(
+			length(File::Basename::basename($_))
+			> $maxlen,
+			@outfiles
+		       );
+
+    foreach (@toolong){
+	my($dir) = File::Basename::dirname($_);
+	my($file) = File::Basename::basename($_);
+	my($trunc) = substr($file,0,$maxlen);
+	$notuniq{$dir}{$trunc} = 1 if $shorts{$dir}{$trunc};
+	$shorts{$dir}{$trunc} = $shorts{$dir}{$trunc} ?
+	    "$shorts{$dir}{$trunc}, $file" : $file;
+    }
+    if (%notuniq && $warn){
+	print "$filename: some names are not unique when " .
+	    "truncated to $maxlen characters:\n";
+	foreach my $dir (sort keys %notuniq){
+	    print " directory $dir:\n";
+	    foreach my $trunc (sort keys %{$notuniq{$dir}}) {
+		print "  $shorts{$dir}{$trunc} truncate to $trunc\n";
+	    }
+	}
+    }
+}
+
+1;
+__END__
+
+# test functions so AutoSplit.pm can be applied to itself:
+sub test1 ($)   { "test 1\n"; }
+sub test2 ($$)  { "test 2\n"; }
+sub test3 ($$$) { "test 3\n"; }
+sub testtesttesttest4_1  { "test 4\n"; }
+sub testtesttesttest4_2  { "duplicate test 4\n"; }
+sub Just::Another::test5 { "another test 5\n"; }
+sub test6       { return join ":", __FILE__,__LINE__; }
+package Yet::Another::AutoSplit;
+sub testtesttesttest4_1 ($)  { "another test 4\n"; }
+sub testtesttesttest4_2 ($$) { "another duplicate test 4\n"; }
+package Yet::More::Attributes;
+sub test_a1 ($) : locked :locked { 1; }
+sub test_a2 : locked { 1; }
Index: /for-distributions/trunk/bin/windows/perl/lib/B.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B.pm	(revision 14265)
@@ -0,0 +1,892 @@
+#      B.pm
+#
+#      Copyright (c) 1996, 1997, 1998 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B;
+use XSLoader ();
+require Exporter;
+@ISA = qw(Exporter);
+
+# walkoptree_slow comes from B.pm (you are there),
+# walkoptree comes from B.xs
+@EXPORT_OK = qw(minus_c ppname save_BEGINs
+		class peekop cast_I32 cstring cchar hash threadsv_names
+		main_root main_start main_cv svref_2object opnumber
+		amagic_generation
+		walkoptree_slow walkoptree walkoptree_exec walksymtable
+		parents comppadlist sv_undef compile_stats timing_info
+		begin_av init_av end_av);
+
+sub OPf_KIDS ();
+use strict;
+@B::SV::ISA = 'B::OBJECT';
+@B::NULL::ISA = 'B::SV';
+@B::PV::ISA = 'B::SV';
+@B::IV::ISA = 'B::SV';
+@B::NV::ISA = 'B::IV';
+@B::RV::ISA = 'B::SV';
+@B::PVIV::ISA = qw(B::PV B::IV);
+@B::PVNV::ISA = qw(B::PV B::NV);
+@B::PVMG::ISA = 'B::PVNV';
+@B::PVLV::ISA = 'B::PVMG';
+@B::BM::ISA = 'B::PVMG';
+@B::AV::ISA = 'B::PVMG';
+@B::GV::ISA = 'B::PVMG';
+@B::HV::ISA = 'B::PVMG';
+@B::CV::ISA = 'B::PVMG';
+@B::IO::ISA = 'B::PVMG';
+@B::FM::ISA = 'B::CV';
+
+@B::OP::ISA = 'B::OBJECT';
+@B::UNOP::ISA = 'B::OP';
+@B::BINOP::ISA = 'B::UNOP';
+@B::LOGOP::ISA = 'B::UNOP';
+@B::LISTOP::ISA = 'B::BINOP';
+@B::SVOP::ISA = 'B::OP';
+@B::PADOP::ISA = 'B::OP';
+@B::PVOP::ISA = 'B::OP';
+@B::CVOP::ISA = 'B::OP';
+@B::LOOP::ISA = 'B::LISTOP';
+@B::PMOP::ISA = 'B::LISTOP';
+@B::COP::ISA = 'B::OP';
+
+@B::SPECIAL::ISA = 'B::OBJECT';
+
+{
+    # Stop "-w" from complaining about the lack of a real B::OBJECT class
+    package B::OBJECT;
+}
+
+sub B::GV::SAFENAME {
+  my $name = (shift())->NAME;
+
+  # The regex below corresponds to the isCONTROLVAR macro
+  # from toke.c
+
+  $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".chr(64 ^ ord($1))/e;
+  return $name;
+}
+
+sub B::IV::int_value {
+  my ($self) = @_;
+  return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
+}
+
+my $debug;
+my $op_count = 0;
+my @parents = ();
+
+sub debug {
+    my ($class, $value) = @_;
+    $debug = $value;
+    walkoptree_debug($value);
+}
+
+sub class {
+    my $obj = shift;
+    my $name = ref $obj;
+    $name =~ s/^.*:://;
+    return $name;
+}
+
+sub parents { \@parents }
+
+# For debugging
+sub peekop {
+    my $op = shift;
+    return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
+}
+
+sub walkoptree_slow {
+    my($op, $method, $level) = @_;
+    $op_count++; # just for statistics
+    $level ||= 0;
+    warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
+    $op->$method($level);
+    if ($$op && ($op->flags & OPf_KIDS)) {
+	my $kid;
+	unshift(@parents, $op);
+	for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
+	    walkoptree_slow($kid, $method, $level + 1);
+	}
+	shift @parents;
+    }
+}
+
+sub compile_stats {
+    return "Total number of OPs processed: $op_count\n";
+}
+
+sub timing_info {
+    my ($sec, $min, $hr) = localtime;
+    my ($user, $sys) = times;
+    sprintf("%02d:%02d:%02d user=$user sys=$sys",
+	    $hr, $min, $sec, $user, $sys);
+}
+
+my %symtable;
+
+sub clearsym {
+    %symtable = ();
+}
+
+sub savesym {
+    my ($obj, $value) = @_;
+#    warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
+    $symtable{sprintf("sym_%x", $$obj)} = $value;
+}
+
+sub objsym {
+    my $obj = shift;
+    return $symtable{sprintf("sym_%x", $$obj)};
+}
+
+sub walkoptree_exec {
+    my ($op, $method, $level) = @_;
+    $level ||= 0;
+    my ($sym, $ppname);
+    my $prefix = "    " x $level;
+    for (; $$op; $op = $op->next) {
+	$sym = objsym($op);
+	if (defined($sym)) {
+	    print $prefix, "goto $sym\n";
+	    return;
+	}
+	savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
+	$op->$method($level);
+	$ppname = $op->name;
+	if ($ppname =~
+	    /^(or|and|mapwhile|grepwhile|entertry|range|cond_expr)$/)
+	{
+	    print $prefix, uc($1), " => {\n";
+	    walkoptree_exec($op->other, $method, $level + 1);
+	    print $prefix, "}\n";
+	} elsif ($ppname eq "match" || $ppname eq "subst") {
+	    my $pmreplstart = $op->pmreplstart;
+	    if ($$pmreplstart) {
+		print $prefix, "PMREPLSTART => {\n";
+		walkoptree_exec($pmreplstart, $method, $level + 1);
+		print $prefix, "}\n";
+	    }
+	} elsif ($ppname eq "substcont") {
+	    print $prefix, "SUBSTCONT => {\n";
+	    walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
+	    print $prefix, "}\n";
+	    $op = $op->other;
+	} elsif ($ppname eq "enterloop") {
+	    print $prefix, "REDO => {\n";
+	    walkoptree_exec($op->redoop, $method, $level + 1);
+	    print $prefix, "}\n", $prefix, "NEXT => {\n";
+	    walkoptree_exec($op->nextop, $method, $level + 1);
+	    print $prefix, "}\n", $prefix, "LAST => {\n";
+	    walkoptree_exec($op->lastop,  $method, $level + 1);
+	    print $prefix, "}\n";
+	} elsif ($ppname eq "subst") {
+	    my $replstart = $op->pmreplstart;
+	    if ($$replstart) {
+		print $prefix, "SUBST => {\n";
+		walkoptree_exec($replstart, $method, $level + 1);
+		print $prefix, "}\n";
+	    }
+	}
+    }
+}
+
+sub walksymtable {
+    my ($symref, $method, $recurse, $prefix) = @_;
+    my $sym;
+    my $ref;
+    no strict 'vars';
+    local(*glob);
+    $prefix = '' unless defined $prefix;
+    while (($sym, $ref) = each %$symref) {
+	*glob = "*main::".$prefix.$sym;
+	if ($sym =~ /::$/) {
+	    $sym = $prefix . $sym;
+	    if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
+		walksymtable(\%glob, $method, $recurse, $sym);
+	    }
+	} else {
+	    svref_2object(\*glob)->EGV->$method();
+	}
+    }
+}
+
+{
+    package B::Section;
+    my $output_fh;
+    my %sections;
+    
+    sub new {
+	my ($class, $section, $symtable, $default) = @_;
+	$output_fh ||= FileHandle->new_tmpfile;
+	my $obj = bless [-1, $section, $symtable, $default], $class;
+	$sections{$section} = $obj;
+	return $obj;
+    }
+    
+    sub get {
+	my ($class, $section) = @_;
+	return $sections{$section};
+    }
+
+    sub add {
+	my $section = shift;
+	while (defined($_ = shift)) {
+	    print $output_fh "$section->[1]\t$_\n";
+	    $section->[0]++;
+	}
+    }
+
+    sub index {
+	my $section = shift;
+	return $section->[0];
+    }
+
+    sub name {
+	my $section = shift;
+	return $section->[1];
+    }
+
+    sub symtable {
+	my $section = shift;
+	return $section->[2];
+    }
+	
+    sub default {
+	my $section = shift;
+	return $section->[3];
+    }
+	
+    sub output {
+	my ($section, $fh, $format) = @_;
+	my $name = $section->name;
+	my $sym = $section->symtable || {};
+	my $default = $section->default;
+
+	seek($output_fh, 0, 0);
+	while (<$output_fh>) {
+	    chomp;
+	    s/^(.*?)\t//;
+	    if ($1 eq $name) {
+		s{(s\\_[0-9a-f]+)} {
+		    exists($sym->{$1}) ? $sym->{$1} : $default;
+		}ge;
+		printf $fh $format, $_;
+	    }
+	}
+    }
+}
+
+XSLoader::load 'B';
+
+1;
+
+__END__
+
+=head1 NAME
+
+B - The Perl Compiler
+
+=head1 SYNOPSIS
+
+	use B;
+
+=head1 DESCRIPTION
+
+The C<B> module supplies classes which allow a Perl program to delve
+into its own innards. It is the module used to implement the
+"backends" of the Perl compiler. Usage of the compiler does not
+require knowledge of this module: see the F<O> module for the
+user-visible part. The C<B> module is of use to those who want to
+write new compiler backends. This documentation assumes that the
+reader knows a fair amount about perl's internals including such
+things as SVs, OPs and the internal symbol table and syntax tree
+of a program.
+
+=head1 OVERVIEW OF CLASSES
+
+The C structures used by Perl's internals to hold SV and OP
+information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
+class hierarchy and the C<B> module gives access to them via a true
+object hierarchy. Structure fields which point to other objects
+(whether types of SV or types of OP) are represented by the C<B>
+module as Perl objects of the appropriate class. The bulk of the C<B>
+module is the methods for accessing fields of these structures. Note
+that all access is read-only: you cannot modify the internals by
+using this module.
+
+=head2 SV-RELATED CLASSES
+
+B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
+B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
+the obvious way to the underlying C structures of similar names. The
+inheritance hierarchy mimics the underlying C "inheritance". Access
+methods correspond to the underlying C macros for field access,
+usually with the leading "class indication" prefix removed (Sv, Av,
+Hv, ...). The leading prefix is only left in cases where its removal
+would cause a clash in method name. For example, C<GvREFCNT> stays
+as-is since its abbreviation would clash with the "superclass" method
+C<REFCNT> (corresponding to the C function C<SvREFCNT>).
+
+=head2 B::SV METHODS
+
+=over 4
+
+=item REFCNT
+
+=item FLAGS
+
+=back
+
+=head2 B::IV METHODS
+
+=over 4
+
+=item IV
+
+Returns the value of the IV, I<interpreted as
+a signed integer>. This will be misleading
+if C<FLAGS & SVf_IVisUV>. Perhaps you want the
+C<int_value> method instead?
+
+=item IVX
+
+=item UVX
+
+=item int_value
+
+This method returns the value of the IV as an integer.
+It differs from C<IV> in that it returns the correct
+value regardless of whether it's stored signed or
+unsigned.
+
+=item needs64bits
+
+=item packiv
+
+=back
+
+=head2 B::NV METHODS
+
+=over 4
+
+=item NV
+
+=item NVX
+
+=back
+
+=head2 B::RV METHODS
+
+=over 4
+
+=item RV
+
+=back
+
+=head2 B::PV METHODS
+
+=over 4
+
+=item PV
+
+This method is the one you usually want. It constructs a
+string using the length and offset information in the struct:
+for ordinary scalars it will return the string that you'd see
+from Perl, even if it contains null characters.
+
+=item PVX
+
+This method is less often useful. It assumes that the string
+stored in the struct is null-terminated, and disregards the
+length information.
+
+It is the appropriate method to use if you need to get the name
+of a lexical variable from a padname array. Lexical variable names
+are always stored with a null terminator, and the length field
+(SvCUR) is overloaded for other purposes and can't be relied on here.
+
+=back
+
+=head2 B::PVMG METHODS
+
+=over 4
+
+=item MAGIC
+
+=item SvSTASH
+
+=back
+
+=head2 B::MAGIC METHODS
+
+=over 4
+
+=item MOREMAGIC
+
+=item PRIVATE
+
+=item TYPE
+
+=item FLAGS
+
+=item OBJ
+
+=item PTR
+
+=back
+
+=head2 B::PVLV METHODS
+
+=over 4
+
+=item TARGOFF
+
+=item TARGLEN
+
+=item TYPE
+
+=item TARG
+
+=back
+
+=head2 B::BM METHODS
+
+=over 4
+
+=item USEFUL
+
+=item PREVIOUS
+
+=item RARE
+
+=item TABLE
+
+=back
+
+=head2 B::GV METHODS
+
+=over 4
+
+=item is_empty
+
+This method returns TRUE if the GP field of the GV is NULL.
+
+=item NAME
+
+=item SAFENAME
+
+This method returns the name of the glob, but if the first
+character of the name is a control character, then it converts
+it to ^X first, so that *^G would return "^G" rather than "\cG".
+
+It's useful if you want to print out the name of a variable.
+If you restrict yourself to globs which exist at compile-time
+then the result ought to be unambiguous, because code like
+C<${"^G"} = 1> is compiled as two ops - a constant string and
+a dereference (rv2gv) - so that the glob is created at runtime.
+
+If you're working with globs at runtime, and need to disambiguate
+*^G from *{"^G"}, then you should use the raw NAME method.
+
+=item STASH
+
+=item SV
+
+=item IO
+
+=item FORM
+
+=item AV
+
+=item HV
+
+=item EGV
+
+=item CV
+
+=item CVGEN
+
+=item LINE
+
+=item FILE
+
+=item FILEGV
+
+=item GvREFCNT
+
+=item FLAGS
+
+=back
+
+=head2 B::IO METHODS
+
+=over 4
+
+=item LINES
+
+=item PAGE
+
+=item PAGE_LEN
+
+=item LINES_LEFT
+
+=item TOP_NAME
+
+=item TOP_GV
+
+=item FMT_NAME
+
+=item FMT_GV
+
+=item BOTTOM_NAME
+
+=item BOTTOM_GV
+
+=item SUBPROCESS
+
+=item IoTYPE
+
+=item IoFLAGS
+
+=back
+
+=head2 B::AV METHODS
+
+=over 4
+
+=item FILL
+
+=item MAX
+
+=item OFF
+
+=item ARRAY
+
+=item AvFLAGS
+
+=back
+
+=head2 B::CV METHODS
+
+=over 4
+
+=item STASH
+
+=item START
+
+=item ROOT
+
+=item GV
+
+=item FILE
+
+=item DEPTH
+
+=item PADLIST
+
+=item OUTSIDE
+
+=item XSUB
+
+=item XSUBANY
+
+=item CvFLAGS
+
+=back
+
+=head2 B::HV METHODS
+
+=over 4
+
+=item FILL
+
+=item MAX
+
+=item KEYS
+
+=item RITER
+
+=item NAME
+
+=item PMROOT
+
+=item ARRAY
+
+=back
+
+=head2 OP-RELATED CLASSES
+
+B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
+B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
+These classes correspond in
+the obvious way to the underlying C structures of similar names. The
+inheritance hierarchy mimics the underlying C "inheritance". Access
+methods correspond to the underlying C structre field names, with the
+leading "class indication" prefix removed (op_).
+
+=head2 B::OP METHODS
+
+=over 4
+
+=item next
+
+=item sibling
+
+=item name
+
+This returns the op name as a string (e.g. "add", "rv2av").
+
+=item ppaddr
+
+This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
+"PL_ppaddr[OP_RV2AV]").
+
+=item desc
+
+This returns the op description from the global C PL_op_desc array
+(e.g. "addition" "array deref").
+
+=item targ
+
+=item type
+
+=item seq
+
+=item flags
+
+=item private
+
+=back
+
+=head2 B::UNOP METHOD
+
+=over 4
+
+=item first
+
+=back
+
+=head2 B::BINOP METHOD
+
+=over 4
+
+=item last
+
+=back
+
+=head2 B::LOGOP METHOD
+
+=over 4
+
+=item other
+
+=back
+
+=head2 B::LISTOP METHOD
+
+=over 4
+
+=item children
+
+=back
+
+=head2 B::PMOP METHODS
+
+=over 4
+
+=item pmreplroot
+
+=item pmreplstart
+
+=item pmnext
+
+=item pmregexp
+
+=item pmflags
+
+=item pmpermflags
+
+=item precomp
+
+=back
+
+=head2 B::SVOP METHOD
+
+=over 4
+
+=item sv
+
+=item gv
+
+=back
+
+=head2 B::PADOP METHOD
+
+=over 4
+
+=item padix
+
+=back
+
+=head2 B::PVOP METHOD
+
+=over 4
+
+=item pv
+
+=back
+
+=head2 B::LOOP METHODS
+
+=over 4
+
+=item redoop
+
+=item nextop
+
+=item lastop
+
+=back
+
+=head2 B::COP METHODS
+
+=over 4
+
+=item label
+
+=item stash
+
+=item file
+
+=item cop_seq
+
+=item arybase
+
+=item line
+
+=back
+
+=head1 FUNCTIONS EXPORTED BY C<B>
+
+The C<B> module exports a variety of functions: some are simple
+utility functions, others provide a Perl program with a way to
+get an initial "handle" on an internal object.
+
+=over 4
+
+=item main_cv
+
+Return the (faked) CV corresponding to the main part of the Perl
+program.
+
+=item init_av
+
+Returns the AV object (i.e. in class B::AV) representing INIT blocks.
+
+=item main_root
+
+Returns the root op (i.e. an object in the appropriate B::OP-derived
+class) of the main part of the Perl program.
+
+=item main_start
+
+Returns the starting op of the main part of the Perl program.
+
+=item comppadlist
+
+Returns the AV object (i.e. in class B::AV) of the global comppadlist.
+
+=item sv_undef
+
+Returns the SV object corresponding to the C variable C<sv_undef>.
+
+=item sv_yes
+
+Returns the SV object corresponding to the C variable C<sv_yes>.
+
+=item sv_no
+
+Returns the SV object corresponding to the C variable C<sv_no>.
+
+=item amagic_generation
+
+Returns the SV object corresponding to the C variable C<amagic_generation>.
+
+=item walkoptree(OP, METHOD)
+
+Does a tree-walk of the syntax tree based at OP and calls METHOD on
+each op it visits. Each node is visited before its children. If
+C<walkoptree_debug> (q.v.) has been called to turn debugging on then
+the method C<walkoptree_debug> is called on each op before METHOD is
+called.
+
+=item walkoptree_debug(DEBUG)
+
+Returns the current debugging flag for C<walkoptree>. If the optional
+DEBUG argument is non-zero, it sets the debugging flag to that. See
+the description of C<walkoptree> above for what the debugging flag
+does.
+
+=item walksymtable(SYMREF, METHOD, RECURSE)
+
+Walk the symbol table starting at SYMREF and call METHOD on each
+symbol visited. When the walk reached package symbols "Foo::" it
+invokes RECURSE and only recurses into the package if that sub
+returns true.
+
+=item svref_2object(SV)
+
+Takes any Perl variable and turns it into an object in the
+appropriate B::OP-derived or B::SV-derived class. Apart from functions
+such as C<main_root>, this is the primary way to get an initial
+"handle" on a internal perl data structure which can then be followed
+with the other access methods.
+
+=item ppname(OPNUM)
+
+Return the PP function name (e.g. "pp_add") of op number OPNUM.
+
+=item hash(STR)
+
+Returns a string in the form "0x..." representing the value of the
+internal hash function used by perl on string STR.
+
+=item cast_I32(I)
+
+Casts I to the internal I32 type used by that perl.
+
+
+=item minus_c
+
+Does the equivalent of the C<-c> command-line option. Obviously, this
+is only useful in a BEGIN block or else the flag is set too late.
+
+
+=item cstring(STR)
+
+Returns a double-quote-surrounded escaped version of STR which can
+be used as a string in C source code.
+
+=item class(OBJ)
+
+Returns the class of an object without the part of the classname
+preceding the first "::". This is used to turn "B::UNOP" into
+"UNOP" for example.
+
+=item threadsv_names
+
+In a perl compiled for threads, this returns a list of the special
+per-thread threadsv variables.
+
+=back
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Asmdata.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Asmdata.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Asmdata.pm	(revision 14265)
@@ -0,0 +1,172 @@
+#
+#      Copyright (c) 1996-1999 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+#
+#
+# This file is autogenerated from bytecode.pl. Changes made here will be lost.
+#
+package B::Asmdata;
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name);
+our(%insn_data, @insn_name, @optype, @specialsv_name);
+
+@optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP);
+@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no pWARN_ALL pWARN_NONE);
+
+# XXX insn_data is initialised this way because with a large
+# %insn_data = (foo => [...], bar => [...], ...) initialiser
+# I get a hard-to-track-down stack underflow and segfault.
+$insn_data{comment} = [35, \&PUT_comment_t, "GET_comment_t"];
+$insn_data{nop} = [10, \&PUT_none, "GET_none"];
+$insn_data{ret} = [0, \&PUT_none, "GET_none"];
+$insn_data{ldsv} = [1, \&PUT_svindex, "GET_svindex"];
+$insn_data{ldop} = [2, \&PUT_opindex, "GET_opindex"];
+$insn_data{stsv} = [3, \&PUT_U32, "GET_U32"];
+$insn_data{stop} = [4, \&PUT_U32, "GET_U32"];
+$insn_data{stpv} = [5, \&PUT_U32, "GET_U32"];
+$insn_data{ldspecsv} = [6, \&PUT_U8, "GET_U8"];
+$insn_data{newsv} = [7, \&PUT_U8, "GET_U8"];
+$insn_data{newop} = [8, \&PUT_U8, "GET_U8"];
+$insn_data{newopn} = [9, \&PUT_U8, "GET_U8"];
+$insn_data{newpv} = [11, \&PUT_PV, "GET_PV"];
+$insn_data{pv_cur} = [12, \&PUT_U32, "GET_U32"];
+$insn_data{pv_free} = [13, \&PUT_none, "GET_none"];
+$insn_data{sv_upgrade} = [14, \&PUT_U8, "GET_U8"];
+$insn_data{sv_refcnt} = [15, \&PUT_U32, "GET_U32"];
+$insn_data{sv_refcnt_add} = [16, \&PUT_I32, "GET_I32"];
+$insn_data{sv_flags} = [17, \&PUT_U32, "GET_U32"];
+$insn_data{xrv} = [18, \&PUT_svindex, "GET_svindex"];
+$insn_data{xpv} = [19, \&PUT_none, "GET_none"];
+$insn_data{xiv32} = [20, \&PUT_I32, "GET_I32"];
+$insn_data{xiv64} = [21, \&PUT_IV64, "GET_IV64"];
+$insn_data{xnv} = [22, \&PUT_NV, "GET_NV"];
+$insn_data{xlv_targoff} = [23, \&PUT_U32, "GET_U32"];
+$insn_data{xlv_targlen} = [24, \&PUT_U32, "GET_U32"];
+$insn_data{xlv_targ} = [25, \&PUT_svindex, "GET_svindex"];
+$insn_data{xlv_type} = [26, \&PUT_U8, "GET_U8"];
+$insn_data{xbm_useful} = [27, \&PUT_I32, "GET_I32"];
+$insn_data{xbm_previous} = [28, \&PUT_U16, "GET_U16"];
+$insn_data{xbm_rare} = [29, \&PUT_U8, "GET_U8"];
+$insn_data{xfm_lines} = [30, \&PUT_I32, "GET_I32"];
+$insn_data{xio_lines} = [31, \&PUT_I32, "GET_I32"];
+$insn_data{xio_page} = [32, \&PUT_I32, "GET_I32"];
+$insn_data{xio_page_len} = [33, \&PUT_I32, "GET_I32"];
+$insn_data{xio_lines_left} = [34, \&PUT_I32, "GET_I32"];
+$insn_data{xio_top_name} = [36, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_top_gv} = [37, \&PUT_svindex, "GET_svindex"];
+$insn_data{xio_fmt_name} = [38, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_fmt_gv} = [39, \&PUT_svindex, "GET_svindex"];
+$insn_data{xio_bottom_name} = [40, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_bottom_gv} = [41, \&PUT_svindex, "GET_svindex"];
+$insn_data{xio_subprocess} = [42, \&PUT_U16, "GET_U16"];
+$insn_data{xio_type} = [43, \&PUT_U8, "GET_U8"];
+$insn_data{xio_flags} = [44, \&PUT_U8, "GET_U8"];
+$insn_data{xcv_stash} = [45, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_start} = [46, \&PUT_opindex, "GET_opindex"];
+$insn_data{xcv_root} = [47, \&PUT_opindex, "GET_opindex"];
+$insn_data{xcv_gv} = [48, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_file} = [49, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{xcv_depth} = [50, \&PUT_I32, "GET_I32"];
+$insn_data{xcv_padlist} = [51, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_outside} = [52, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_flags} = [53, \&PUT_U16, "GET_U16"];
+$insn_data{av_extend} = [54, \&PUT_I32, "GET_I32"];
+$insn_data{av_push} = [55, \&PUT_svindex, "GET_svindex"];
+$insn_data{xav_fill} = [56, \&PUT_I32, "GET_I32"];
+$insn_data{xav_max} = [57, \&PUT_I32, "GET_I32"];
+$insn_data{xav_flags} = [58, \&PUT_U8, "GET_U8"];
+$insn_data{xhv_riter} = [59, \&PUT_I32, "GET_I32"];
+$insn_data{xhv_name} = [60, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{hv_store} = [61, \&PUT_svindex, "GET_svindex"];
+$insn_data{sv_magic} = [62, \&PUT_U8, "GET_U8"];
+$insn_data{mg_obj} = [63, \&PUT_svindex, "GET_svindex"];
+$insn_data{mg_private} = [64, \&PUT_U16, "GET_U16"];
+$insn_data{mg_flags} = [65, \&PUT_U8, "GET_U8"];
+$insn_data{mg_pv} = [66, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xmg_stash} = [67, \&PUT_svindex, "GET_svindex"];
+$insn_data{gv_fetchpv} = [68, \&PUT_strconst, "GET_strconst"];
+$insn_data{gv_stashpv} = [69, \&PUT_strconst, "GET_strconst"];
+$insn_data{gp_sv} = [70, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_refcnt} = [71, \&PUT_U32, "GET_U32"];
+$insn_data{gp_refcnt_add} = [72, \&PUT_I32, "GET_I32"];
+$insn_data{gp_av} = [73, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_hv} = [74, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_cv} = [75, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_file} = [76, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{gp_io} = [77, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_form} = [78, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_cvgen} = [79, \&PUT_U32, "GET_U32"];
+$insn_data{gp_line} = [80, \&PUT_U16, "GET_U16"];
+$insn_data{gp_share} = [81, \&PUT_svindex, "GET_svindex"];
+$insn_data{xgv_flags} = [82, \&PUT_U8, "GET_U8"];
+$insn_data{op_next} = [83, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_sibling} = [84, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_ppaddr} = [85, \&PUT_strconst, "GET_strconst"];
+$insn_data{op_targ} = [86, \&PUT_U32, "GET_U32"];
+$insn_data{op_type} = [87, \&PUT_U16, "GET_U16"];
+$insn_data{op_seq} = [88, \&PUT_U16, "GET_U16"];
+$insn_data{op_flags} = [89, \&PUT_U8, "GET_U8"];
+$insn_data{op_private} = [90, \&PUT_U8, "GET_U8"];
+$insn_data{op_first} = [91, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_last} = [92, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_other} = [93, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmreplroot} = [94, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmreplrootgv} = [95, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_pmreplstart} = [96, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmnext} = [97, \&PUT_opindex, "GET_opindex"];
+$insn_data{pregcomp} = [98, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pmflags} = [99, \&PUT_U16, "GET_U16"];
+$insn_data{op_pmpermflags} = [100, \&PUT_U16, "GET_U16"];
+$insn_data{op_sv} = [101, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_padix} = [102, \&PUT_U32, "GET_U32"];
+$insn_data{op_pv} = [103, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pv_tr} = [104, \&PUT_op_tr_array, "GET_op_tr_array"];
+$insn_data{op_redoop} = [105, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_nextop} = [106, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_lastop} = [107, \&PUT_opindex, "GET_opindex"];
+$insn_data{cop_label} = [108, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{cop_stashpv} = [109, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{cop_file} = [110, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{cop_seq} = [111, \&PUT_U32, "GET_U32"];
+$insn_data{cop_arybase} = [112, \&PUT_I32, "GET_I32"];
+$insn_data{cop_line} = [113, \&PUT_U16, "GET_U16"];
+$insn_data{cop_warnings} = [114, \&PUT_svindex, "GET_svindex"];
+$insn_data{main_start} = [115, \&PUT_opindex, "GET_opindex"];
+$insn_data{main_root} = [116, \&PUT_opindex, "GET_opindex"];
+$insn_data{curpad} = [117, \&PUT_svindex, "GET_svindex"];
+$insn_data{push_begin} = [118, \&PUT_svindex, "GET_svindex"];
+$insn_data{push_init} = [119, \&PUT_svindex, "GET_svindex"];
+$insn_data{push_end} = [120, \&PUT_svindex, "GET_svindex"];
+
+my ($insn_name, $insn_data);
+while (($insn_name, $insn_data) = each %insn_data) {
+    $insn_name[$insn_data->[0]] = $insn_name;
+}
+# Fill in any gaps
+@insn_name = map($_ || "unused", @insn_name);
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode
+
+=head1 SYNOPSIS
+
+	use Asmdata;
+
+=head1 DESCRIPTION
+
+See F<ext/B/B/Asmdata.pm>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Assembler.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Assembler.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Assembler.pm	(revision 14265)
@@ -0,0 +1,285 @@
+#      Assembler.pm
+#
+#      Copyright (c) 1996 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+
+package B::Assembler;
+use Exporter;
+use B qw(ppname);
+use B::Asmdata qw(%insn_data @insn_name);
+use Config qw(%Config);
+require ByteLoader;		# we just need its $VERSIOM
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(assemble_fh newasm endasm assemble);
+$VERSION = 0.02;
+
+use strict;
+my %opnumber;
+my ($i, $opname);
+for ($i = 0; defined($opname = ppname($i)); $i++) {
+    $opnumber{$opname} = $i;
+}
+
+my($linenum, $errors, $out); #	global state, set up by newasm
+
+sub error {
+    my $str = shift;
+    warn "$linenum: $str\n";
+    $errors++;
+}
+
+my $debug = 0;
+sub debug { $debug = shift }
+
+#
+# First define all the data conversion subs to which Asmdata will refer
+#
+
+sub B::Asmdata::PUT_U8 {
+    my $arg = shift;
+    my $c = uncstring($arg);
+    if (defined($c)) {
+	if (length($c) != 1) {
+	    error "argument for U8 is too long: $c";
+	    $c = substr($c, 0, 1);
+	}
+    } else {
+	$c = chr($arg);
+    }
+    return $c;
+}
+
+sub B::Asmdata::PUT_U16 { pack("S", $_[0]) }
+sub B::Asmdata::PUT_U32 { pack("L", $_[0]) }
+sub B::Asmdata::PUT_I32 { pack("L", $_[0]) }
+sub B::Asmdata::PUT_NV  { sprintf("%s\0", $_[0]) } # "%lf" looses precision and pack('d',...)
+						   # may not even be portable between compilers
+sub B::Asmdata::PUT_objindex { pack("L", $_[0]) } # could allow names here
+sub B::Asmdata::PUT_svindex { &B::Asmdata::PUT_objindex }
+sub B::Asmdata::PUT_opindex { &B::Asmdata::PUT_objindex }
+sub B::Asmdata::PUT_pvindex { &B::Asmdata::PUT_objindex }
+
+sub B::Asmdata::PUT_strconst {
+    my $arg = shift;
+    $arg = uncstring($arg);
+    if (!defined($arg)) {
+	error "bad string constant: $arg";
+	return "";
+    }
+    if ($arg =~ s/\0//g) {
+	error "string constant argument contains NUL: $arg";
+    }
+    return $arg . "\0";
+}
+
+sub B::Asmdata::PUT_pvcontents {
+    my $arg = shift;
+    error "extraneous argument: $arg" if defined $arg;
+    return "";
+}
+sub B::Asmdata::PUT_PV {
+    my $arg = shift;
+    $arg = uncstring($arg);
+    error "bad string argument: $arg" unless defined($arg);
+    return pack("L", length($arg)) . $arg;
+}
+sub B::Asmdata::PUT_comment_t {
+    my $arg = shift;
+    $arg = uncstring($arg);
+    error "bad string argument: $arg" unless defined($arg);
+    if ($arg =~ s/\n//g) {
+	error "comment argument contains linefeed: $arg";
+    }
+    return $arg . "\n";
+}
+sub B::Asmdata::PUT_double { sprintf("%s\0", $_[0]) } # see PUT_NV above
+sub B::Asmdata::PUT_none {
+    my $arg = shift;
+    error "extraneous argument: $arg" if defined $arg;
+    return "";
+}
+sub B::Asmdata::PUT_op_tr_array {
+    my $arg = shift;
+    my @ary = split(/\s*,\s*/, $arg);
+    if (@ary != 256) {
+	error "wrong number of arguments to op_tr_array";
+	@ary = (0) x 256;
+    }
+    return pack("S256", @ary);
+}
+# XXX Check this works
+sub B::Asmdata::PUT_IV64 {
+    my $arg = shift;
+    return pack("LL", $arg >> 32, $arg & 0xffffffff);
+}
+
+my %unesc = (n => "\n", r => "\r", t => "\t", a => "\a",
+	     b => "\b", f => "\f", v => "\013");
+
+sub uncstring {
+    my $s = shift;
+    $s =~ s/^"// and $s =~ s/"$// or return undef;
+    $s =~ s/\\(\d\d\d|.)/length($1) == 3 ? chr(oct($1)) : ($unesc{$1}||$1)/eg;
+    return $s;
+}
+
+sub strip_comments {
+    my $stmt = shift;
+    # Comments only allowed in instructions which don't take string arguments
+    $stmt =~ s{
+	(?sx)	# Snazzy extended regexp coming up. Also, treat
+		# string as a single line so .* eats \n characters.
+	^\s*	# Ignore leading whitespace
+	(
+	  [^"]*	# A double quote '"' indicates a string argument. If we
+		# find a double quote, the match fails and we strip nothing.
+	)
+	\s*\#	# Any amount of whitespace plus the comment marker...
+	.*$	# ...which carries on to end-of-string.
+    }{$1};	# Keep only the instruction and optional argument.
+    return $stmt;
+}
+
+# create the ByteCode header: magic, archname, ByteLoader $VERSION, ivsize,
+# 	ptrsize, byteorder
+# nvtype is irrelevant (floats are stored as strings)
+# byteorder is strconst not U32 because of varying size issues
+
+sub gen_header {
+    my $header = "";
+
+    $header .= B::Asmdata::PUT_U32(0x43424c50);	# 'PLBC'
+    $header .= B::Asmdata::PUT_strconst('"' . $Config{archname}. '"');
+    $header .= B::Asmdata::PUT_strconst(qq["$ByteLoader::VERSION"]);
+    $header .= B::Asmdata::PUT_U32($Config{ivsize});
+    $header .= B::Asmdata::PUT_U32($Config{ptrsize});
+    $header .= B::Asmdata::PUT_strconst(sprintf(qq["0x%s"], $Config{byteorder}));
+
+    $header;
+}
+
+sub parse_statement {
+    my $stmt = shift;
+    my ($insn, $arg) = $stmt =~ m{
+	(?sx)
+	^\s*	# allow (but ignore) leading whitespace
+	(.*?)	# Instruction continues up until...
+	(?:	# ...an optional whitespace+argument group
+	    \s+		# first whitespace.
+	    (.*)	# The argument is all the rest (newlines included).
+	)?$	# anchor at end-of-line
+    };	
+    if (defined($arg)) {
+	if ($arg =~ s/^0x(?=[0-9a-fA-F]+$)//) {
+	    $arg = hex($arg);
+	} elsif ($arg =~ s/^0(?=[0-7]+$)//) {
+	    $arg = oct($arg);
+	} elsif ($arg =~ /^pp_/) {
+	    $arg =~ s/\s*$//; # strip trailing whitespace
+	    my $opnum = $opnumber{$arg};
+	    if (defined($opnum)) {
+		$arg = $opnum;
+	    } else {
+		error qq(No such op type "$arg");
+		$arg = 0;
+	    }
+	}
+    }
+    return ($insn, $arg);
+}
+
+sub assemble_insn {
+    my ($insn, $arg) = @_;
+    my $data = $insn_data{$insn};
+    if (defined($data)) {
+	my ($bytecode, $putsub) = @{$data}[0, 1];
+	my $argcode = &$putsub($arg);
+	return chr($bytecode).$argcode;
+    } else {
+	error qq(no such instruction "$insn");
+	return "";
+    }
+}
+
+sub assemble_fh {
+    my ($fh, $out) = @_;
+    my $line;
+    my $asm = newasm($out);
+    while ($line = <$fh>) {
+	assemble($line);
+    }
+    endasm();
+}
+
+sub newasm {
+    my($outsub) = @_;
+
+    die "Invalid printing routine for B::Assembler\n" unless ref $outsub eq 'CODE';
+    die <<EOD if ref $out;
+Can't have multiple byteassembly sessions at once!
+	(perhaps you forgot an endasm()?)
+EOD
+
+    $linenum = $errors = 0;
+    $out = $outsub;
+
+    $out->(gen_header());
+}
+
+sub endasm {
+    if ($errors) {
+	die "There were $errors assembly errors\n";
+    }
+    $linenum = $errors = $out = 0;
+}
+
+sub assemble {
+    my($line) = @_;
+    my ($insn, $arg);
+    $linenum++;
+    chomp $line;
+    if ($debug) {
+	my $quotedline = $line;
+	$quotedline =~ s/\\/\\\\/g;
+	$quotedline =~ s/"/\\"/g;
+	$out->(assemble_insn("comment", qq("$quotedline")));
+    }
+    $line = strip_comments($line) or next;
+    ($insn, $arg) = parse_statement($line);
+    $out->(assemble_insn($insn, $arg));
+    if ($debug) {
+	$out->(assemble_insn("nop", undef));
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Assembler - Assemble Perl bytecode
+
+=head1 SYNOPSIS
+
+	use B::Assembler qw(newasm endasm assemble);
+	newasm(\&printsub);	# sets up for assembly
+	assemble($buf); 	# assembles one line
+	endasm();		# closes down
+
+	use B::Assembler qw(assemble_fh);
+	assemble_fh($fh, \&printsub);	# assemble everything in $fh
+
+=head1 DESCRIPTION
+
+See F<ext/B/B/Assembler.pm>.
+
+=head1 AUTHORS
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+Per-statement interface by Benjamin Stuhl, C<sho_pi@hotmail.com>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Bblock.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Bblock.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Bblock.pm	(revision 14265)
@@ -0,0 +1,180 @@
+package B::Bblock;
+use Exporter ();
+@ISA = "Exporter";
+@EXPORT_OK = qw(find_leaders);
+
+use B qw(peekop walkoptree walkoptree_exec
+	 main_root main_start svref_2object
+         OPf_SPECIAL OPf_STACKED );
+
+use B::Terse;
+use strict;
+
+my $bblock;
+my @bblock_ends;
+
+sub mark_leader {
+    my $op = shift;
+    if ($$op) {
+	$bblock->{$$op} = $op;
+    }
+}
+
+sub remove_sortblock{
+    foreach (keys %$bblock){
+        my $leader=$$bblock{$_};	
+	delete $$bblock{$_} if( $leader == 0);   
+    }
+}
+sub find_leaders {
+    my ($root, $start) = @_;
+    $bblock = {};
+    mark_leader($start) if ( ref $start ne "B::NULL" );
+    walkoptree($root, "mark_if_leader") if ((ref $root) ne "B::NULL") ;
+    remove_sortblock();
+    return $bblock;
+}
+
+# Debugging
+sub walk_bblocks {
+    my ($root, $start) = @_;
+    my ($op, $lastop, $leader, $bb);
+    $bblock = {};
+    mark_leader($start);
+    walkoptree($root, "mark_if_leader");
+    my @leaders = values %$bblock;
+    while ($leader = shift @leaders) {
+	$lastop = $leader;
+	$op = $leader->next;
+	while ($$op && !exists($bblock->{$$op})) {
+	    $bblock->{$$op} = $leader;
+	    $lastop = $op;
+	    $op = $op->next;
+	}
+	push(@bblock_ends, [$leader, $lastop]);
+    }
+    foreach $bb (@bblock_ends) {
+	($leader, $lastop) = @$bb;
+	printf "%s .. %s\n", peekop($leader), peekop($lastop);
+	for ($op = $leader; $$op != $$lastop; $op = $op->next) {
+	    printf "    %s\n", peekop($op);
+	}
+	printf "    %s\n", peekop($lastop);
+    }
+    print "-------\n";
+    walkoptree_exec($start, "terse");
+}
+
+sub walk_bblocks_obj {
+    my $cvref = shift;
+    my $cv = svref_2object($cvref);
+    walk_bblocks($cv->ROOT, $cv->START);
+}
+
+sub B::OP::mark_if_leader {}
+
+sub B::COP::mark_if_leader {
+    my $op = shift;
+    if ($op->label) {
+	mark_leader($op);
+    }
+}
+
+sub B::LOOP::mark_if_leader {
+    my $op = shift;
+    mark_leader($op->next);
+    mark_leader($op->nextop);
+    mark_leader($op->redoop);
+    mark_leader($op->lastop->next);
+}
+
+sub B::LOGOP::mark_if_leader {
+    my $op = shift;
+    my $opname = $op->name;
+    mark_leader($op->next);
+    if ($opname eq "entertry") {
+	mark_leader($op->other->next);
+    } else {
+	mark_leader($op->other);
+    }
+}
+
+sub B::LISTOP::mark_if_leader {
+    my $op = shift;
+    my $first=$op->first;
+    $first=$first->next while ($first->name eq "null");
+    mark_leader($op->first) unless (exists( $bblock->{$$first}));
+    mark_leader($op->next);
+    if ($op->name eq "sort" and $op->flags & OPf_SPECIAL
+	and $op->flags & OPf_STACKED){
+        my $root=$op->first->sibling->first;
+        my $leader=$root->first;
+        $bblock->{$$leader} = 0;
+    }
+}
+
+sub B::PMOP::mark_if_leader {
+    my $op = shift;
+    if ($op->name ne "pushre") {
+	my $replroot = $op->pmreplroot;
+	if ($$replroot) {
+	    mark_leader($replroot);
+	    mark_leader($op->next);
+	    mark_leader($op->pmreplstart);
+	}
+    }
+}
+
+# PMOP stuff omitted
+
+sub compile {
+    my @options = @_;
+    B::clearsym();
+    if (@options) {
+	return sub {
+	    my $objname;
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		eval "walk_bblocks_obj(\\&$objname)";
+		die "walk_bblocks_obj(\\&$objname) failed: $@" if $@;
+	    }
+	}
+    } else {
+	return sub { walk_bblocks(main_root, main_start) };
+    }
+}
+
+# Basic block leaders:
+#     Any COP (pp_nextstate) with a non-NULL label
+#     [The op after a pp_enter] Omit
+#     [The op after a pp_entersub. Don't count this one.]
+#     The ops pointed at by nextop, redoop and lastop->op_next of a LOOP
+#     The ops pointed at by op_next and op_other of a LOGOP, except
+#     for pp_entertry which has op_next and op_other->op_next
+#     The op pointed at by op_pmreplstart of a PMOP
+#     The op pointed at by op_other->op_pmreplstart of pp_substcont?
+#     [The op after a pp_return] Omit
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Bblock - Walk basic blocks
+
+=head1 SYNOPSIS
+
+	perl -MO=Bblock[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This module is used by the B::CC back end.  It walks "basic blocks".
+A basic block is a series of operations which is known to execute from
+start to finish, with no possiblity of branching or halting.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Bytecode.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Bytecode.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Bytecode.pm	(revision 14265)
@@ -0,0 +1,998 @@
+#      Bytecode.pm
+#
+#      Copyright (c) 1996-1998 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B::Bytecode;
+
+use strict;
+use Carp;
+use B qw(main_cv main_root main_start comppadlist
+	 class peekop walkoptree svref_2object cstring walksymtable
+	 init_av begin_av end_av
+	 SVf_POK SVp_POK SVf_IOK SVp_IOK SVf_NOK SVp_NOK
+	 SVf_READONLY GVf_IMPORTED_AV GVf_IMPORTED_CV GVf_IMPORTED_HV
+	 GVf_IMPORTED_SV SVTYPEMASK
+	);
+use B::Asmdata qw(@optype @specialsv_name);
+use B::Assembler qw(newasm endasm assemble);
+
+my %optype_enum;
+my $i;
+for ($i = 0; $i < @optype; $i++) {
+    $optype_enum{$optype[$i]} = $i;
+}
+
+# Following is SVf_POK|SVp_POK
+# XXX Shouldn't be hardwired
+sub POK () { SVf_POK|SVp_POK }
+
+# Following is SVf_IOK|SVp_IOK
+# XXX Shouldn't be hardwired
+sub IOK () { SVf_IOK|SVp_IOK }
+
+# Following is SVf_NOK|SVp_NOK
+# XXX Shouldn't be hardwired
+sub NOK () { SVf_NOK|SVp_NOK }
+
+# nonexistant flags (see B::GV::bytecode for usage)
+sub GVf_IMPORTED_IO () { 0; }
+sub GVf_IMPORTED_FORM () { 0; }
+
+my ($verbose, $no_assemble, $debug_bc, $debug_cv);
+my @packages;	# list of packages to compile
+
+sub asm (@) {	# print replacement that knows about assembling
+    if ($no_assemble) {
+	print @_;
+    } else {
+	my $buf = join '', @_;
+	assemble($_) for (split /\n/, $buf);
+    }
+}
+
+sub asmf (@) {	# printf replacement that knows about assembling
+    if ($no_assemble) {
+	printf shift(), @_;
+    } else {
+	my $format = shift;
+	my $buf = sprintf $format, @_;
+	assemble($_) for (split /\n/, $buf);
+    }
+}
+
+# Optimisation options. On the command line, use hyphens instead of
+# underscores for compatibility with gcc-style options. We use
+# underscores here because they are OK in (strict) barewords.
+my ($compress_nullops, $omit_seq, $bypass_nullops);
+my %optimise = (compress_nullops	=> \$compress_nullops,
+		omit_sequence_numbers	=> \$omit_seq,
+		bypass_nullops		=> \$bypass_nullops);
+
+my $strip_syntree;	# this is left here in case stripping the
+			# syntree ever becomes safe again
+			#	-- BKS, June 2000
+
+my $nextix = 0;
+my %symtable;	# maps object addresses to object indices.
+		# Filled in at allocation (newsv/newop) time.
+
+my %saved;	# maps object addresses (for SVish classes) to "saved yet?"
+		# flag. Set at FOO::bytecode time usually by SV::bytecode.
+		# Manipulated via saved(), mark_saved(), unmark_saved().
+
+my %strtable;	# maps shared strings to object indices
+		# Filled in at allocation (pvix) time
+
+my $svix = -1;	# we keep track of when the sv register contains an element
+		# of the object table to avoid unnecessary repeated
+		# consecutive ldsv instructions.
+
+my $opix = -1;	# Ditto for the op register.
+
+sub ldsv {
+    my $ix = shift;
+    if ($ix != $svix) {
+	asm "ldsv $ix\n";
+	$svix = $ix;
+    }
+}
+
+sub stsv {
+    my $ix = shift;
+    asm "stsv $ix\n";
+    $svix = $ix;
+}
+
+sub set_svix {
+    $svix = shift;
+}
+
+sub ldop {
+    my $ix = shift;
+    if ($ix != $opix) {
+	asm "ldop $ix\n";
+	$opix = $ix;
+    }
+}
+
+sub stop {
+    my $ix = shift;
+    asm "stop $ix\n";
+    $opix = $ix;
+}
+
+sub set_opix {
+    $opix = shift;
+}
+
+sub pvstring {
+    my $str = shift;
+    if (defined($str)) {
+	return cstring($str . "\0");
+    } else {
+	return '""';
+    }
+}
+
+sub nv {
+    # print full precision
+    my $str = sprintf "%.40f", $_[0];
+    $str =~ s/0+$//;		# remove trailing zeros
+    $str =~ s/\.$/.0/;
+    return $str;
+}
+
+sub saved { $saved{${$_[0]}} }
+sub mark_saved { $saved{${$_[0]}} = 1 }
+sub unmark_saved { $saved{${$_[0]}} = 0 }
+
+sub debug { $debug_bc = shift }
+
+sub pvix {	# save a shared PV (mainly for COPs)
+    return $strtable{$_[0]} if defined($strtable{$_[0]});
+    asmf "newpv %s\n", pvstring($_[0]);
+    my $ix = $nextix++;
+    $strtable{$_[0]} = $ix;
+    asmf "stpv %d\n", $ix;
+    return $ix;
+}
+
+sub B::OBJECT::nyi {
+    my $obj = shift;
+    warn sprintf("bytecode save method for %s (0x%x) not yet implemented\n",
+		 class($obj), $$obj);
+}
+
+#
+# objix may stomp on the op register (for op objects)
+# or the sv register (for SV objects)
+#
+sub B::OBJECT::objix {
+    my $obj = shift;
+    my $ix = $symtable{$$obj};
+    if (defined($ix)) {
+	return $ix;
+    } else {
+	$obj->newix($nextix);
+	return $symtable{$$obj} = $nextix++;
+    }
+}
+
+sub B::SV::newix {
+    my ($sv, $ix) = @_;
+    asmf "newsv %d\t# %s\n", $sv->FLAGS & SVTYPEMASK, class($sv);
+    stsv($ix);    
+}
+
+sub B::GV::newix {
+    my ($gv, $ix) = @_;
+    my $gvname = $gv->NAME;
+    my $name = cstring($gv->STASH->NAME . "::" . $gvname);
+    asm "gv_fetchpv $name\n";
+    stsv($ix);
+}
+
+sub B::HV::newix {
+    my ($hv, $ix) = @_;
+    my $name = $hv->NAME;
+    if ($name) {
+	# It's a stash
+	asmf "gv_stashpv %s\n", cstring($name);
+	stsv($ix);
+    } else {
+	# It's an ordinary HV. Fall back to ordinary newix method
+	$hv->B::SV::newix($ix);
+    }
+}
+
+sub B::SPECIAL::newix {
+    my ($sv, $ix) = @_;
+    # Special case. $$sv is not the address of the SV but an
+    # index into svspecialsv_list.
+    asmf "ldspecsv $$sv\t# %s\n", $specialsv_name[$$sv];
+    stsv($ix);
+}
+
+sub B::OP::newix {
+    my ($op, $ix) = @_;
+    my $class = class($op);
+    my $typenum = $optype_enum{$class};
+    croak("OP::newix: can't understand class $class") unless defined($typenum);
+    asm "newop $typenum\t# $class\n";
+    stop($ix);
+}
+
+sub B::OP::walkoptree_debug {
+    my $op = shift;
+    warn(sprintf("walkoptree: %s\n", peekop($op)));
+}
+
+sub B::OP::bytecode {
+    my $op = shift;
+    my $next = $op->next;
+    my $nextix;
+    my $sibix = $op->sibling->objix unless $strip_syntree;
+    my $ix = $op->objix;
+    my $type = $op->type;
+
+    if ($bypass_nullops) {
+	$next = $next->next while $$next && $next->type == 0;
+    }
+    $nextix = $next->objix;
+
+    asmf "# %s\n", peekop($op) if $debug_bc;
+    ldop($ix);
+    asm "op_next $nextix\n";
+    asm "op_sibling $sibix\n" unless $strip_syntree;
+    asmf "op_type %s\t# %d\n", "pp_" . $op->name, $type;
+    asmf("op_seq %d\n", $op->seq) unless $omit_seq;
+    if ($type || !$compress_nullops) {
+	asmf "op_targ %d\nop_flags 0x%x\nop_private 0x%x\n",
+	    $op->targ, $op->flags, $op->private;
+    }
+}
+
+sub B::UNOP::bytecode {
+    my $op = shift;
+    my $firstix = $op->first->objix unless $strip_syntree;
+    $op->B::OP::bytecode;
+    if (($op->type || !$compress_nullops) && !$strip_syntree) {
+	asm "op_first $firstix\n";
+    }
+}
+
+sub B::LOGOP::bytecode {
+    my $op = shift;
+    my $otherix = $op->other->objix;
+    $op->B::UNOP::bytecode;
+    asm "op_other $otherix\n";
+}
+
+sub B::SVOP::bytecode {
+    my $op = shift;
+    my $sv = $op->sv;
+    my $svix = $sv->objix;
+    $op->B::OP::bytecode;
+    asm "op_sv $svix\n";
+    $sv->bytecode;
+}
+
+sub B::PADOP::bytecode {
+    my $op = shift;
+    my $padix = $op->padix;
+    $op->B::OP::bytecode;
+    asm "op_padix $padix\n";
+}
+
+sub B::PVOP::bytecode {
+    my $op = shift;
+    my $pv = $op->pv;
+    $op->B::OP::bytecode;
+    #
+    # This would be easy except that OP_TRANS uses a PVOP to store an
+    # endian-dependent array of 256 shorts instead of a plain string.
+    #
+    if ($op->name eq "trans") {
+	my @shorts = unpack("s256", $pv); # assembler handles endianness
+	asm "op_pv_tr ", join(",", @shorts), "\n";
+    } else {
+	asmf "newpv %s\nop_pv\n", pvstring($pv);
+    }
+}
+
+sub B::BINOP::bytecode {
+    my $op = shift;
+    my $lastix = $op->last->objix unless $strip_syntree;
+    $op->B::UNOP::bytecode;
+    if (($op->type || !$compress_nullops) && !$strip_syntree) {
+	asm "op_last $lastix\n";
+    }
+}
+
+sub B::LOOP::bytecode {
+    my $op = shift;
+    my $redoopix = $op->redoop->objix;
+    my $nextopix = $op->nextop->objix;
+    my $lastopix = $op->lastop->objix;
+    $op->B::LISTOP::bytecode;
+    asm "op_redoop $redoopix\nop_nextop $nextopix\nop_lastop $lastopix\n";
+}
+
+sub B::COP::bytecode {
+    my $op = shift;
+    my $file = $op->file;
+    my $line = $op->line;
+    if ($debug_bc) { # do this early to aid debugging
+	asmf "# line %s:%d\n", $file, $line;
+    }
+    my $stashpv = $op->stashpv;
+    my $warnings = $op->warnings;
+    my $warningsix = $warnings->objix;
+    my $labelix = pvix($op->label);
+    my $stashix = pvix($stashpv);
+    my $fileix = pvix($file);
+    $warnings->bytecode;
+    $op->B::OP::bytecode;
+    asmf <<"EOT", $labelix, $stashix, $op->cop_seq, $fileix, $op->arybase;
+cop_label %d
+cop_stashpv %d
+cop_seq %d
+cop_file %d
+cop_arybase %d
+cop_line $line
+cop_warnings $warningsix
+EOT
+}
+
+sub B::PMOP::bytecode {
+    my $op = shift;
+    my $replroot = $op->pmreplroot;
+    my $replrootix = $replroot->objix;
+    my $replstartix = $op->pmreplstart->objix;
+    my $opname = $op->name;
+    # pmnext is corrupt in some PMOPs (see misc.t for example)
+    #my $pmnextix = $op->pmnext->objix;
+
+    if ($$replroot) {
+	# OP_PUSHRE (a mutated version of OP_MATCH for the regexp
+	# argument to a split) stores a GV in op_pmreplroot instead
+	# of a substitution syntax tree. We don't want to walk that...
+	if ($opname eq "pushre") {
+	    $replroot->bytecode;
+	} else {
+	    walkoptree($replroot, "bytecode");
+	}
+    }
+    $op->B::LISTOP::bytecode;
+    if ($opname eq "pushre") {
+	asmf "op_pmreplrootgv $replrootix\n";
+    } else {
+	asm "op_pmreplroot $replrootix\nop_pmreplstart $replstartix\n";
+    }
+    my $re = pvstring($op->precomp);
+    # op_pmnext omitted since a perl bug means it's sometime corrupt
+    asmf <<"EOT", $op->pmflags, $op->pmpermflags;
+op_pmflags 0x%x
+op_pmpermflags 0x%x
+newpv $re
+pregcomp
+EOT
+}
+
+sub B::SV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    my $ix = $sv->objix;
+    my $refcnt = $sv->REFCNT;
+    my $flags = sprintf("0x%x", $sv->FLAGS);
+    ldsv($ix);
+    asm "sv_refcnt $refcnt\nsv_flags $flags\n";
+    mark_saved($sv);
+}
+
+sub B::PV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    $sv->B::SV::bytecode;
+    asmf("newpv %s\nxpv\n", pvstring($sv->PV)) if $sv->FLAGS & POK;
+}
+
+sub B::IV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    my $iv = $sv->IVX;
+    $sv->B::SV::bytecode;
+    asmf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32" if $sv->FLAGS & IOK; # could be PVNV
+}
+
+sub B::NV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    $sv->B::SV::bytecode;
+    asmf "xnv %s\n", nv($sv->NVX);
+}
+
+sub B::RV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    my $rv = $sv->RV;
+    my $rvix = $rv->objix;
+    $rv->bytecode;
+    $sv->B::SV::bytecode;
+    asm "xrv $rvix\n";
+}
+
+sub B::PVIV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    my $iv = $sv->IVX;
+    $sv->B::PV::bytecode;
+    asmf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32";
+}
+
+sub B::PVNV::bytecode {
+    my $sv = shift;
+    my $flag = shift || 0;
+    # The $flag argument is passed through PVMG::bytecode by BM::bytecode
+    # and AV::bytecode and indicates special handling. $flag = 1 is used by
+    # BM::bytecode and means that we should ensure we save the whole B-M
+    # table. It consists of 257 bytes (256 char array plus a final \0)
+    # which follow the ordinary PV+\0 and the 257 bytes are *not* reflected
+    # in SvCUR. $flag = 2 is used by AV::bytecode and means that we only
+    # call SV::bytecode instead of saving PV and calling NV::bytecode since
+    # PV/NV/IV stuff is different for AVs.
+    return if saved($sv);
+    if ($flag == 2) {
+	$sv->B::SV::bytecode;
+    } else {
+	my $pv = $sv->PV;
+	$sv->B::IV::bytecode;
+	asmf "xnv %s\n", nv($sv->NVX);
+	if ($flag == 1) {
+	    $pv .= "\0" . $sv->TABLE;
+	    asmf "newpv %s\npv_cur %d\nxpv\n", pvstring($pv),length($pv)-257;
+	} else {
+	    asmf("newpv %s\nxpv\n", pvstring($pv)) if $sv->FLAGS & POK;
+	}
+    }
+}
+
+sub B::PVMG::bytecode {
+    my ($sv, $flag) = @_;
+    # See B::PVNV::bytecode for an explanation of $flag.
+    return if saved($sv);
+    # XXX We assume SvSTASH is already saved and don't save it later ourselves
+    my $stashix = $sv->SvSTASH->objix;
+    my @mgchain = $sv->MAGIC;
+    my (@mgobjix, $mg);
+    #
+    # We need to traverse the magic chain and get objix for each OBJ
+    # field *before* we do B::PVNV::bytecode since objix overwrites
+    # the sv register. However, we need to write the magic-saving
+    # bytecode *after* B::PVNV::bytecode since sv isn't initialised
+    # to refer to $sv until then.
+    #
+    @mgobjix = map($_->OBJ->objix, @mgchain);
+    $sv->B::PVNV::bytecode($flag);
+    asm "xmg_stash $stashix\n";
+    foreach $mg (@mgchain) {
+	asmf "sv_magic %s\nmg_obj %d\nnewpv %s\nmg_pv\n",
+	    cstring($mg->TYPE), shift(@mgobjix), pvstring($mg->PTR);
+    }
+}
+
+sub B::PVLV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    $sv->B::PVMG::bytecode;
+    asmf <<'EOT', $sv->TARGOFF, $sv->TARGLEN, cstring($sv->TYPE);
+xlv_targoff %d
+xlv_targlen %d
+xlv_type %s
+EOT
+}
+
+sub B::BM::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    # See PVNV::bytecode for an explanation of what the argument does
+    $sv->B::PVMG::bytecode(1);
+    asmf "xbm_useful %d\nxbm_previous %d\nxbm_rare %d\n",
+	$sv->USEFUL, $sv->PREVIOUS, $sv->RARE;
+}
+
+sub empty_gv {	# is a GV empty except for imported stuff?
+    my $gv = shift;
+
+    return 0 if ($gv->SV->FLAGS & SVTYPEMASK);	# sv not SVt_NULL
+    my @subfield_names = qw(AV HV CV FORM IO);
+    @subfield_names = grep {;
+				no strict 'refs';
+				!($gv->GvFLAGS & ${\"GVf_IMPORTED_$_"}->()) && ${$gv->$_()};
+			} @subfield_names;
+    return scalar @subfield_names;
+}
+
+sub B::GV::bytecode {
+    my $gv = shift;
+    return if saved($gv);
+    return unless grep { $_ eq $gv->STASH->NAME; } @packages;
+    return if $gv->NAME =~ m/^\(/;	# ignore overloads - they'll be rebuilt
+    my $ix = $gv->objix;
+    mark_saved($gv);
+    ldsv($ix);
+    asmf <<"EOT", $gv->FLAGS, $gv->GvFLAGS;
+sv_flags 0x%x
+xgv_flags 0x%x
+EOT
+    my $refcnt = $gv->REFCNT;
+    asmf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1;
+    return if $gv->is_empty;
+    asmf <<"EOT", $gv->LINE, pvix($gv->FILE);
+gp_line %d
+gp_file %d
+EOT
+    my $gvname = $gv->NAME;
+    my $name = cstring($gv->STASH->NAME . "::" . $gvname);
+    my $egv = $gv->EGV;
+    my $egvix = $egv->objix;
+    my $gvrefcnt = $gv->GvREFCNT;
+    asmf("gp_refcnt_add %d\n", $gvrefcnt - 1) if $gvrefcnt > 1;
+    if ($gvrefcnt > 1 &&  $ix != $egvix) {
+	asm "gp_share $egvix\n";
+    } else {
+	if ($gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/) {
+	    my $i;
+	    my @subfield_names = qw(SV AV HV CV FORM IO);
+	    @subfield_names = grep {;
+					no strict 'refs';
+					!($gv->GvFLAGS & ${\"GVf_IMPORTED_$_"}->());
+				} @subfield_names;
+	    my @subfields = map($gv->$_(), @subfield_names);
+	    my @ixes = map($_->objix, @subfields);
+	    # Reset sv register for $gv
+	    ldsv($ix);
+	    for ($i = 0; $i < @ixes; $i++) {
+		asmf "gp_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
+	    }
+	    # Now save all the subfields
+	    my $sv;
+	    foreach $sv (@subfields) {
+		$sv->bytecode;
+	    }
+	}
+    }
+}
+
+sub B::HV::bytecode {
+    my $hv = shift;
+    return if saved($hv);
+    mark_saved($hv);
+    my $name = $hv->NAME;
+    my $ix = $hv->objix;
+    if (!$name) {
+	# It's an ordinary HV. Stashes have NAME set and need no further
+	# saving beyond the gv_stashpv that $hv->objix already ensures.
+	my @contents = $hv->ARRAY;
+	my ($i, @ixes);
+	for ($i = 1; $i < @contents; $i += 2) {
+	    push(@ixes, $contents[$i]->objix);
+	}
+	for ($i = 1; $i < @contents; $i += 2) {
+	    $contents[$i]->bytecode;
+	}
+	ldsv($ix);
+	for ($i = 0; $i < @contents; $i += 2) {
+	    asmf("newpv %s\nhv_store %d\n",
+		   pvstring($contents[$i]), $ixes[$i / 2]);
+	}
+	asmf "sv_refcnt %d\nsv_flags 0x%x\n", $hv->REFCNT, $hv->FLAGS;
+    }
+}
+
+sub B::AV::bytecode {
+    my $av = shift;
+    return if saved($av);
+    my $ix = $av->objix;
+    my $fill = $av->FILL;
+    my $max = $av->MAX;
+    my (@array, @ixes);
+    if ($fill > -1) {
+	@array = $av->ARRAY;
+	@ixes = map($_->objix, @array);
+	my $sv;
+	foreach $sv (@array) {
+	    $sv->bytecode;
+	}
+    }
+    # See PVNV::bytecode for the meaning of the flag argument of 2.
+    $av->B::PVMG::bytecode(2);
+    # Recover sv register and set AvMAX and AvFILL to -1 (since we
+    # create an AV with NEWSV and SvUPGRADE rather than doing newAV
+    # which is what sets AvMAX and AvFILL.
+    ldsv($ix);
+    asmf "sv_flags 0x%x\n", $av->FLAGS & ~SVf_READONLY; # SvREADONLY_off($av) in case PADCONST
+    asmf "xav_flags 0x%x\nxav_max -1\nxav_fill -1\n", $av->AvFLAGS;
+    if ($fill > -1) {
+	my $elix;
+	foreach $elix (@ixes) {
+	    asm "av_push $elix\n";
+	}
+    } else {
+	if ($max > -1) {
+	    asm "av_extend $max\n";
+	}
+    }
+    asmf "sv_flags 0x%x\n", $av->FLAGS; # restore flags from above
+}
+
+sub B::CV::bytecode {
+    my $cv = shift;
+    return if saved($cv);
+    return if ${$cv->GV} && ($cv->GV->GvFLAGS & GVf_IMPORTED_CV);
+    my $fileix = pvix($cv->FILE);
+    my $ix = $cv->objix;
+    $cv->B::PVMG::bytecode;
+    my $i;
+    my @subfield_names = qw(ROOT START STASH GV PADLIST OUTSIDE);
+    my @subfields = map($cv->$_(), @subfield_names);
+    my @ixes = map($_->objix, @subfields);
+    # Save OP tree from CvROOT (first element of @subfields)
+    my $root = shift @subfields;
+    if ($$root) {
+	walkoptree($root, "bytecode");
+    }
+    # Reset sv register for $cv (since above ->objix calls stomped on it)
+    ldsv($ix);
+    for ($i = 0; $i < @ixes; $i++) {
+	asmf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
+    }
+    asmf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->CvFLAGS;
+    asmf "xcv_file %d\n", $fileix;
+    # Now save all the subfields (except for CvROOT which was handled
+    # above) and CvSTART (now the initial element of @subfields).
+    shift @subfields; # bye-bye CvSTART
+    my $sv;
+    foreach $sv (@subfields) {
+	$sv->bytecode;
+    }
+}
+
+sub B::IO::bytecode {
+    my $io = shift;
+    return if saved($io);
+    my $ix = $io->objix;
+    my $top_gv = $io->TOP_GV;
+    my $top_gvix = $top_gv->objix;
+    my $fmt_gv = $io->FMT_GV;
+    my $fmt_gvix = $fmt_gv->objix;
+    my $bottom_gv = $io->BOTTOM_GV;
+    my $bottom_gvix = $bottom_gv->objix;
+
+    $io->B::PVMG::bytecode;
+    ldsv($ix);
+    asm "xio_top_gv $top_gvix\n";
+    asm "xio_fmt_gv $fmt_gvix\n";
+    asm "xio_bottom_gv $bottom_gvix\n";
+    my $field;
+    foreach $field (qw(TOP_NAME FMT_NAME BOTTOM_NAME)) {
+	asmf "newpv %s\nxio_%s\n", pvstring($io->$field()), lc($field);
+    }
+    foreach $field (qw(LINES PAGE PAGE_LEN LINES_LEFT SUBPROCESS)) {
+	asmf "xio_%s %d\n", lc($field), $io->$field();
+    }
+    asmf "xio_type %s\nxio_flags 0x%x\n", cstring($io->IoTYPE), $io->IoFLAGS;
+    $top_gv->bytecode;
+    $fmt_gv->bytecode;
+    $bottom_gv->bytecode;
+}
+
+sub B::SPECIAL::bytecode {
+    # nothing extra needs doing
+}
+
+sub bytecompile_object {
+    for my $sv (@_) {
+	svref_2object($sv)->bytecode;
+    }
+}
+
+sub B::GV::bytecodecv {
+    my $gv = shift;
+    my $cv = $gv->CV;
+    if ($$cv && !saved($cv) && !($gv->FLAGS & GVf_IMPORTED_CV)) {
+	if ($debug_cv) {
+	    warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
+			 $gv->STASH->NAME, $gv->NAME, $$cv, $$gv);
+	}
+	$gv->bytecode;
+    }
+}
+
+sub save_call_queues {
+    if (begin_av()->isa("B::AV")) {	# this is just to save 'use Foo;' calls
+	for my $cv (begin_av()->ARRAY) {
+	    next unless grep { $_ eq $cv->STASH->NAME; } @packages;
+	    my $op = $cv->START;
+OPLOOP:
+	    while ($$op) {
+	 	if ($op->name eq 'require') { # save any BEGIN that does a require
+		    $cv->bytecode;
+		    asmf "push_begin %d\n", $cv->objix;
+		    last OPLOOP;
+		}
+		$op = $op->next;
+	    }
+	}
+    }
+    if (init_av()->isa("B::AV")) {
+	for my $cv (init_av()->ARRAY) {
+	    next unless grep { $_ eq $cv->STASH->NAME; } @packages;
+	    $cv->bytecode;
+	    asmf "push_init %d\n", $cv->objix;
+	}
+    }
+    if (end_av()->isa("B::AV")) {
+	for my $cv (end_av()->ARRAY) {
+	    next unless grep { $_ eq $cv->STASH->NAME; } @packages;
+	    $cv->bytecode;
+	    asmf "push_end %d\n", $cv->objix;
+	}
+    }
+}
+
+sub symwalk {
+    no strict 'refs';
+    my $ok = 1 if grep { (my $name = $_[0]) =~ s/::$//; $_ eq $name;} @packages;
+    if (grep { /^$_[0]/; } @packages) {
+	walksymtable(\%{"$_[0]"}, "bytecodecv", \&symwalk, $_[0]);
+    }
+    warn "considering $_[0] ... " . ($ok ? "accepted\n" : "rejected\n")
+	if $debug_bc;
+    $ok;
+}
+
+sub bytecompile_main {
+    my $curpad = (comppadlist->ARRAY)[1];
+    my $curpadix = $curpad->objix;
+    $curpad->bytecode;
+    save_call_queues();
+    walkoptree(main_root, "bytecode") unless ref(main_root) eq "B::NULL";
+    warn "done main program, now walking symbol table\n" if $debug_bc;
+    if (@packages) {
+	no strict qw(refs);
+	walksymtable(\%{"main::"}, "bytecodecv", \&symwalk);
+    } else {
+	die "No packages requested for compilation!\n";
+    }
+    asmf "main_root %d\n", main_root->objix;
+    asmf "main_start %d\n", main_start->objix;
+    asmf "curpad $curpadix\n";
+    # XXX Do min_intro_pending and max_intro_pending matter?
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+    open(OUT, ">&STDOUT");
+    binmode OUT;
+    select OUT;
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "o") {
+	    $arg ||= shift @options;
+	    open(OUT, ">$arg") or return "$arg: $!\n";
+	    binmode OUT;
+	} elsif ($opt eq "a") {
+	    $arg ||= shift @options;
+	    open(OUT, ">>$arg") or return "$arg: $!\n";
+	    binmode OUT;
+	} elsif ($opt eq "D") {
+	    $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "b") {
+		    $| = 1;
+		    debug(1);
+		} elsif ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "a") {
+		    B::Assembler::debug(1);
+		} elsif ($arg eq "C") {
+		    $debug_cv = 1;
+		}
+	    }
+	} elsif ($opt eq "v") {
+	    $verbose = 1;
+	} elsif ($opt eq "S") {
+	    $no_assemble = 1;
+	} elsif ($opt eq "f") {
+	    $arg ||= shift @options;
+	    my $value = $arg !~ s/^no-//;
+	    $arg =~ s/-/_/g;
+	    my $ref = $optimise{$arg};
+	    if (defined($ref)) {
+		$$ref = $value;
+	    } else {
+		warn qq(ignoring unknown optimisation option "$arg"\n);
+	    }
+	} elsif ($opt eq "O") {
+	    $arg = 1 if $arg eq "";
+	    my $ref;
+	    foreach $ref (values %optimise) {
+		$$ref = 0;
+	    }
+	    if ($arg >= 2) {
+		$bypass_nullops = 1;
+	    }
+	    if ($arg >= 1) {
+		$compress_nullops = 1;
+		$omit_seq = 1;
+	    }
+	} elsif ($opt eq "u") {
+	    $arg ||= shift @options;
+	    push @packages, $arg;
+	} else {
+	    warn qq(ignoring unknown option "$opt$arg"\n);
+	}
+    }
+    if (! @packages) {
+	warn "No package specified for compilation, assuming main::\n";
+	@packages = qw(main);
+    }
+    if (@options) {
+	die "Extraneous options left on B::Bytecode commandline: @options\n";
+    } else {
+	return sub { 
+	    newasm(\&apr) unless $no_assemble;
+	    bytecompile_main();
+	    endasm() unless $no_assemble;
+	};
+    }
+}
+
+sub apr { print @_; }
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Bytecode - Perl compiler's bytecode backend
+
+=head1 SYNOPSIS
+
+	perl -MO=Bytecode[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This compiler backend takes Perl source and generates a
+platform-independent bytecode encapsulating code to load the
+internal structures perl uses to run your program. When the
+generated bytecode is loaded in, your program is ready to run,
+reducing the time which perl would have taken to load and parse
+your program into its internal semi-compiled form. That means that
+compiling with this backend will not help improve the runtime
+execution speed of your program but may improve the start-up time.
+Depending on the environment in which your program runs this may
+or may not be a help.
+
+The resulting bytecode can be run with a special byteperl executable
+or (for non-main programs) be loaded via the C<byteload_fh> function
+in the F<B> module.
+
+=head1 OPTIONS
+
+If there are any non-option arguments, they are taken to be names of
+objects to be saved (probably doesn't work properly yet).  Without
+extra arguments, it saves the main program.
+
+=over 4
+
+=item B<-ofilename>
+
+Output to filename instead of STDOUT.
+
+=item B<-afilename>
+
+Append output to filename.
+
+=item B<-->
+
+Force end of options.
+
+=item B<-f>
+
+Force optimisations on or off one at a time. Each can be preceded
+by B<no-> to turn the option off (e.g. B<-fno-compress-nullops>).
+
+=item B<-fcompress-nullops>
+
+Only fills in the necessary fields of ops which have
+been optimised away by perl's internal compiler.
+
+=item B<-fomit-sequence-numbers>
+
+Leaves out code to fill in the op_seq field of all ops
+which is only used by perl's internal compiler.
+
+=item B<-fbypass-nullops>
+
+If op->op_next ever points to a NULLOP, replaces the op_next field
+with the first non-NULLOP in the path of execution.
+
+=item B<-On>
+
+Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>.
+B<-O1> sets B<-fcompress-nullops> B<-fomit-sequence numbers>.
+B<-O2> adds B<-fbypass-nullops>.
+
+=item B<-D>
+
+Debug options (concatenated or separate flags like C<perl -D>).
+
+=item B<-Do>
+
+Prints each OP as it's processed.
+
+=item B<-Db>
+
+Print debugging information about bytecompiler progress.
+
+=item B<-Da>
+
+Tells the (bytecode) assembler to include source assembler lines
+in its output as bytecode comments.
+
+=item B<-DC>
+
+Prints each CV taken from the final symbol tree walk.
+
+=item B<-S>
+
+Output (bytecode) assembler source rather than piping it
+through the assembler and outputting bytecode.
+
+=item B<-upackage>
+  
+Stores package in the output.
+  
+=back
+
+=head1 EXAMPLES
+
+    perl -MO=Bytecode,-O6,-ofoo.plc,-umain foo.pl
+
+    perl -MO=Bytecode,-S,-umain foo.pl > foo.S
+    assemble foo.S > foo.plc
+
+Note that C<assemble> lives in the C<B> subdirectory of your perl
+library directory. The utility called perlcc may also be used to 
+help make use of this compiler.
+
+    perl -MO=Bytecode,-uFoo,-oFoo.pmc Foo.pm
+
+=head1 BUGS
+
+Output is still huge and there are still occasional crashes during
+either compilation or ByteLoading. Current status: experimental.
+
+=head1 AUTHORS
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+Benjamin Stuhl, C<sho_pi@hotmail.com>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/C.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/C.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/C.pm	(revision 14265)
@@ -0,0 +1,1657 @@
+#      C.pm
+#
+#      Copyright (c) 1996, 1997, 1998 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B::C::Section;
+use B ();
+use base B::Section;
+
+sub new
+{
+ my $class = shift;
+ my $o = $class->SUPER::new(@_);
+ push(@$o,[]);
+ return $o;
+}
+
+sub add
+{  
+ my $section = shift;
+ push(@{$section->[-1]},@_);
+}
+
+sub index
+{  
+ my $section = shift;
+ return scalar(@{$section->[-1]})-1;
+}
+
+sub output
+{   
+ my ($section, $fh, $format) = @_;
+ my $sym = $section->symtable || {};
+ my $default = $section->default;
+ foreach (@{$section->[-1]})
+  {
+   s{(s\\_[0-9a-f]+)}{ exists($sym->{$1}) ? $sym->{$1} : $default; }ge;
+   printf $fh $format, $_;
+  }
+}
+
+package B::C;
+use Exporter ();
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(output_all output_boilerplate output_main mark_unused
+		init_sections set_callback save_unused_subs objsym save_context);
+
+use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start peekop
+	 class cstring cchar svref_2object compile_stats comppadlist hash
+	 threadsv_names main_cv init_av opnumber amagic_generation
+	 AVf_REAL HEf_SVKEY);
+use B::Asmdata qw(@specialsv_name);
+
+use FileHandle;
+use Carp;
+use strict;
+use Config;
+
+my $hv_index = 0;
+my $gv_index = 0;
+my $re_index = 0;
+my $pv_index = 0;
+my $anonsub_index = 0;
+my $initsub_index = 0;
+
+my %symtable;
+my %xsub;
+my $warn_undefined_syms;
+my $verbose;
+my %unused_sub_packages;
+my $nullop_count;
+my $pv_copy_on_grow = 0;
+my ($debug_cops, $debug_av, $debug_cv, $debug_mg);
+my $max_string_len;
+
+my @threadsv_names;
+BEGIN {
+    @threadsv_names = threadsv_names();
+}
+
+# Code sections
+my ($init, $decl, $symsect, $binopsect, $condopsect, $copsect, 
+    $padopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect,
+    $pvopsect, $svopsect, $unopsect, $svsect, $xpvsect, $xpvavsect,
+    $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect,
+    $xrvsect, $xpvbmsect, $xpviosect );
+
+sub walk_and_save_optree;
+my $saveoptree_callback = \&walk_and_save_optree;
+sub set_callback { $saveoptree_callback = shift }
+sub saveoptree { &$saveoptree_callback(@_) }
+
+sub walk_and_save_optree {
+    my ($name, $root, $start) = @_;
+    walkoptree($root, "save");
+    return objsym($start);
+}
+
+# Current workaround/fix for op_free() trying to free statically
+# defined OPs is to set op_seq = -1 and check for that in op_free().
+# Instead of hardwiring -1 in place of $op->seq, we use $op_seq
+# so that it can be changed back easily if necessary. In fact, to
+# stop compilers from moaning about a U16 being initialised with an
+# uncast -1 (the printf format is %d so we can't tweak it), we have
+# to "know" that op_seq is a U16 and use 65535. Ugh.
+my $op_seq = 65535;
+
+# Look this up here so we can do just a number compare
+# rather than looking up the name of every BASEOP in B::OP
+my $OP_THREADSV = opnumber('threadsv');
+
+sub savesym {
+    my ($obj, $value) = @_;
+    my $sym = sprintf("s\\_%x", $$obj);
+    $symtable{$sym} = $value;
+}
+
+sub objsym {
+    my $obj = shift;
+    return $symtable{sprintf("s\\_%x", $$obj)};
+}
+
+sub getsym {
+    my $sym = shift;
+    my $value;
+
+    return 0 if $sym eq "sym_0";	# special case
+    $value = $symtable{$sym};
+    if (defined($value)) {
+	return $value;
+    } else {
+	warn "warning: undefined symbol $sym\n" if $warn_undefined_syms;
+	return "UNUSED";
+    }
+}
+
+sub savepv {
+    my $pv = shift;         
+    $pv    = '' unless defined $pv;  # Is this sane ?
+    my $pvsym = 0;
+    my $pvmax = 0;
+    if ($pv_copy_on_grow) { 
+	my $cstring = cstring($pv);
+	if ($cstring ne "0") { # sic
+	    $pvsym = sprintf("pv%d", $pv_index++);
+	    $decl->add(sprintf("static char %s[] = %s;", $pvsym, $cstring));
+	}
+    } else {
+	$pvmax = length($pv) + 1;
+    }
+    return ($pvsym, $pvmax);
+}
+
+sub B::OP::save {
+    my ($op, $level) = @_;
+    my $sym = objsym($op);
+    return $sym if defined $sym;
+    my $type = $op->type;
+    $nullop_count++ unless $type;
+    if ($type == $OP_THREADSV) {
+	# saves looking up ppaddr but it's a bit naughty to hard code this
+	$init->add(sprintf("(void)find_threadsv(%s);",
+			   cstring($threadsv_names[$op->targ])));
+    }
+    $opsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x",
+			 ${$op->next}, ${$op->sibling}, $op->targ,
+			 $type, $op_seq, $op->flags, $op->private));
+    my $ix = $opsect->index;
+    $init->add(sprintf("op_list[$ix].op_ppaddr = %s;", $op->ppaddr));
+    savesym($op, "&op_list[$ix]");
+}
+
+sub B::FAKEOP::new {
+    my ($class, %objdata) = @_;
+    bless \%objdata, $class;
+}
+
+sub B::FAKEOP::save {
+    my ($op, $level) = @_;
+    $opsect->add(sprintf("%s, %s, NULL, %u, %u, %u, 0x%x, 0x%x",
+			 $op->next, $op->sibling, $op->targ,
+			 $op->type, $op_seq, $op->flags, $op->private));
+    my $ix = $opsect->index;
+    $init->add(sprintf("op_list[$ix].op_ppaddr = %s;", $op->ppaddr));
+    return "&op_list[$ix]";
+}
+
+sub B::FAKEOP::next { $_[0]->{"next"} || 0 }
+sub B::FAKEOP::type { $_[0]->{type} || 0}
+sub B::FAKEOP::sibling { $_[0]->{sibling} || 0 }
+sub B::FAKEOP::ppaddr { $_[0]->{ppaddr} || 0 }
+sub B::FAKEOP::targ { $_[0]->{targ} || 0 }
+sub B::FAKEOP::flags { $_[0]->{flags} || 0 }
+sub B::FAKEOP::private { $_[0]->{private} || 0 }
+
+sub B::UNOP::save {
+    my ($op, $level) = @_;
+    my $sym = objsym($op);
+    return $sym if defined $sym;
+    $unopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x",
+			   ${$op->next}, ${$op->sibling},
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private, ${$op->first}));
+    my $ix = $unopsect->index;
+    $init->add(sprintf("unop_list[$ix].op_ppaddr = %s;", $op->ppaddr));
+    savesym($op, "(OP*)&unop_list[$ix]");
+}
+
+sub B::BINOP::save {
+    my ($op, $level) = @_;
+    my $sym = objsym($op);
+    return $sym if defined $sym;
+    $binopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+			    ${$op->next}, ${$op->sibling},
+			    $op->targ, $op->type, $op_seq, $op->flags,
+			    $op->private, ${$op->first}, ${$op->last}));
+    my $ix = $binopsect->index;
+    $init->add(sprintf("binop_list[$ix].op_ppaddr = %s;", $op->ppaddr));
+    savesym($op, "(OP*)&binop_list[$ix]");
+}
+
+sub B::LISTOP::save {
+    my ($op, $level) = @_;
+    my $sym = objsym($op);
+    return $sym if defined $sym;
+    $listopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+			     ${$op->next}, ${$op->sibling},
+			     $op->targ, $op->type, $op_seq, $op->flags,
+			     $op->private, ${$op->first}, ${$op->last}));
+    my $ix = $listopsect->index;
+    $init->add(sprintf("listop_list[$ix].op_ppaddr = %s;", $op->ppaddr));
+    savesym($op, "(OP*)&listop_list[$ix]");
+}
+
+sub B::LOGOP::save {
+    my ($op, $level) = @_;
+    my $sym = objsym($op);
+    return $sym if defined $sym;
+    $logopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+			    ${$op->next}, ${$op->sibling},
+			    $op->targ, $op->type, $op_seq, $op->flags,
+			    $op->private, ${$op->first}, ${$op->other}));
+    my $ix = $logopsect->index;
+    $init->add(sprintf("logop_list[$ix].op_ppaddr = %s;", $op->ppaddr));
+    savesym($op, "(OP*)&logop_list[$ix]");
+}
+
+sub B::LOOP::save {
+    my ($op, $level) = @_;
+    my $sym = objsym($op);
+    return $sym if defined $sym;
+    #warn sprintf("LOOP: redoop %s, nextop %s, lastop %s\n",
+    #		 peekop($op->redoop), peekop($op->nextop),
+    #		 peekop($op->lastop)); # debug
+    $loopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x",
+			   ${$op->next}, ${$op->sibling},
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private, ${$op->first}, ${$op->last},
+			   ${$op->redoop}, ${$op->nextop},
+			   ${$op->lastop}));
+    my $ix = $loopsect->index;
+    $init->add(sprintf("loop_list[$ix].op_ppaddr = %s;", $op->ppaddr));
+    savesym($op, "(OP*)&loop_list[$ix]");
+}
+
+sub B::PVOP::save {
+    my ($op, $level) = @_;
+    my $sym = objsym($op);
+    return $sym if defined $sym;
+    $pvopsect->add(sprintf("s\\_%x, s\\_%x, NULL,  %u, %u, %u, 0x%x, 0x%x, %s",
+			   ${$op->next}, ${$op->sibling},
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private, cstring($op->pv)));
+    my $ix = $pvopsect->index;
+    $init->add(sprintf("pvop_list[$ix].op_ppaddr = %s;", $op->ppaddr));
+    savesym($op, "(OP*)&pvop_list[$ix]");
+}
+
+sub B::SVOP::save {
+    my ($op, $level) = @_;
+    my $sym = objsym($op);
+    return $sym if defined $sym;
+    my $svsym = $op->sv->save;
+    $svopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, Nullsv",
+			   ${$op->next}, ${$op->sibling},
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private));
+    my $ix = $svopsect->index;
+    $init->add(sprintf("svop_list[$ix].op_ppaddr = %s;", $op->ppaddr));
+    $init->add("svop_list[$ix].op_sv = (SV*)$svsym;");
+    savesym($op, "(OP*)&svop_list[$ix]");
+}
+
+sub B::PADOP::save {
+    my ($op, $level) = @_;
+    my $sym = objsym($op);
+    return $sym if defined $sym;
+    $padopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, 0",
+			   ${$op->next}, ${$op->sibling},
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private));
+    $init->add(sprintf("padop_list[%d].op_ppaddr = %s;", $padopsect->index, $op->ppaddr));
+    my $ix = $padopsect->index;
+    $init->add(sprintf("padop_list[$ix].op_padix = %ld;", $op->padix));
+    savesym($op, "(OP*)&padop_list[$ix]");
+}
+
+sub B::COP::save {
+    my ($op, $level) = @_;
+    my $sym = objsym($op);
+    return $sym if defined $sym;
+    warn sprintf("COP: line %d file %s\n", $op->line, $op->file)
+	if $debug_cops;
+    $copsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, %s, NULL, NULL, %u, %d, %u",
+			  ${$op->next}, ${$op->sibling},
+			  $op->targ, $op->type, $op_seq, $op->flags,
+			  $op->private, cstring($op->label), $op->cop_seq,
+			  $op->arybase, $op->line));
+    my $ix = $copsect->index;
+    $init->add(sprintf("cop_list[$ix].op_ppaddr = %s;", $op->ppaddr));
+    $init->add(sprintf("CopFILE_set(&cop_list[$ix], %s);", cstring($op->file)),
+	       sprintf("CopSTASHPV_set(&cop_list[$ix], %s);", cstring($op->stashpv)));
+    savesym($op, "(OP*)&cop_list[$ix]");
+}
+
+sub B::PMOP::save {
+    my ($op, $level) = @_;
+    my $sym = objsym($op);
+    return $sym if defined $sym;
+    my $replroot = $op->pmreplroot;
+    my $replstart = $op->pmreplstart;
+    my $replrootfield = sprintf("s\\_%x", $$replroot);
+    my $replstartfield = sprintf("s\\_%x", $$replstart);
+    my $gvsym;
+    my $ppaddr = $op->ppaddr;
+    if ($$replroot) {
+	# OP_PUSHRE (a mutated version of OP_MATCH for the regexp
+	# argument to a split) stores a GV in op_pmreplroot instead
+	# of a substitution syntax tree. We don't want to walk that...
+	if ($op->name eq "pushre") {
+	    $gvsym = $replroot->save;
+#	    warn "PMOP::save saving a pp_pushre with GV $gvsym\n"; # debug
+	    $replrootfield = 0;
+	} else {
+	    $replstartfield = saveoptree("*ignore*", $replroot, $replstart);
+	}
+    }
+    # pmnext handling is broken in perl itself, I think. Bad op_pmnext
+    # fields aren't noticed in perl's runtime (unless you try reset) but we
+    # segfault when trying to dereference it to find op->op_pmnext->op_type
+    $pmopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %s, %s, 0, 0, 0x%x, 0x%x",
+			   ${$op->next}, ${$op->sibling}, $op->targ,
+			   $op->type, $op_seq, $op->flags, $op->private,
+			   ${$op->first}, ${$op->last}, 
+			   $replrootfield, $replstartfield,
+			   $op->pmflags, $op->pmpermflags,));
+    my $pm = sprintf("pmop_list[%d]", $pmopsect->index);
+    $init->add(sprintf("$pm.op_ppaddr = %s;", $ppaddr));
+    my $re = $op->precomp;
+    if (defined($re)) {
+	my $resym = sprintf("re%d", $re_index++);
+	$decl->add(sprintf("static char *$resym = %s;", cstring($re)));
+	$init->add(sprintf("$pm.op_pmregexp = pregcomp($resym, $resym + %u, &$pm);",
+			   length($re)));
+    }
+    if ($gvsym) {
+	$init->add("$pm.op_pmreplroot = (OP*)$gvsym;");
+    }
+    savesym($op, "(OP*)&$pm");
+}
+
+sub B::SPECIAL::save {
+    my ($sv) = @_;
+    # special case: $$sv is not the address but an index into specialsv_list
+#   warn "SPECIAL::save specialsv $$sv\n"; # debug
+    my $sym = $specialsv_name[$$sv];
+    if (!defined($sym)) {
+	confess "unknown specialsv index $$sv passed to B::SPECIAL::save";
+    }
+    return $sym;
+}
+
+sub B::OBJECT::save {}
+
+sub B::NULL::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+#   warn "Saving SVt_NULL SV\n"; # debug
+    # debug
+    if ($$sv == 0) {
+    	warn "NULL::save for sv = 0 called from @{[(caller(1))[3]]}\n";
+	return savesym($sv, "Nullsv /* XXX */");
+    }
+    $svsect->add(sprintf("0, %u, 0x%x", $sv->REFCNT , $sv->FLAGS));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::IV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    $xpvivsect->add(sprintf("0, 0, 0, %d", $sv->IVX));
+    $svsect->add(sprintf("&xpviv_list[%d], %lu, 0x%x",
+			 $xpvivsect->index, $sv->REFCNT , $sv->FLAGS));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::NV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $val= $sv->NVX;
+    $val .= '.00' if $val =~ /^-?\d+$/;
+    $xpvnvsect->add(sprintf("0, 0, 0, %d, %s", $sv->IVX, $val));
+    $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
+			 $xpvnvsect->index, $sv->REFCNT , $sv->FLAGS));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub savepvn {
+    my ($dest,$pv) = @_;
+    my @res;
+    if (defined $max_string_len && length($pv) > $max_string_len) {
+	push @res, sprintf("New(0,%s,%u,char);", $dest, length($pv)+1);
+	my $offset = 0;
+	while (length $pv) {
+	    my $str = substr $pv, 0, $max_string_len, '';
+	    push @res, sprintf("Copy(%s,$dest+$offset,%u,char);",
+			       cstring($str), length($str));
+	    $offset += length $str;
+	}
+	push @res, sprintf("%s[%u] = '\\0';", $dest, $offset);
+    }
+    else {
+	push @res, sprintf("%s = savepvn(%s, %u);", $dest,
+			   cstring($pv), length($pv));
+    }
+    return @res;
+}
+
+sub B::PVLV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    my ($lvtarg, $lvtarg_sym);
+    $xpvlvsect->add(sprintf("%s, %u, %u, %d, %g, 0, 0, %u, %u, 0, %s",
+			    $pvsym, $len, $pvmax, $sv->IVX, $sv->NVX, 
+			    $sv->TARGOFF, $sv->TARGLEN, cchar($sv->TYPE)));
+    $svsect->add(sprintf("&xpvlv_list[%d], %lu, 0x%x",
+			 $xpvlvsect->index, $sv->REFCNT , $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(savepvn(sprintf("xpvlv_list[%d].xpv_pv",
+				   $xpvlvsect->index), $pv));
+    }
+    $sv->save_magic;
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PVIV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    $xpvivsect->add(sprintf("%s, %u, %u, %d", $pvsym, $len, $pvmax, $sv->IVX));
+    $svsect->add(sprintf("&xpviv_list[%d], %u, 0x%x",
+			 $xpvivsect->index, $sv->REFCNT , $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(savepvn(sprintf("xpviv_list[%d].xpv_pv",
+				   $xpvivsect->index), $pv));
+    }
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PVNV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;     
+    $pv = '' unless defined $pv;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    my $val= $sv->NVX;
+    $val .= '.00' if $val =~ /^-?\d+$/;
+    $xpvnvsect->add(sprintf("%s, %u, %u, %d, %s",
+			    $pvsym, $len, $pvmax, $sv->IVX, $val));
+    $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
+			 $xpvnvsect->index, $sv->REFCNT , $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(savepvn(sprintf("xpvnv_list[%d].xpv_pv",
+				   $xpvnvsect->index), $pv));
+    }
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::BM::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV . "\0" . $sv->TABLE;
+    my $len = length($pv);
+    $xpvbmsect->add(sprintf("0, %u, %u, %d, %s, 0, 0, %d, %u, 0x%x",
+			    $len, $len + 258, $sv->IVX, $sv->NVX,
+			    $sv->USEFUL, $sv->PREVIOUS, $sv->RARE));
+    $svsect->add(sprintf("&xpvbm_list[%d], %lu, 0x%x",
+			 $xpvbmsect->index, $sv->REFCNT , $sv->FLAGS));
+    $sv->save_magic;
+    $init->add(savepvn(sprintf("xpvbm_list[%d].xpv_pv",
+			       $xpvbmsect->index), $pv),
+	       sprintf("xpvbm_list[%d].xpv_cur = %u;",
+		       $xpvbmsect->index, $len - 257));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    $xpvsect->add(sprintf("%s, %u, %u", $pvsym, $len, $pvmax));
+    $svsect->add(sprintf("&xpv_list[%d], %lu, 0x%x",
+			 $xpvsect->index, $sv->REFCNT , $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(savepvn(sprintf("xpv_list[%d].xpv_pv",
+				   $xpvsect->index), $pv));
+    }
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PVMG::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    $xpvmgsect->add(sprintf("%s, %u, %u, %d, %s, 0, 0",
+			    $pvsym, $len, $pvmax, $sv->IVX, $sv->NVX));
+    $svsect->add(sprintf("&xpvmg_list[%d], %lu, 0x%x",
+			 $xpvmgsect->index, $sv->REFCNT , $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(savepvn(sprintf("xpvmg_list[%d].xpv_pv",
+				   $xpvmgsect->index), $pv));
+    }
+    $sym = savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+    $sv->save_magic;
+    return $sym;
+}
+
+sub B::PVMG::save_magic {
+    my ($sv) = @_;
+    #warn sprintf("saving magic for %s (0x%x)\n", class($sv), $$sv); # debug
+    my $stash = $sv->SvSTASH;
+    $stash->save;
+    if ($$stash) {
+	warn sprintf("xmg_stash = %s (0x%x)\n", $stash->NAME, $$stash)
+	    if $debug_mg;
+	# XXX Hope stash is already going to be saved.
+	$init->add(sprintf("SvSTASH(s\\_%x) = s\\_%x;", $$sv, $$stash));
+    }
+    my @mgchain = $sv->MAGIC;
+    my ($mg, $type, $obj, $ptr,$len,$ptrsv);
+    foreach $mg (@mgchain) {
+	$type = $mg->TYPE;
+	$obj = $mg->OBJ;
+	$ptr = $mg->PTR;
+	$len=$mg->LENGTH;
+	if ($debug_mg) {
+	    warn sprintf("magic %s (0x%x), obj %s (0x%x), type %s, ptr %s\n",
+			 class($sv), $$sv, class($obj), $$obj,
+			 cchar($type), cstring($ptr));
+	}
+	$obj->save;
+	if ($len == HEf_SVKEY){
+		#The pointer is an SV*
+		$ptrsv=svref_2object($ptr)->save;
+		$init->add(sprintf("sv_magic((SV*)s\\_%x, (SV*)s\\_%x, %s,(char *) %s, %d);",
+			   $$sv, $$obj, cchar($type),$ptrsv,$len));
+	}else{
+		$init->add(sprintf("sv_magic((SV*)s\\_%x, (SV*)s\\_%x, %s, %s, %d);",
+			   $$sv, $$obj, cchar($type),cstring($ptr),$len));
+	}
+    }
+}
+
+sub B::RV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $rv = $sv->RV->save;
+    $rv =~ s/^\([AGHS]V\s*\*\)\s*(\&sv_list.*)$/$1/;
+    $xrvsect->add($rv);
+    $svsect->add(sprintf("&xrv_list[%d], %lu, 0x%x",
+			 $xrvsect->index, $sv->REFCNT , $sv->FLAGS));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub try_autoload {
+    my ($cvstashname, $cvname) = @_;
+    warn sprintf("No definition for sub %s::%s\n", $cvstashname, $cvname);
+    # Handle AutoLoader classes explicitly. Any more general AUTOLOAD
+    # use should be handled by the class itself.
+    no strict 'refs';
+    my $isa = \@{"$cvstashname\::ISA"};
+    if (grep($_ eq "AutoLoader", @$isa)) {
+	warn "Forcing immediate load of sub derived from AutoLoader\n";
+	# Tweaked version of AutoLoader::AUTOLOAD
+	my $dir = $cvstashname;
+	$dir =~ s(::)(/)g;
+	eval { require "auto/$dir/$cvname.al" };
+	if ($@) {
+	    warn qq(failed require "auto/$dir/$cvname.al": $@\n);
+	    return 0;
+	} else {
+	    return 1;
+	}
+    }
+}
+sub Dummy_initxs{};
+sub B::CV::save {
+    my ($cv) = @_;
+    my $sym = objsym($cv);
+    if (defined($sym)) {
+#	warn sprintf("CV 0x%x already saved as $sym\n", $$cv); # debug
+	return $sym;
+    }
+    # Reserve a place in svsect and xpvcvsect and record indices
+    my $gv = $cv->GV;
+    my ($cvname, $cvstashname);
+    if ($$gv){
+    	$cvname = $gv->NAME;
+    	$cvstashname = $gv->STASH->NAME;
+    }
+    my $root = $cv->ROOT;
+    my $cvxsub = $cv->XSUB;
+    #INIT is removed from the symbol table, so this call must come
+    # from PL_initav->save. Re-bootstrapping  will push INIT back in
+    # so nullop should be sent.
+    if ($cvxsub && ($cvname ne "INIT")) {
+	my $egv = $gv->EGV;
+	my $stashname = $egv->STASH->NAME;
+         if ($cvname eq "bootstrap")
+          {                                   
+           my $file = $gv->FILE;    
+           $decl->add("/* bootstrap $file */"); 
+           warn "Bootstrap $stashname $file\n";
+           $xsub{$stashname}='Dynamic'; 
+	   # $xsub{$stashname}='Static' unless  $xsub{$stashname};
+           return qq/NULL/;
+          }                                   
+        warn sprintf("stub for XSUB $cvstashname\:\:$cvname CV 0x%x\n", $$cv) if $debug_cv;
+	return qq/(perl_get_cv("$stashname\:\:$cvname",TRUE))/;
+    }
+    if ($cvxsub && $cvname eq "INIT") {
+	 no strict 'refs';
+   	 return svref_2object(\&Dummy_initxs)->save;
+    }
+    my $sv_ix = $svsect->index + 1;
+    $svsect->add("svix$sv_ix");
+    my $xpvcv_ix = $xpvcvsect->index + 1;
+    $xpvcvsect->add("xpvcvix$xpvcv_ix");
+    # Save symbol now so that GvCV() doesn't recurse back to us via CvGV()
+    $sym = savesym($cv, "&sv_list[$sv_ix]");
+    warn sprintf("saving $cvstashname\:\:$cvname CV 0x%x as $sym\n", $$cv) if $debug_cv;
+    if (!$$root && !$cvxsub) {
+	if (try_autoload($cvstashname, $cvname)) {
+	    # Recalculate root and xsub
+	    $root = $cv->ROOT;
+	    $cvxsub = $cv->XSUB;
+	    if ($$root || $cvxsub) {
+		warn "Successful forced autoload\n";
+	    }
+	}
+    }
+    my $startfield = 0;
+    my $padlist = $cv->PADLIST;
+    my $pv = $cv->PV;
+    my $xsub = 0;
+    my $xsubany = "Nullany";
+    if ($$root) {
+	warn sprintf("saving op tree for CV 0x%x, root = 0x%x\n",
+		     $$cv, $$root) if $debug_cv;
+	my $ppname = "";
+	if ($$gv) {
+	    my $stashname = $gv->STASH->NAME;
+	    my $gvname = $gv->NAME;
+	    if ($gvname ne "__ANON__") {
+		$ppname = (${$gv->FORM} == $$cv) ? "pp_form_" : "pp_sub_";
+		$ppname .= ($stashname eq "main") ?
+			    $gvname : "$stashname\::$gvname";
+		$ppname =~ s/::/__/g;
+	        if ($gvname eq "INIT"){
+		       $ppname .= "_$initsub_index";
+		       $initsub_index++;
+		    }
+	    }
+	}
+	if (!$ppname) {
+	    $ppname = "pp_anonsub_$anonsub_index";
+	    $anonsub_index++;
+	}
+	$startfield = saveoptree($ppname, $root, $cv->START, $padlist->ARRAY);
+	warn sprintf("done saving op tree for CV 0x%x, name %s, root 0x%x\n",
+		     $$cv, $ppname, $$root) if $debug_cv;
+	if ($$padlist) {
+	    warn sprintf("saving PADLIST 0x%x for CV 0x%x\n",
+			 $$padlist, $$cv) if $debug_cv;
+	    $padlist->save;
+	    warn sprintf("done saving PADLIST 0x%x for CV 0x%x\n",
+			 $$padlist, $$cv) if $debug_cv;
+	}
+    }
+    else {
+	warn sprintf("No definition for sub %s::%s (unable to autoload)\n",
+		     $cvstashname, $cvname); # debug
+    }              
+    $pv = '' unless defined $pv; # Avoid use of undef warnings
+    $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, \"\", %d, s\\_%x, (CV*)s\\_%x, 0x%x",
+			  $xpvcv_ix, cstring($pv), length($pv), $cv->IVX,
+			  $cv->NVX, $startfield, ${$cv->ROOT}, $cv->DEPTH,
+                        $$padlist, ${$cv->OUTSIDE}, $cv->CvFLAGS));
+
+    if (${$cv->OUTSIDE} == ${main_cv()}){
+	$init->add(sprintf("CvOUTSIDE(s\\_%x)=PL_main_cv;",$$cv));
+	$init->add(sprintf("SvREFCNT_inc(PL_main_cv);"));
+    }
+
+    if ($$gv) {
+	$gv->save;
+	$init->add(sprintf("CvGV(s\\_%x) = s\\_%x;",$$cv,$$gv));
+	warn sprintf("done saving GV 0x%x for CV 0x%x\n",
+		     $$gv, $$cv) if $debug_cv;
+    }
+    $init->add(sprintf("CvFILE($sym) = %s;", cstring($cv->FILE)));
+    my $stash = $cv->STASH;
+    if ($$stash) {
+	$stash->save;
+	$init->add(sprintf("CvSTASH(s\\_%x) = s\\_%x;", $$cv, $$stash));
+	warn sprintf("done saving STASH 0x%x for CV 0x%x\n",
+		     $$stash, $$cv) if $debug_cv;
+    }
+    $symsect->add(sprintf("svix%d\t(XPVCV*)&xpvcv_list[%u], %lu, 0x%x",
+			  $sv_ix, $xpvcv_ix, $cv->REFCNT +1 , $cv->FLAGS));
+    return $sym;
+}
+
+sub B::GV::save {
+    my ($gv) = @_;
+    my $sym = objsym($gv);
+    if (defined($sym)) {
+	#warn sprintf("GV 0x%x already saved as $sym\n", $$gv); # debug
+	return $sym;
+    } else {
+	my $ix = $gv_index++;
+	$sym = savesym($gv, "gv_list[$ix]");
+	#warn sprintf("Saving GV 0x%x as $sym\n", $$gv); # debug
+    }
+    my $is_empty = $gv->is_empty;
+    my $gvname = $gv->NAME;
+    my $name = cstring($gv->STASH->NAME . "::" . $gvname);
+    #warn "GV name is $name\n"; # debug
+    my $egvsym;
+    unless ($is_empty) {
+	my $egv = $gv->EGV;
+	if ($$gv != $$egv) {
+	    #warn(sprintf("EGV name is %s, saving it now\n",
+	    #	     $egv->STASH->NAME . "::" . $egv->NAME)); # debug
+	    $egvsym = $egv->save;
+	}
+    }
+    $init->add(qq[$sym = gv_fetchpv($name, TRUE, SVt_PV);],
+	       sprintf("SvFLAGS($sym) = 0x%x;", $gv->FLAGS),
+	       sprintf("GvFLAGS($sym) = 0x%x;", $gv->GvFLAGS));
+    $init->add(sprintf("GvLINE($sym) = %u;", $gv->LINE)) unless $is_empty;
+
+    # Shouldn't need to do save_magic since gv_fetchpv handles that
+    #$gv->save_magic;
+    my $refcnt = $gv->REFCNT + 1;
+    $init->add(sprintf("SvREFCNT($sym) += %u;", $refcnt - 1)) if $refcnt > 1;
+
+    return $sym if $is_empty;
+
+    my $gvrefcnt = $gv->GvREFCNT;
+    if ($gvrefcnt > 1) {
+	$init->add(sprintf("GvREFCNT($sym) += %u;", $gvrefcnt - 1));
+    }
+    if (defined($egvsym)) {
+	# Shared glob *foo = *bar
+	$init->add("gp_free($sym);",
+		   "GvGP($sym) = GvGP($egvsym);");
+    } elsif ($gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/) {
+	# Don't save subfields of special GVs (*_, *1, *# and so on)
+#	warn "GV::save saving subfields\n"; # debug
+	my $gvsv = $gv->SV;
+	if ($$gvsv) {
+	    $gvsv->save;
+	    $init->add(sprintf("GvSV($sym) = s\\_%x;", $$gvsv));
+#	    warn "GV::save \$$name\n"; # debug
+	}
+	my $gvav = $gv->AV;
+	if ($$gvav) {
+	    $gvav->save;
+	    $init->add(sprintf("GvAV($sym) = s\\_%x;", $$gvav));
+#	    warn "GV::save \@$name\n"; # debug
+	}
+	my $gvhv = $gv->HV;
+	if ($$gvhv) {
+	    $gvhv->save;
+	    $init->add(sprintf("GvHV($sym) = s\\_%x;", $$gvhv));
+#	    warn "GV::save \%$name\n"; # debug
+	}
+	my $gvcv = $gv->CV;
+	if ($$gvcv) { 
+	    my $origname=cstring($gvcv->GV->EGV->STASH->NAME .
+		 "::" . $gvcv->GV->EGV->NAME);  
+	    if (0 && $gvcv->XSUB && $name ne $origname) { #XSUB alias
+	        # must save as a 'stub' so newXS() has a CV to populate
+                $init->add("{ CV *cv;");
+                $init->add("\tcv=perl_get_cv($origname,TRUE);");
+                $init->add("\tGvCV($sym)=cv;");
+                $init->add("\tSvREFCNT_inc((SV *)cv);");
+                $init->add("}");    
+	    } else {     
+               $init->add(sprintf("GvCV($sym) = (CV*)(%s);", $gvcv->save));
+#              warn "GV::save &$name\n"; # debug
+	    } 
+        }     
+	$init->add(sprintf("GvFILE($sym) = %s;", cstring($gv->FILE)));
+#	warn "GV::save GvFILE(*$name)\n"; # debug
+	my $gvform = $gv->FORM;
+	if ($$gvform) {
+	    $gvform->save;
+	    $init->add(sprintf("GvFORM($sym) = (CV*)s\\_%x;", $$gvform));
+#	    warn "GV::save GvFORM(*$name)\n"; # debug
+	}
+	my $gvio = $gv->IO;
+	if ($$gvio) {
+	    $gvio->save;
+	    $init->add(sprintf("GvIOp($sym) = s\\_%x;", $$gvio));
+#	    warn "GV::save GvIO(*$name)\n"; # debug
+	}
+    }
+    return $sym;
+}
+sub B::AV::save {
+    my ($av) = @_;
+    my $sym = objsym($av);
+    return $sym if defined $sym;
+    my $avflags = $av->AvFLAGS;
+    $xpvavsect->add(sprintf("0, -1, -1, 0, 0.0, 0, Nullhv, 0, 0, 0x%x",
+			    $avflags));
+    $svsect->add(sprintf("&xpvav_list[%d], %lu, 0x%x",
+			 $xpvavsect->index, $av->REFCNT  , $av->FLAGS));
+    my $sv_list_index = $svsect->index;
+    my $fill = $av->FILL;
+    $av->save_magic;
+    warn sprintf("saving AV 0x%x FILL=$fill AvFLAGS=0x%x", $$av, $avflags)
+	if $debug_av;
+    # XXX AVf_REAL is wrong test: need to save comppadlist but not stack
+    #if ($fill > -1 && ($avflags & AVf_REAL)) {
+    if ($fill > -1) {
+	my @array = $av->ARRAY;
+	if ($debug_av) {
+	    my $el;
+	    my $i = 0;
+	    foreach $el (@array) {
+		warn sprintf("AV 0x%x[%d] = %s 0x%x\n",
+			     $$av, $i++, class($el), $$el);
+	    }
+	}
+	my @names = map($_->save, @array);
+	# XXX Better ways to write loop?
+	# Perhaps svp[0] = ...; svp[1] = ...; svp[2] = ...;
+	# Perhaps I32 i = 0; svp[i++] = ...; svp[i++] = ...; svp[i++] = ...;
+	$init->add("{",
+		   "\tSV **svp;",
+		   "\tAV *av = (AV*)&sv_list[$sv_list_index];",
+		   "\tav_extend(av, $fill);",
+		   "\tsvp = AvARRAY(av);",
+	       map("\t*svp++ = (SV*)$_;", @names),
+		   "\tAvFILLp(av) = $fill;",
+		   "}");
+    } else {
+	my $max = $av->MAX;
+	$init->add("av_extend((AV*)&sv_list[$sv_list_index], $max);")
+	    if $max > -1;
+    }
+    return savesym($av, "(AV*)&sv_list[$sv_list_index]");
+}
+
+sub B::HV::save {
+    my ($hv) = @_;
+    my $sym = objsym($hv);
+    return $sym if defined $sym;
+    my $name = $hv->NAME;
+    if ($name) {
+	# It's a stash
+
+	# A perl bug means HvPMROOT isn't altered when a PMOP is freed. Usually
+	# the only symptom is that sv_reset tries to reset the PMf_USED flag of
+	# a trashed op but we look at the trashed op_type and segfault.
+	#my $adpmroot = ${$hv->PMROOT};
+	my $adpmroot = 0;
+	$decl->add("static HV *hv$hv_index;");
+	# XXX Beware of weird package names containing double-quotes, \n, ...?
+	$init->add(qq[hv$hv_index = gv_stashpv("$name", TRUE);]);
+	if ($adpmroot) {
+	    $init->add(sprintf("HvPMROOT(hv$hv_index) = (PMOP*)s\\_%x;",
+			       $adpmroot));
+	}
+	$sym = savesym($hv, "hv$hv_index");
+	$hv_index++;
+	return $sym;
+    }
+    # It's just an ordinary HV
+    $xpvhvsect->add(sprintf("0, 0, %d, 0, 0.0, 0, Nullhv, %d, 0, 0, 0",
+			    $hv->MAX, $hv->RITER));
+    $svsect->add(sprintf("&xpvhv_list[%d], %lu, 0x%x",
+			 $xpvhvsect->index, $hv->REFCNT  , $hv->FLAGS));
+    my $sv_list_index = $svsect->index;
+    my @contents = $hv->ARRAY;
+    if (@contents) {
+	my $i;
+	for ($i = 1; $i < @contents; $i += 2) {
+	    $contents[$i] = $contents[$i]->save;
+	}
+	$init->add("{", "\tHV *hv = (HV*)&sv_list[$sv_list_index];");
+	while (@contents) {
+	    my ($key, $value) = splice(@contents, 0, 2);
+	    $init->add(sprintf("\thv_store(hv, %s, %u, %s, %s);",
+			       cstring($key),length($key),$value, hash($key)));
+#	    $init->add(sprintf("\thv_store(hv, %s, %u, %s, %s);",
+#			       cstring($key),length($key),$value, 0));
+	}
+	$init->add("}");
+    }
+    $hv->save_magic();
+    return savesym($hv, "(HV*)&sv_list[$sv_list_index]");
+}
+
+sub B::IO::save {
+    my ($io) = @_;
+    my $sym = objsym($io);
+    return $sym if defined $sym;
+    my $pv = $io->PV;
+    $pv = '' unless defined $pv;
+    my $len = length($pv);
+    $xpviosect->add(sprintf("0, %u, %u, %d, %s, 0, 0, 0, 0, 0, %d, %d, %d, %d, %s, Nullgv, %s, Nullgv, %s, Nullgv, %d, %s, 0x%x",
+			    $len, $len+1, $io->IVX, $io->NVX, $io->LINES,
+			    $io->PAGE, $io->PAGE_LEN, $io->LINES_LEFT,
+			    cstring($io->TOP_NAME), cstring($io->FMT_NAME), 
+			    cstring($io->BOTTOM_NAME), $io->SUBPROCESS,
+			    cchar($io->IoTYPE), $io->IoFLAGS));
+    $svsect->add(sprintf("&xpvio_list[%d], %lu, 0x%x",
+			 $xpviosect->index, $io->REFCNT , $io->FLAGS));
+    $sym = savesym($io, sprintf("(IO*)&sv_list[%d]", $svsect->index));
+    my ($field, $fsym);
+    foreach $field (qw(TOP_GV FMT_GV BOTTOM_GV)) {
+      	$fsym = $io->$field();
+	if ($$fsym) {
+	    $init->add(sprintf("Io$field($sym) = (GV*)s\\_%x;", $$fsym));
+	    $fsym->save;
+	}
+    }
+    $io->save_magic;
+    return $sym;
+}
+
+sub B::SV::save {
+    my $sv = shift;
+    # This is where we catch an honest-to-goodness Nullsv (which gets
+    # blessed into B::SV explicitly) and any stray erroneous SVs.
+    return 0 unless $$sv;
+    confess sprintf("cannot save that type of SV: %s (0x%x)\n",
+		    class($sv), $$sv);
+}
+
+sub output_all {
+    my $init_name = shift;
+    my $section;
+    my @sections = ($opsect, $unopsect, $binopsect, $logopsect, $condopsect,
+		    $listopsect, $pmopsect, $svopsect, $padopsect, $pvopsect,
+		    $loopsect, $copsect, $svsect, $xpvsect,
+		    $xpvavsect, $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect,
+		    $xpvmgsect, $xpvlvsect, $xrvsect, $xpvbmsect, $xpviosect);
+    $symsect->output(\*STDOUT, "#define %s\n");
+    print "\n";
+    output_declarations();
+    foreach $section (@sections) {
+	my $lines = $section->index + 1;
+	if ($lines) {
+	    my $name = $section->name;
+	    my $typename = ($name eq "xpvcv") ? "XPVCV_or_similar" : uc($name);
+	    print "Static $typename ${name}_list[$lines];\n";
+	}
+    }
+    $decl->output(\*STDOUT, "%s\n");
+    print "\n";
+    foreach $section (@sections) {
+	my $lines = $section->index + 1;
+	if ($lines) {
+	    my $name = $section->name;
+	    my $typename = ($name eq "xpvcv") ? "XPVCV_or_similar" : uc($name);
+	    printf "static %s %s_list[%u] = {\n", $typename, $name, $lines;
+	    $section->output(\*STDOUT, "\t{ %s },\n");
+	    print "};\n\n";
+	}
+    }
+
+    print <<"EOT";
+static int $init_name()
+{
+	dTARG;
+	dSP;
+EOT
+    $init->output(\*STDOUT, "\t%s\n");
+    print "\treturn 0;\n}\n";
+    if ($verbose) {
+	warn compile_stats();
+	warn "NULLOP count: $nullop_count\n";
+    }
+}
+
+sub output_declarations {
+    print <<'EOT';
+#ifdef BROKEN_STATIC_REDECL
+#define Static extern
+#else
+#define Static static
+#endif /* BROKEN_STATIC_REDECL */
+
+#ifdef BROKEN_UNION_INIT
+/*
+ * Cribbed from cv.h with ANY (a union) replaced by void*.
+ * Some pre-Standard compilers can't cope with initialising unions. Ho hum.
+ */
+typedef struct {
+    char *	xpv_pv;		/* pointer to malloced string */
+    STRLEN	xpv_cur;	/* length of xp_pv as a C string */
+    STRLEN	xpv_len;	/* allocated size */
+    IV		xof_off;	/* integer value */
+    NV		xnv_nv;		/* numeric value, if any */
+    MAGIC*	xmg_magic;	/* magic for scalar array */
+    HV*		xmg_stash;	/* class package */
+
+    HV *	xcv_stash;
+    OP *	xcv_start;
+    OP *	xcv_root;
+    void      (*xcv_xsub) (pTHXo_ CV*);
+    ANY		xcv_xsubany;
+    GV *	xcv_gv;
+    char *	xcv_file;
+    long	xcv_depth;	/* >= 2 indicates recursive call */
+    AV *	xcv_padlist;
+    CV *	xcv_outside;
+#ifdef USE_THREADS
+    perl_mutex *xcv_mutexp;
+    struct perl_thread *xcv_owner;	/* current owner thread */
+#endif /* USE_THREADS */
+    cv_flags_t	xcv_flags;
+} XPVCV_or_similar;
+#define ANYINIT(i) i
+#else
+#define XPVCV_or_similar XPVCV
+#define ANYINIT(i) {i}
+#endif /* BROKEN_UNION_INIT */
+#define Nullany ANYINIT(0)
+
+#define UNUSED 0
+#define sym_0 0
+
+EOT
+    print "static GV *gv_list[$gv_index];\n" if $gv_index;
+    print "\n";
+}
+
+
+sub output_boilerplate {
+    print <<'EOT';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/* Workaround for mapstart: the only op which needs a different ppaddr */
+#undef Perl_pp_mapstart
+#define Perl_pp_mapstart Perl_pp_grepstart
+#define XS_DynaLoader_boot_DynaLoader boot_DynaLoader
+EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
+
+static void xs_init (pTHX);
+static void dl_init (pTHX);
+static PerlInterpreter *my_perl;
+EOT
+}
+
+sub output_main {
+    print <<'EOT';
+int
+main(int argc, char **argv, char **env)
+{
+    int exitstatus;
+    int i;
+    char **fakeargv;
+
+    PERL_SYS_INIT3(&argc,&argv,&env);
+ 
+    if (!PL_do_undump) {
+	my_perl = perl_alloc();
+	if (!my_perl)
+	    exit(1);
+	perl_construct( my_perl );
+	PL_perl_destruct_level = 0;
+    }
+
+#ifdef CSH
+    if (!PL_cshlen) 
+      PL_cshlen = strlen(PL_cshname);
+#endif
+
+#ifdef ALLOW_PERL_OPTIONS
+#define EXTRA_OPTIONS 2
+#else
+#define EXTRA_OPTIONS 3
+#endif /* ALLOW_PERL_OPTIONS */
+    New(666, fakeargv, argc + EXTRA_OPTIONS + 1, char *);
+    fakeargv[0] = argv[0];
+    fakeargv[1] = "-e";
+    fakeargv[2] = "";
+#ifndef ALLOW_PERL_OPTIONS
+    fakeargv[3] = "--";
+#endif /* ALLOW_PERL_OPTIONS */
+    for (i = 1; i < argc; i++)
+	fakeargv[i + EXTRA_OPTIONS] = argv[i];
+    fakeargv[argc + EXTRA_OPTIONS] = 0;
+    
+    exitstatus = perl_parse(my_perl, xs_init, argc + EXTRA_OPTIONS,
+			    fakeargv, NULL);
+    if (exitstatus)
+	exit( exitstatus );
+
+    sv_setpv(GvSV(gv_fetchpv("0", TRUE, SVt_PV)), argv[0]);
+    PL_main_cv = PL_compcv;
+    PL_compcv = 0;
+
+    exitstatus = perl_init();
+    if (exitstatus)
+	exit( exitstatus );
+    dl_init(aTHX);
+
+    exitstatus = perl_run( my_perl );
+
+    perl_destruct( my_perl );
+    perl_free( my_perl );
+
+    PERL_SYS_TERM();
+
+    exit( exitstatus );
+}
+
+/* yanked from perl.c */
+static void
+xs_init(pTHX)
+{
+    char *file = __FILE__;
+    dTARG;
+    dSP;
+EOT
+    print "\n#ifdef USE_DYNAMIC_LOADING";
+    print qq/\n\tnewXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);/;
+    print "\n#endif\n" ;
+    # delete $xsub{'DynaLoader'}; 
+    delete $xsub{'UNIVERSAL'}; 
+    print("/* bootstrapping code*/\n\tSAVETMPS;\n");
+    print("\ttarg=sv_newmortal();\n");
+    print "#ifdef DYNALOADER_BOOTSTRAP\n";
+    print "\tPUSHMARK(sp);\n";
+    print qq/\tXPUSHp("DynaLoader",strlen("DynaLoader"));\n/;
+    print qq/\tPUTBACK;\n/;
+    print "\tboot_DynaLoader(aTHX_ NULL);\n";
+    print qq/\tSPAGAIN;\n/;
+    print "#endif\n";
+    foreach my $stashname (keys %xsub){
+	if ($xsub{$stashname} ne 'Dynamic') {
+	   my $stashxsub=$stashname;
+	   $stashxsub  =~ s/::/__/g; 
+	   print "\tPUSHMARK(sp);\n";
+	   print qq/\tXPUSHp("$stashname",strlen("$stashname"));\n/;
+	   print qq/\tPUTBACK;\n/;
+	   print "\tboot_$stashxsub(aTHX_ NULL);\n";
+	   print qq/\tSPAGAIN;\n/;
+	}   
+    }
+    print("\tFREETMPS;\n/* end bootstrapping code */\n");
+    print "}\n";
+    
+print <<'EOT';
+static void
+dl_init(pTHX)
+{
+    char *file = __FILE__;
+    dTARG;
+    dSP;
+EOT
+    print("/* Dynamicboot strapping code*/\n\tSAVETMPS;\n");
+    print("\ttarg=sv_newmortal();\n");
+    foreach my $stashname (@DynaLoader::dl_modules) {
+	warn "Loaded $stashname\n";
+	if (exists($xsub{$stashname}) && $xsub{$stashname} eq 'Dynamic') {
+  	   my $stashxsub=$stashname;
+	   $stashxsub  =~ s/::/__/g; 
+   	   print "\tPUSHMARK(sp);\n";
+   	   print qq/\tXPUSHp("$stashname",/,length($stashname),qq/);\n/;
+	   print qq/\tPUTBACK;\n/;
+           print "#ifdef DYNALOADER_BOOTSTRAP\n";
+	   warn "bootstrapping $stashname added to xs_init\n";
+	   print qq/\tperl_call_method("bootstrap",G_DISCARD);\n/;
+           print "\n#else\n";
+	   print "\tboot_$stashxsub(aTHX_ NULL);\n";
+           print "#endif\n";
+	   print qq/\tSPAGAIN;\n/;
+	}   
+    }
+    print("\tFREETMPS;\n/* end Dynamic bootstrapping code */\n");
+    print "}\n";
+}
+sub dump_symtable {
+    # For debugging
+    my ($sym, $val);
+    warn "----Symbol table:\n";
+    while (($sym, $val) = each %symtable) {
+	warn "$sym => $val\n";
+    }
+    warn "---End of symbol table\n";
+}
+
+sub save_object {
+    my $sv;
+    foreach $sv (@_) {
+	svref_2object($sv)->save;
+    }
+}       
+
+sub Dummy_BootStrap { }            
+
+sub B::GV::savecv 
+{
+ my $gv = shift;
+ my $package=$gv->STASH->NAME;
+ my $name = $gv->NAME;
+ my $cv = $gv->CV;
+ my $sv = $gv->SV;
+ my $av = $gv->AV;
+ my $hv = $gv->HV;
+
+ # We may be looking at this package just because it is a branch in the 
+ # symbol table which is on the path to a package which we need to save
+ # e.g. this is 'Getopt' and we need to save 'Getopt::Long'
+ # 
+ return unless ($unused_sub_packages{$package});
+ return unless ($$cv || $$av || $$sv || $$hv);
+ $gv->save;
+}
+
+sub mark_package
+{    
+ my $package = shift;
+ unless ($unused_sub_packages{$package})
+  {    
+   no strict 'refs';
+   $unused_sub_packages{$package} = 1;
+   if (defined @{$package.'::ISA'})
+    {
+     foreach my $isa (@{$package.'::ISA'}) 
+      {
+       if ($isa eq 'DynaLoader')
+        {
+         unless (defined(&{$package.'::bootstrap'}))
+          {                    
+           warn "Forcing bootstrap of $package\n";
+           eval { $package->bootstrap }; 
+          }
+        }
+#      else
+        {
+         unless ($unused_sub_packages{$isa})
+          {
+           warn "$isa saved (it is in $package\'s \@ISA)\n";
+           mark_package($isa);
+          }
+        }
+      }
+    }
+  }
+ return 1;
+}
+     
+sub should_save
+{
+ no strict qw(vars refs);
+ my $package = shift;
+ $package =~ s/::$//;
+ return $unused_sub_packages{$package} = 0 if ($package =~ /::::/);  # skip ::::ISA::CACHE etc.
+ # warn "Considering $package\n";#debug
+ foreach my $u (grep($unused_sub_packages{$_},keys %unused_sub_packages)) 
+  {  
+   # If this package is a prefix to something we are saving, traverse it 
+   # but do not mark it for saving if it is not already
+   # e.g. to get to Getopt::Long we need to traverse Getopt but need
+   # not save Getopt
+   return 1 if ($u =~ /^$package\:\:/);
+  }
+ if (exists $unused_sub_packages{$package})
+  {
+   # warn "Cached $package is ".$unused_sub_packages{$package}."\n"; 
+   delete_unsaved_hashINC($package) unless  $unused_sub_packages{$package} ;
+   return $unused_sub_packages{$package}; 
+  }
+ # Omit the packages which we use (and which cause grief
+ # because of fancy "goto &$AUTOLOAD" stuff).
+ # XXX Surely there must be a nicer way to do this.
+ if ($package eq "FileHandle" || $package eq "Config" || 
+     $package eq "SelectSaver" || $package =~/^(B|IO)::/) 
+  {
+   delete_unsaved_hashINC($package);
+   return $unused_sub_packages{$package} = 0;
+  }
+ # Now see if current package looks like an OO class this is probably too strong.
+ foreach my $m (qw(new DESTROY TIESCALAR TIEARRAY TIEHASH TIEHANDLE)) 
+  {
+   if (UNIVERSAL::can($package, $m))
+    {
+     warn "$package has method $m: saving package\n";#debug
+     return mark_package($package);
+    }
+  }
+ delete_unsaved_hashINC($package);
+ return $unused_sub_packages{$package} = 0;
+}
+sub delete_unsaved_hashINC{
+	my $packname=shift;
+	$packname =~ s/\:\:/\//g;
+	$packname .= '.pm';
+#	warn "deleting $packname" if $INC{$packname} ;# debug
+	delete $INC{$packname};
+}
+sub walkpackages 
+{
+ my ($symref, $recurse, $prefix) = @_;
+ my $sym;
+ my $ref;
+ no strict 'vars';
+ local(*glob);
+ $prefix = '' unless defined $prefix;
+ while (($sym, $ref) = each %$symref) 
+  {             
+   *glob = $ref;
+   if ($sym =~ /::$/) 
+    {
+     $sym = $prefix . $sym;
+     if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) 
+      {
+       walkpackages(\%glob, $recurse, $sym);
+      }
+    } 
+  }
+}
+
+
+sub save_unused_subs 
+{
+ no strict qw(refs);
+ &descend_marked_unused;
+ warn "Prescan\n";
+ walkpackages(\%{"main::"}, sub { should_save($_[0]); return 1 });
+ warn "Saving methods\n";
+ walksymtable(\%{"main::"}, "savecv", \&should_save);
+}
+
+sub save_context
+{
+ my $curpad_nam = (comppadlist->ARRAY)[0]->save;
+ my $curpad_sym = (comppadlist->ARRAY)[1]->save;
+ my $inc_hv     = svref_2object(\%INC)->save;
+ my $inc_av     = svref_2object(\@INC)->save;
+ my $amagic_generate= amagic_generation;          
+ $init->add(   "PL_curpad = AvARRAY($curpad_sym);",
+	       "GvHV(PL_incgv) = $inc_hv;",
+	       "GvAV(PL_incgv) = $inc_av;",
+               "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
+               "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));",
+  		"PL_amagic_generation= $amagic_generate;" );
+}
+
+sub descend_marked_unused {
+    foreach my $pack (keys %unused_sub_packages)
+    {
+    	mark_package($pack);
+    }
+}
+ 
+sub save_main {
+    warn "Starting compile\n";
+    warn "Walking tree\n";
+    seek(STDOUT,0,0); #exclude print statements in BEGIN{} into output
+    walkoptree(main_root, "save");
+    warn "done main optree, walking symtable for extras\n" if $debug_cv;
+    save_unused_subs();
+    my $init_av = init_av->save;
+    $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
+	       sprintf("PL_main_start = s\\_%x;", ${main_start()}),
+              "PL_initav = (AV *) $init_av;");                                
+    save_context();
+    warn "Writing output\n";
+    output_boilerplate();
+    print "\n";
+    output_all("perl_init");
+    print "\n";
+    output_main();
+}
+
+sub init_sections {
+    my @sections = (init => \$init, decl => \$decl, sym => \$symsect,
+		    binop => \$binopsect, condop => \$condopsect,
+		    cop => \$copsect, padop => \$padopsect,
+		    listop => \$listopsect, logop => \$logopsect,
+		    loop => \$loopsect, op => \$opsect, pmop => \$pmopsect,
+		    pvop => \$pvopsect, svop => \$svopsect, unop => \$unopsect,
+		    sv => \$svsect, xpv => \$xpvsect, xpvav => \$xpvavsect,
+		    xpvhv => \$xpvhvsect, xpvcv => \$xpvcvsect,
+		    xpviv => \$xpvivsect, xpvnv => \$xpvnvsect,
+		    xpvmg => \$xpvmgsect, xpvlv => \$xpvlvsect,
+		    xrv => \$xrvsect, xpvbm => \$xpvbmsect,
+		    xpvio => \$xpviosect);
+    my ($name, $sectref);
+    while (($name, $sectref) = splice(@sections, 0, 2)) {
+	$$sectref = new B::C::Section $name, \%symtable, 0;
+    }
+}           
+
+sub mark_unused
+{
+ my ($arg,$val) = @_;
+ $unused_sub_packages{$arg} = $val;
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	}
+	if ($opt eq "w") {
+	    $warn_undefined_syms = 1;
+	} elsif ($opt eq "D") {
+	    $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "c") {
+		    $debug_cops = 1;
+		} elsif ($arg eq "A") {
+		    $debug_av = 1;
+		} elsif ($arg eq "C") {
+		    $debug_cv = 1;
+		} elsif ($arg eq "M") {
+		    $debug_mg = 1;
+		} else {
+		    warn "ignoring unknown debug option: $arg\n";
+		}
+	    }
+	} elsif ($opt eq "o") {
+	    $arg ||= shift @options;
+	    open(STDOUT, ">$arg") or return "$arg: $!\n";
+	} elsif ($opt eq "v") {
+	    $verbose = 1;
+	} elsif ($opt eq "u") {
+	    $arg ||= shift @options;
+	    mark_unused($arg,undef);
+	} elsif ($opt eq "f") {
+	    $arg ||= shift @options;
+	    if ($arg eq "cog") {
+		$pv_copy_on_grow = 1;
+	    } elsif ($arg eq "no-cog") {
+		$pv_copy_on_grow = 0;
+	    }
+	} elsif ($opt eq "O") {
+	    $arg = 1 if $arg eq "";
+	    $pv_copy_on_grow = 0;
+	    if ($arg >= 1) {
+		# Optimisations for -O1
+		$pv_copy_on_grow = 1;
+	    }
+	} elsif ($opt eq "l") {
+	    $max_string_len = $arg;
+	}
+    }
+    init_sections();
+    if (@options) {
+	return sub {
+	    my $objname;
+	    foreach $objname (@options) {
+		eval "save_object(\\$objname)";
+	    }
+	    output_all();
+	}
+    } else {
+	return sub { save_main() };
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::C - Perl compiler's C backend
+
+=head1 SYNOPSIS
+
+	perl -MO=C[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This compiler backend takes Perl source and generates C source code
+corresponding to the internal structures that perl uses to run
+your program. When the generated C source is compiled and run, it
+cuts out the time which perl would have taken to load and parse
+your program into its internal semi-compiled form. That means that
+compiling with this backend will not help improve the runtime
+execution speed of your program but may improve the start-up time.
+Depending on the environment in which your program runs this may be
+either a help or a hindrance.
+
+=head1 OPTIONS
+
+If there are any non-option arguments, they are taken to be
+names of objects to be saved (probably doesn't work properly yet).
+Without extra arguments, it saves the main program.
+
+=over 4
+
+=item B<-ofilename>
+
+Output to filename instead of STDOUT
+
+=item B<-v>
+
+Verbose compilation (currently gives a few compilation statistics).
+
+=item B<-->
+
+Force end of options
+
+=item B<-uPackname>
+
+Force apparently unused subs from package Packname to be compiled.
+This allows programs to use eval "foo()" even when sub foo is never
+seen to be used at compile time. The down side is that any subs which
+really are never used also have code generated. This option is
+necessary, for example, if you have a signal handler foo which you
+initialise with C<$SIG{BAR} = "foo">.  A better fix, though, is just
+to change it to C<$SIG{BAR} = \&foo>. You can have multiple B<-u>
+options. The compiler tries to figure out which packages may possibly
+have subs in which need compiling but the current version doesn't do
+it very well. In particular, it is confused by nested packages (i.e.
+of the form C<A::B>) where package C<A> does not contain any subs.
+
+=item B<-D>
+
+Debug options (concatenated or separate flags like C<perl -D>).
+
+=item B<-Do>
+
+OPs, prints each OP as it's processed
+
+=item B<-Dc>
+
+COPs, prints COPs as processed (incl. file & line num)
+
+=item B<-DA>
+
+prints AV information on saving
+
+=item B<-DC>
+
+prints CV information on saving
+
+=item B<-DM>
+
+prints MAGIC information on saving
+
+=item B<-f>
+
+Force optimisations on or off one at a time.
+
+=item B<-fcog>
+
+Copy-on-grow: PVs declared and initialised statically.
+
+=item B<-fno-cog>
+
+No copy-on-grow.
+
+=item B<-On>
+
+Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>.  Currently,
+B<-O1> and higher set B<-fcog>.
+
+=item B<-llimit>
+
+Some C compilers impose an arbitrary limit on the length of string
+constants (e.g. 2048 characters for Microsoft Visual C++).  The
+B<-llimit> options tells the C backend not to generate string literals
+exceeding that limit.
+
+=back
+
+=head1 EXAMPLES
+
+    perl -MO=C,-ofoo.c foo.pl
+    perl cc_harness -o foo foo.c
+
+Note that C<cc_harness> lives in the C<B> subdirectory of your perl
+library directory. The utility called C<perlcc> may also be used to
+help make use of this compiler.
+
+    perl -MO=C,-v,-DcA,-l2048 bar.pl > /dev/null
+
+=head1 BUGS
+
+Plenty. Current status: experimental.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/CC.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/CC.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/CC.pm	(revision 14265)
@@ -0,0 +1,2002 @@
+#      CC.pm
+#
+#      Copyright (c) 1996, 1997, 1998 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B::CC;
+use Config;
+use strict;
+use B qw(main_start main_root class comppadlist peekop svref_2object
+	timing_info init_av sv_undef amagic_generation 
+	OPf_WANT_LIST OPf_WANT OPf_MOD OPf_STACKED OPf_SPECIAL
+	OPpASSIGN_BACKWARDS OPpLVAL_INTRO OPpDEREF_AV OPpDEREF_HV
+	OPpDEREF OPpFLIP_LINENUM G_ARRAY G_SCALAR    
+	CXt_NULL CXt_SUB CXt_EVAL CXt_LOOP CXt_SUBST CXt_BLOCK
+	);
+use B::C qw(save_unused_subs objsym init_sections mark_unused
+	    output_all output_boilerplate output_main);
+use B::Bblock qw(find_leaders);
+use B::Stackobj qw(:types :flags);
+
+# These should probably be elsewhere
+# Flags for $op->flags
+
+my $module;		# module name (when compiled with -m)
+my %done;		# hash keyed by $$op of leaders of basic blocks
+			# which have already been done.
+my $leaders;		# ref to hash of basic block leaders. Keys are $$op
+			# addresses, values are the $op objects themselves.
+my @bblock_todo;	# list of leaders of basic blocks that need visiting
+			# sometime.
+my @cc_todo;		# list of tuples defining what PP code needs to be
+			# saved (e.g. CV, main or PMOP repl code). Each tuple
+			# is [$name, $root, $start, @padlist]. PMOP repl code
+			# tuples inherit padlist.
+my @stack;		# shadows perl's stack when contents are known.
+			# Values are objects derived from class B::Stackobj
+my @pad;		# Lexicals in current pad as Stackobj-derived objects
+my @padlist;		# Copy of current padlist so PMOP repl code can find it
+my @cxstack;		# Shadows the (compile-time) cxstack for next,last,redo
+my $jmpbuf_ix = 0;	# Next free index for dynamically allocated jmpbufs
+my %constobj;		# OP_CONST constants as Stackobj-derived objects
+			# keyed by $$sv.
+my $need_freetmps = 0;	# We may postpone FREETMPS to the end of each basic
+			# block or even to the end of each loop of blocks,
+			# depending on optimisation options.
+my $know_op = 0;	# Set when C variable op already holds the right op
+			# (from an immediately preceding DOOP(ppname)).
+my $errors = 0;		# Number of errors encountered
+my %skip_stack;		# Hash of PP names which don't need write_back_stack
+my %skip_lexicals;	# Hash of PP names which don't need write_back_lexicals
+my %skip_invalidate;	# Hash of PP names which don't need invalidate_lexicals
+my %ignore_op;		# Hash of ops which do nothing except returning op_next
+my %need_curcop;	# Hash of ops which need PL_curcop
+
+my %lexstate;		#state of padsvs at the start of a bblock
+
+BEGIN {
+    foreach (qw(pp_scalar pp_regcmaybe pp_lineseq pp_scope pp_null)) {
+	$ignore_op{$_} = 1;
+    }
+}
+
+my ($module_name);
+my ($debug_op, $debug_stack, $debug_cxstack, $debug_pad, $debug_runtime,
+    $debug_shadow, $debug_queue, $debug_lineno, $debug_timings);
+
+# Optimisation options. On the command line, use hyphens instead of
+# underscores for compatibility with gcc-style options. We use
+# underscores here because they are OK in (strict) barewords.
+my ($freetmps_each_bblock, $freetmps_each_loop, $omit_taint);
+my %optimise = (freetmps_each_bblock	=> \$freetmps_each_bblock,
+		freetmps_each_loop	=> \$freetmps_each_loop,
+		omit_taint		=> \$omit_taint);
+# perl patchlevel to generate code for (defaults to current patchlevel)
+my $patchlevel = int(0.5 + 1000 * ($]  - 5));
+
+# Could rewrite push_runtime() and output_runtime() to use a
+# temporary file if memory is at a premium.
+my $ppname;		# name of current fake PP function
+my $runtime_list_ref;
+my $declare_ref;	# Hash ref keyed by C variable type of declarations.
+
+my @pp_list;		# list of [$ppname, $runtime_list_ref, $declare_ref]
+			# tuples to be written out.
+
+my ($init, $decl);
+
+sub init_hash { map { $_ => 1 } @_ }
+
+#
+# Initialise the hashes for the default PP functions where we can avoid
+# either write_back_stack, write_back_lexicals or invalidate_lexicals.
+#
+%skip_lexicals = init_hash qw(pp_enter pp_enterloop);
+%skip_invalidate = init_hash qw(pp_enter pp_enterloop);
+%need_curcop = init_hash qw(pp_rv2gv  pp_bless pp_repeat pp_sort pp_caller
+			pp_reset pp_rv2cv pp_entereval pp_require pp_dofile
+			pp_entertry pp_enterloop pp_enteriter pp_entersub
+			pp_enter pp_method);
+
+sub debug {
+    if ($debug_runtime) {
+	warn(@_);
+    } else {
+	my @tmp=@_;
+	runtime(map { chomp; "/* $_ */"} @tmp);
+    }
+}
+
+sub declare {
+    my ($type, $var) = @_;
+    push(@{$declare_ref->{$type}}, $var);
+}
+
+sub push_runtime {
+    push(@$runtime_list_ref, @_);
+    warn join("\n", @_) . "\n" if $debug_runtime;
+}
+
+sub save_runtime {
+    push(@pp_list, [$ppname, $runtime_list_ref, $declare_ref]);
+}
+
+sub output_runtime {
+    my $ppdata;
+    print qq(#include "cc_runtime.h"\n);
+    foreach $ppdata (@pp_list) {
+	my ($name, $runtime, $declare) = @$ppdata;
+	print "\nstatic\nCCPP($name)\n{\n";
+	my ($type, $varlist, $line);
+	while (($type, $varlist) = each %$declare) {
+	    print "\t$type ", join(", ", @$varlist), ";\n";
+	}
+	foreach $line (@$runtime) {
+	    print $line, "\n";
+	}
+	print "}\n";
+    }
+}
+
+sub runtime {
+    my $line;
+    foreach $line (@_) {
+	push_runtime("\t$line");
+    }
+}
+
+sub init_pp {
+    $ppname = shift;
+    $runtime_list_ref = [];
+    $declare_ref = {};
+    runtime("dSP;");
+    declare("I32", "oldsave");
+    declare("SV", "**svp");
+    map { declare("SV", "*$_") } qw(sv src dst left right);
+    declare("MAGIC", "*mg");
+    $decl->add("static OP * $ppname (pTHX);");
+    debug "init_pp: $ppname\n" if $debug_queue;
+}
+
+# Initialise runtime_callback function for Stackobj class
+BEGIN { B::Stackobj::set_callback(\&runtime) }
+
+# Initialise saveoptree_callback for B::C class
+sub cc_queue {
+    my ($name, $root, $start, @pl) = @_;
+    debug "cc_queue: name $name, root $root, start $start, padlist (@pl)\n"
+	if $debug_queue;
+    if ($name eq "*ignore*") {
+	$name = 0;
+    } else {
+	push(@cc_todo, [$name, $root, $start, (@pl ? @pl : @padlist)]);
+    }
+    my $fakeop = new B::FAKEOP ("next" => 0, sibling => 0, ppaddr => $name);
+    $start = $fakeop->save;
+    debug "cc_queue: name $name returns $start\n" if $debug_queue;
+    return $start;
+}
+BEGIN { B::C::set_callback(\&cc_queue) }
+
+sub valid_int { $_[0]->{flags} & VALID_INT }
+sub valid_double { $_[0]->{flags} & VALID_DOUBLE }
+sub valid_numeric { $_[0]->{flags} & (VALID_INT | VALID_DOUBLE) }
+sub valid_sv { $_[0]->{flags} & VALID_SV }
+
+sub top_int { @stack ? $stack[-1]->as_int : "TOPi" }
+sub top_double { @stack ? $stack[-1]->as_double : "TOPn" }
+sub top_numeric { @stack ? $stack[-1]->as_numeric : "TOPn" }
+sub top_sv { @stack ? $stack[-1]->as_sv : "TOPs" }
+sub top_bool { @stack ? $stack[-1]->as_bool : "SvTRUE(TOPs)" }
+
+sub pop_int { @stack ? (pop @stack)->as_int : "POPi" }
+sub pop_double { @stack ? (pop @stack)->as_double : "POPn" }
+sub pop_numeric { @stack ? (pop @stack)->as_numeric : "POPn" }
+sub pop_sv { @stack ? (pop @stack)->as_sv : "POPs" }
+sub pop_bool {
+    if (@stack) {
+	return ((pop @stack)->as_bool);
+    } else {
+	# Careful: POPs has an auto-decrement and SvTRUE evaluates
+	# its argument more than once.
+	runtime("sv = POPs;");
+	return "SvTRUE(sv)";
+    }
+}
+
+sub write_back_lexicals {
+    my $avoid = shift || 0;
+    debug "write_back_lexicals($avoid) called from @{[(caller(1))[3]]}\n"
+	if $debug_shadow;
+    my $lex;
+    foreach $lex (@pad) {
+	next unless ref($lex);
+	$lex->write_back unless $lex->{flags} & $avoid;
+    }
+}
+
+sub save_or_restore_lexical_state {
+    my $bblock=shift;
+    unless( exists $lexstate{$bblock}){
+    	foreach my $lex (@pad) {
+		next unless ref($lex);
+		${$lexstate{$bblock}}{$lex->{iv}} = $lex->{flags} ;
+	}
+    }
+    else {
+    	foreach my $lex (@pad) {
+	    next unless ref($lex);
+	    my $old_flags=${$lexstate{$bblock}}{$lex->{iv}}  ;
+	    next if ( $old_flags eq $lex->{flags});
+	    if  (($old_flags & VALID_SV)  && !($lex->{flags} & VALID_SV)){
+		$lex->write_back;
+	    }
+	    if (($old_flags & VALID_DOUBLE) && !($lex->{flags} & VALID_DOUBLE)){
+                $lex->load_double;
+            }
+            if (($old_flags & VALID_INT) && !($lex->{flags} & VALID_INT)){
+                $lex->load_int;
+            }
+        }
+    }
+}
+
+sub write_back_stack {
+    my $obj;
+    return unless @stack;
+    runtime(sprintf("EXTEND(sp, %d);", scalar(@stack)));
+    foreach $obj (@stack) {
+	runtime(sprintf("PUSHs((SV*)%s);", $obj->as_sv));
+    }
+    @stack = ();
+}
+
+sub invalidate_lexicals {
+    my $avoid = shift || 0;
+    debug "invalidate_lexicals($avoid) called from @{[(caller(1))[3]]}\n"
+	if $debug_shadow;
+    my $lex;
+    foreach $lex (@pad) {
+	next unless ref($lex);
+	$lex->invalidate unless $lex->{flags} & $avoid;
+    }
+}
+
+sub reload_lexicals {
+    my $lex;
+    foreach $lex (@pad) {
+	next unless ref($lex);
+	my $type = $lex->{type};
+	if ($type == T_INT) {
+	    $lex->as_int;
+	} elsif ($type == T_DOUBLE) {
+	    $lex->as_double;
+	} else {
+	    $lex->as_sv;
+	}
+    }
+}
+
+{
+    package B::Pseudoreg;
+    #
+    # This class allocates pseudo-registers (OK, so they're C variables).
+    #
+    my %alloc;		# Keyed by variable name. A value of 1 means the
+			# variable has been declared. A value of 2 means
+			# it's in use.
+    
+    sub new_scope { %alloc = () }
+    
+    sub new ($$$) {
+	my ($class, $type, $prefix) = @_;
+	my ($ptr, $i, $varname, $status, $obj);
+	$prefix =~ s/^(\**)//;
+	$ptr = $1;
+	$i = 0;
+	do {
+	    $varname = "$prefix$i";
+	    $status = $alloc{$varname};
+	} while $status == 2;
+	if ($status != 1) {
+	    # Not declared yet
+	    B::CC::declare($type, "$ptr$varname");
+	    $alloc{$varname} = 2;	# declared and in use
+	}
+	$obj = bless \$varname, $class;
+	return $obj;
+    }
+    sub DESTROY {
+	my $obj = shift;
+	$alloc{$$obj} = 1; # no longer in use but still declared
+    }
+}
+{
+    package B::Shadow;
+    #
+    # This class gives a standard API for a perl object to shadow a
+    # C variable and only generate reloads/write-backs when necessary.
+    #
+    # Use $obj->load($foo) instead of runtime("shadowed_c_var = foo").
+    # Use $obj->write_back whenever shadowed_c_var needs to be up to date.
+    # Use $obj->invalidate whenever an unknown function may have
+    # set shadow itself.
+
+    sub new {
+	my ($class, $write_back) = @_;
+	# Object fields are perl shadow variable, validity flag
+	# (for *C* variable) and callback sub for write_back
+	# (passed perl shadow variable as argument).
+	bless [undef, 1, $write_back], $class;
+    }
+    sub load {
+	my ($obj, $newval) = @_;
+	$obj->[1] = 0;		# C variable no longer valid
+	$obj->[0] = $newval;
+    }
+    sub write_back {
+	my $obj = shift;
+	if (!($obj->[1])) {
+	    $obj->[1] = 1;	# C variable will now be valid
+	    &{$obj->[2]}($obj->[0]);
+	}
+    }
+    sub invalidate { $_[0]->[1] = 0 } # force C variable to be invalid
+}
+my $curcop = new B::Shadow (sub {
+    my $opsym = shift->save;
+    runtime("PL_curcop = (COP*)$opsym;");
+});
+
+#
+# Context stack shadowing. Mimics stuff in pp_ctl.c, cop.h and so on.
+#
+sub dopoptoloop {
+    my $cxix = $#cxstack;
+    while ($cxix >= 0 && $cxstack[$cxix]->{type} != CXt_LOOP) {
+	$cxix--;
+    }
+    debug "dopoptoloop: returning $cxix" if $debug_cxstack;
+    return $cxix;
+}
+
+sub dopoptolabel {
+    my $label = shift;
+    my $cxix = $#cxstack;
+    while ($cxix >= 0 &&
+	   ($cxstack[$cxix]->{type} != CXt_LOOP ||
+	    $cxstack[$cxix]->{label} ne $label)) {
+	$cxix--;
+    }
+    debug "dopoptolabel: returning $cxix" if $debug_cxstack;
+    return $cxix;
+}
+
+sub error {
+    my $format = shift;
+    my $file = $curcop->[0]->file;
+    my $line = $curcop->[0]->line;
+    $errors++;
+    if (@_) {
+	warn sprintf("%s:%d: $format\n", $file, $line, @_);
+    } else {
+	warn sprintf("%s:%d: %s\n", $file, $line, $format);
+    }
+}
+
+#
+# Load pad takes (the elements of) a PADLIST as arguments and loads
+# up @pad with Stackobj-derived objects which represent those lexicals.
+# If/when perl itself can generate type information (my int $foo) then
+# we'll take advantage of that here. Until then, we'll use various hacks
+# to tell the compiler when we want a lexical to be a particular type
+# or to be a register.
+#
+sub load_pad {
+    my ($namelistav, $valuelistav) = @_;
+    @padlist = @_;
+    my @namelist = $namelistav->ARRAY;
+    my @valuelist = $valuelistav->ARRAY;
+    my $ix;
+    @pad = ();
+    debug "load_pad: $#namelist names, $#valuelist values\n" if $debug_pad;
+    # Temporary lexicals don't get named so it's possible for @valuelist
+    # to be strictly longer than @namelist. We count $ix up to the end of
+    # @valuelist but index into @namelist for the name. Any temporaries which
+    # run off the end of @namelist will make $namesv undefined and we treat
+    # that the same as having an explicit SPECIAL sv_undef object in @namelist.
+    # [XXX If/when @_ becomes a lexical, we must start at 0 here.]
+    for ($ix = 1; $ix < @valuelist; $ix++) {
+	my $namesv = $namelist[$ix];
+	my $type = T_UNKNOWN;
+	my $flags = 0;
+	my $name = "tmp$ix";
+	my $class = class($namesv);
+	if (!defined($namesv) || $class eq "SPECIAL") {
+	    # temporaries have &PL_sv_undef instead of a PVNV for a name
+	    $flags = VALID_SV|TEMPORARY|REGISTER;
+	} else {
+	    if ($namesv->PV =~ /^\$(.*)_([di])(r?)$/) {
+		$name = $1;
+		if ($2 eq "i") {
+		    $type = T_INT;
+		    $flags = VALID_SV|VALID_INT;
+		} elsif ($2 eq "d") {
+		    $type = T_DOUBLE;
+		    $flags = VALID_SV|VALID_DOUBLE;
+		}
+		$flags |= REGISTER if $3;
+	    }
+	}
+	$pad[$ix] = new B::Stackobj::Padsv ($type, $flags, $ix,
+					    "i_$name", "d_$name");
+
+	debug sprintf("PL_curpad[$ix] = %s\n", $pad[$ix]->peek) if $debug_pad;
+    }
+}
+
+sub declare_pad {
+    my $ix;
+    for ($ix = 1; $ix <= $#pad; $ix++) {
+	my $type = $pad[$ix]->{type};
+	declare("IV", $type == T_INT ? 
+		sprintf("%s=0",$pad[$ix]->{iv}):$pad[$ix]->{iv}) if $pad[$ix]->save_int;
+	declare("double", $type == T_DOUBLE ?
+		 sprintf("%s = 0",$pad[$ix]->{nv}):$pad[$ix]->{nv} )if $pad[$ix]->save_double;
+
+    }
+}
+#
+# Debugging stuff
+#
+sub peek_stack { sprintf "stack = %s\n", join(" ", map($_->minipeek, @stack)) }
+
+#
+# OP stuff
+#
+
+sub label {
+    my $op = shift;
+    # XXX Preserve original label name for "real" labels?
+    return sprintf("lab_%x", $$op);
+}
+
+sub write_label {
+    my $op = shift;
+    push_runtime(sprintf("  %s:", label($op)));
+}
+
+sub loadop {
+    my $op = shift;
+    my $opsym = $op->save;
+    runtime("PL_op = $opsym;") unless $know_op;
+    return $opsym;
+}
+
+sub doop {
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    my $sym = loadop($op);
+    runtime("DOOP($ppname);");
+    $know_op = 1;
+    return $sym;
+}
+
+sub gimme {
+    my $op = shift;
+    my $flags = $op->flags;
+    return (($flags & OPf_WANT) ? (($flags & OPf_WANT)== OPf_WANT_LIST? G_ARRAY:G_SCALAR) : "dowantarray()");
+}
+
+#
+# Code generation for PP code
+#
+
+sub pp_null {
+    my $op = shift;
+    return $op->next;
+}
+
+sub pp_stub {
+    my $op = shift;
+    my $gimme = gimme($op);
+    if ($gimme != G_ARRAY) {
+	my $obj= new B::Stackobj::Const(sv_undef);
+    	push(@stack, $obj);
+	# XXX Change to push a constant sv_undef Stackobj onto @stack
+	#write_back_stack();
+	#runtime("if ($gimme != G_ARRAY) XPUSHs(&PL_sv_undef);");
+    }
+    return $op->next;
+}
+
+sub pp_unstack {
+    my $op = shift;
+    @stack = ();
+    runtime("PP_UNSTACK;");
+    return $op->next;
+}
+
+sub pp_and {
+    my $op = shift;
+    my $next = $op->next;
+    reload_lexicals();
+    unshift(@bblock_todo, $next);
+    if (@stack >= 1) {
+	my $bool = pop_bool();
+	write_back_stack();
+        save_or_restore_lexical_state($$next);
+	runtime(sprintf("if (!$bool) {XPUSHs(&PL_sv_no); goto %s;}", label($next)));
+    } else {
+        save_or_restore_lexical_state($$next);
+	runtime(sprintf("if (!%s) goto %s;", top_bool(), label($next)),
+		"*sp--;");
+    }
+    return $op->other;
+}
+	    
+sub pp_or {
+    my $op = shift;
+    my $next = $op->next;
+    reload_lexicals();
+    unshift(@bblock_todo, $next);
+    if (@stack >= 1) {
+	my $bool = pop_bool @stack;
+	write_back_stack();
+        save_or_restore_lexical_state($$next);
+	runtime(sprintf("if (%s) { XPUSHs(&PL_sv_yes); goto %s; }",
+			$bool, label($next)));
+    } else {
+        save_or_restore_lexical_state($$next);
+	runtime(sprintf("if (%s) goto %s;", top_bool(), label($next)),
+		"*sp--;");
+    }
+    return $op->other;
+}
+	    
+sub pp_cond_expr {
+    my $op = shift;
+    my $false = $op->next;
+    unshift(@bblock_todo, $false);
+    reload_lexicals();
+    my $bool = pop_bool();
+    write_back_stack();
+    save_or_restore_lexical_state($$false);
+    runtime(sprintf("if (!$bool) goto %s;", label($false)));
+    return $op->other;
+}
+
+sub pp_padsv {
+    my $op = shift;
+    my $ix = $op->targ;
+    push(@stack, $pad[$ix]);
+    if ($op->flags & OPf_MOD) {
+	my $private = $op->private;
+	if ($private & OPpLVAL_INTRO) {
+	    runtime("SAVECLEARSV(PL_curpad[$ix]);");
+	} elsif ($private & OPpDEREF) {
+	    runtime(sprintf("vivify_ref(PL_curpad[%d], %d);",
+			    $ix, $private & OPpDEREF));
+	    $pad[$ix]->invalidate;
+	}
+    }
+    return $op->next;
+}
+
+sub pp_const {
+    my $op = shift;
+    my $sv = $op->sv;
+    my $obj;
+    # constant could be in the pad (under useithreads)
+    if ($$sv) {
+	$obj = $constobj{$$sv};
+	if (!defined($obj)) {
+	    $obj = $constobj{$$sv} = new B::Stackobj::Const ($sv);
+	}
+    }
+    else {
+	$obj = $pad[$op->targ];
+    }
+    push(@stack, $obj);
+    return $op->next;
+}
+
+sub pp_nextstate {
+    my $op = shift;
+    $curcop->load($op);
+    @stack = ();
+    debug(sprintf("%s:%d\n", $op->file, $op->line)) if $debug_lineno;
+    runtime("TAINT_NOT;") unless $omit_taint;
+    runtime("sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;");
+    if ($freetmps_each_bblock || $freetmps_each_loop) {
+	$need_freetmps = 1;
+    } else {
+	runtime("FREETMPS;");
+    }
+    return $op->next;
+}
+
+sub pp_dbstate {
+    my $op = shift;
+    $curcop->invalidate; # XXX?
+    return default_pp($op);
+}
+
+#default_pp will handle this:
+#sub pp_bless { $curcop->write_back; default_pp(@_) }
+#sub pp_repeat { $curcop->write_back; default_pp(@_) }
+# The following subs need $curcop->write_back if we decide to support arybase:
+# pp_pos, pp_substr, pp_index, pp_rindex, pp_aslice, pp_lslice, pp_splice
+#sub pp_caller { $curcop->write_back; default_pp(@_) }
+#sub pp_reset { $curcop->write_back; default_pp(@_) }
+
+sub pp_rv2gv{
+    my $op =shift;
+    $curcop->write_back;
+    write_back_lexicals() unless $skip_lexicals{$ppname};
+    write_back_stack() unless $skip_stack{$ppname};
+    my $sym=doop($op);
+    if ($op->private & OPpDEREF) {
+        $init->add(sprintf("((UNOP *)$sym)->op_first = $sym;"));	
+        $init->add(sprintf("((UNOP *)$sym)->op_type = %d;", 
+		$op->first->type));	
+    }
+    return $op->next;
+}
+sub pp_sort {
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    if ( $op->flags & OPf_SPECIAL && $op->flags  & OPf_STACKED){   
+        #this indicates the sort BLOCK Array case
+        #ugly surgery required.
+        my $root=$op->first->sibling->first;
+        my $start=$root->first;
+	$op->first->save;
+	$op->first->sibling->save;
+	$root->save;
+	my $sym=$start->save;
+        my $fakeop=cc_queue("pp_sort".$$op,$root,$start);
+	$init->add(sprintf("(%s)->op_next=%s;",$sym,$fakeop));
+    }
+    $curcop->write_back;
+    write_back_lexicals();
+    write_back_stack();
+    doop($op);
+    return $op->next;
+}
+
+sub pp_gv {
+    my $op = shift;
+    my $gvsym;
+    if ($Config{useithreads}) {
+	$gvsym = $pad[$op->padix]->as_sv;
+    }
+    else {
+	$gvsym = $op->gv->save;
+    }
+    write_back_stack();
+    runtime("XPUSHs((SV*)$gvsym);");
+    return $op->next;
+}
+
+sub pp_gvsv {
+    my $op = shift;
+    my $gvsym;
+    if ($Config{useithreads}) {
+	$gvsym = $pad[$op->padix]->as_sv;
+    }
+    else {
+	$gvsym = $op->gv->save;
+    }
+    write_back_stack();
+    if ($op->private & OPpLVAL_INTRO) {
+	runtime("XPUSHs(save_scalar($gvsym));");
+    } else {
+	runtime("XPUSHs(GvSV($gvsym));");
+    }
+    return $op->next;
+}
+
+sub pp_aelemfast {
+    my $op = shift;
+    my $gvsym;
+    if ($Config{useithreads}) {
+	$gvsym = $pad[$op->padix]->as_sv;
+    }
+    else {
+	$gvsym = $op->gv->save;
+    }
+    my $ix = $op->private;
+    my $flag = $op->flags & OPf_MOD;
+    write_back_stack();
+    runtime("svp = av_fetch(GvAV($gvsym), $ix, $flag);",
+	    "PUSHs(svp ? *svp : &PL_sv_undef);");
+    return $op->next;
+}
+
+sub int_binop {
+    my ($op, $operator) = @_;
+    if ($op->flags & OPf_STACKED) {
+	my $right = pop_int();
+	if (@stack >= 1) {
+	    my $left = top_int();
+	    $stack[-1]->set_int(&$operator($left, $right));
+	} else {
+	    runtime(sprintf("sv_setiv(TOPs, %s);",&$operator("TOPi", $right)));
+	}
+    } else {
+	my $targ = $pad[$op->targ];
+	my $right = new B::Pseudoreg ("IV", "riv");
+	my $left = new B::Pseudoreg ("IV", "liv");
+	runtime(sprintf("$$right = %s; $$left = %s;", pop_int(), pop_int));
+	$targ->set_int(&$operator($$left, $$right));
+	push(@stack, $targ);
+    }
+    return $op->next;
+}
+
+sub INTS_CLOSED () { 0x1 }
+sub INT_RESULT () { 0x2 }
+sub NUMERIC_RESULT () { 0x4 }
+
+sub numeric_binop {
+    my ($op, $operator, $flags) = @_;
+    my $force_int = 0;
+    $force_int ||= ($flags & INT_RESULT);
+    $force_int ||= ($flags & INTS_CLOSED && @stack >= 2
+		    && valid_int($stack[-2]) && valid_int($stack[-1]));
+    if ($op->flags & OPf_STACKED) {
+	my $right = pop_numeric();
+	if (@stack >= 1) {
+	    my $left = top_numeric();
+	    if ($force_int) {
+		$stack[-1]->set_int(&$operator($left, $right));
+	    } else {
+		$stack[-1]->set_numeric(&$operator($left, $right));
+	    }
+	} else {
+	    if ($force_int) {
+	        my $rightruntime = new B::Pseudoreg ("IV", "riv");
+	    	runtime(sprintf("$$rightruntime = %s;",$right));
+		runtime(sprintf("sv_setiv(TOPs, %s);",
+				&$operator("TOPi", $$rightruntime)));
+	    } else {
+	    	my $rightruntime = new B::Pseudoreg ("double", "rnv");
+	    	runtime(sprintf("$$rightruntime = %s;",$right));
+		runtime(sprintf("sv_setnv(TOPs, %s);",
+				&$operator("TOPn",$$rightruntime)));
+	    }
+	}
+    } else {
+	my $targ = $pad[$op->targ];
+	$force_int ||= ($targ->{type} == T_INT);
+	if ($force_int) {
+	    my $right = new B::Pseudoreg ("IV", "riv");
+	    my $left = new B::Pseudoreg ("IV", "liv");
+	    runtime(sprintf("$$right = %s; $$left = %s;",
+			    pop_numeric(), pop_numeric));
+	    $targ->set_int(&$operator($$left, $$right));
+	} else {
+	    my $right = new B::Pseudoreg ("double", "rnv");
+	    my $left = new B::Pseudoreg ("double", "lnv");
+	    runtime(sprintf("$$right = %s; $$left = %s;",
+			    pop_numeric(), pop_numeric));
+	    $targ->set_numeric(&$operator($$left, $$right));
+	}
+	push(@stack, $targ);
+    }
+    return $op->next;
+}
+
+sub pp_ncmp {
+    my ($op) = @_;
+    if ($op->flags & OPf_STACKED) {
+	my $right = pop_numeric();
+	if (@stack >= 1) {
+	    my $left = top_numeric();
+	    runtime sprintf("if (%s > %s){",$left,$right);
+		$stack[-1]->set_int(1);
+	    $stack[-1]->write_back();
+	    runtime sprintf("}else if (%s < %s ) {",$left,$right);
+		$stack[-1]->set_int(-1);
+	    $stack[-1]->write_back();
+	    runtime sprintf("}else if (%s == %s) {",$left,$right);
+		$stack[-1]->set_int(0);
+	    $stack[-1]->write_back();
+	    runtime sprintf("}else {"); 
+		$stack[-1]->set_sv("&PL_sv_undef");
+	    runtime "}";
+	} else {
+	    my $rightruntime = new B::Pseudoreg ("double", "rnv");
+	    runtime(sprintf("$$rightruntime = %s;",$right));
+	    runtime sprintf(qq/if ("TOPn" > %s){/,$rightruntime);
+	    runtime sprintf("sv_setiv(TOPs,1);");
+	    runtime sprintf(qq/}else if ( "TOPn" < %s ) {/,$$rightruntime);
+	    runtime sprintf("sv_setiv(TOPs,-1);");
+	    runtime sprintf(qq/} else if ("TOPn" == %s) {/,$$rightruntime);
+	    runtime sprintf("sv_setiv(TOPs,0);");
+	    runtime sprintf(qq/}else {/); 
+	    runtime sprintf("sv_setiv(TOPs,&PL_sv_undef;");
+	    runtime "}";
+	}
+    } else {
+       	my $targ = $pad[$op->targ];
+	 my $right = new B::Pseudoreg ("double", "rnv");
+	 my $left = new B::Pseudoreg ("double", "lnv");
+	 runtime(sprintf("$$right = %s; $$left = %s;",
+			    pop_numeric(), pop_numeric));
+	runtime sprintf("if (%s > %s){",$$left,$$right);
+		$targ->set_int(1);
+		$targ->write_back();
+	runtime sprintf("}else if (%s < %s ) {",$$left,$$right);
+		$targ->set_int(-1);
+		$targ->write_back();
+	runtime sprintf("}else if (%s == %s) {",$$left,$$right);
+		$targ->set_int(0);
+		$targ->write_back();
+	runtime sprintf("}else {"); 
+		$targ->set_sv("&PL_sv_undef");
+	runtime "}";
+	push(@stack, $targ);
+    }
+    return $op->next;
+}
+
+sub sv_binop {
+    my ($op, $operator, $flags) = @_;
+    if ($op->flags & OPf_STACKED) {
+	my $right = pop_sv();
+	if (@stack >= 1) {
+	    my $left = top_sv();
+	    if ($flags & INT_RESULT) {
+		$stack[-1]->set_int(&$operator($left, $right));
+	    } elsif ($flags & NUMERIC_RESULT) {
+		$stack[-1]->set_numeric(&$operator($left, $right));
+	    } else {
+		# XXX Does this work?
+		runtime(sprintf("sv_setsv($left, %s);",
+				&$operator($left, $right)));
+		$stack[-1]->invalidate;
+	    }
+	} else {
+	    my $f;
+	    if ($flags & INT_RESULT) {
+		$f = "sv_setiv";
+	    } elsif ($flags & NUMERIC_RESULT) {
+		$f = "sv_setnv";
+	    } else {
+		$f = "sv_setsv";
+	    }
+	    runtime(sprintf("%s(TOPs, %s);", $f, &$operator("TOPs", $right)));
+	}
+    } else {
+	my $targ = $pad[$op->targ];
+	runtime(sprintf("right = %s; left = %s;", pop_sv(), pop_sv));
+	if ($flags & INT_RESULT) {
+	    $targ->set_int(&$operator("left", "right"));
+	} elsif ($flags & NUMERIC_RESULT) {
+	    $targ->set_numeric(&$operator("left", "right"));
+	} else {
+	    # XXX Does this work?
+	    runtime(sprintf("sv_setsv(%s, %s);",
+			    $targ->as_sv, &$operator("left", "right")));
+	    $targ->invalidate;
+	}
+	push(@stack, $targ);
+    }
+    return $op->next;
+}
+    
+sub bool_int_binop {
+    my ($op, $operator) = @_;
+    my $right = new B::Pseudoreg ("IV", "riv");
+    my $left = new B::Pseudoreg ("IV", "liv");
+    runtime(sprintf("$$right = %s; $$left = %s;", pop_int(), pop_int()));
+    my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
+    $bool->set_int(&$operator($$left, $$right));
+    push(@stack, $bool);
+    return $op->next;
+}
+
+sub bool_numeric_binop {
+    my ($op, $operator) = @_;
+    my $right = new B::Pseudoreg ("double", "rnv");
+    my $left = new B::Pseudoreg ("double", "lnv");
+    runtime(sprintf("$$right = %s; $$left = %s;",
+		    pop_numeric(), pop_numeric()));
+    my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
+    $bool->set_numeric(&$operator($$left, $$right));
+    push(@stack, $bool);
+    return $op->next;
+}
+
+sub bool_sv_binop {
+    my ($op, $operator) = @_;
+    runtime(sprintf("right = %s; left = %s;", pop_sv(), pop_sv()));
+    my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
+    $bool->set_numeric(&$operator("left", "right"));
+    push(@stack, $bool);
+    return $op->next;
+}
+
+sub infix_op {
+    my $opname = shift;
+    return sub { "$_[0] $opname $_[1]" }
+}
+
+sub prefix_op {
+    my $opname = shift;
+    return sub { sprintf("%s(%s)", $opname, join(", ", @_)) }
+}
+
+BEGIN {
+    my $plus_op = infix_op("+");
+    my $minus_op = infix_op("-");
+    my $multiply_op = infix_op("*");
+    my $divide_op = infix_op("/");
+    my $modulo_op = infix_op("%");
+    my $lshift_op = infix_op("<<");
+    my $rshift_op = infix_op(">>");
+    my $scmp_op = prefix_op("sv_cmp");
+    my $seq_op = prefix_op("sv_eq");
+    my $sne_op = prefix_op("!sv_eq");
+    my $slt_op = sub { "sv_cmp($_[0], $_[1]) < 0" };
+    my $sgt_op = sub { "sv_cmp($_[0], $_[1]) > 0" };
+    my $sle_op = sub { "sv_cmp($_[0], $_[1]) <= 0" };
+    my $sge_op = sub { "sv_cmp($_[0], $_[1]) >= 0" };
+    my $eq_op = infix_op("==");
+    my $ne_op = infix_op("!=");
+    my $lt_op = infix_op("<");
+    my $gt_op = infix_op(">");
+    my $le_op = infix_op("<=");
+    my $ge_op = infix_op(">=");
+
+    #
+    # XXX The standard perl PP code has extra handling for
+    # some special case arguments of these operators.
+    #
+    sub pp_add { numeric_binop($_[0], $plus_op) }
+    sub pp_subtract { numeric_binop($_[0], $minus_op) }
+    sub pp_multiply { numeric_binop($_[0], $multiply_op) }
+    sub pp_divide { numeric_binop($_[0], $divide_op) }
+    sub pp_modulo { int_binop($_[0], $modulo_op) } # differs from perl's
+
+    sub pp_left_shift { int_binop($_[0], $lshift_op) }
+    sub pp_right_shift { int_binop($_[0], $rshift_op) }
+    sub pp_i_add { int_binop($_[0], $plus_op) }
+    sub pp_i_subtract { int_binop($_[0], $minus_op) }
+    sub pp_i_multiply { int_binop($_[0], $multiply_op) }
+    sub pp_i_divide { int_binop($_[0], $divide_op) }
+    sub pp_i_modulo { int_binop($_[0], $modulo_op) }
+
+    sub pp_eq { bool_numeric_binop($_[0], $eq_op) }
+    sub pp_ne { bool_numeric_binop($_[0], $ne_op) }
+    sub pp_lt { bool_numeric_binop($_[0], $lt_op) }
+    sub pp_gt { bool_numeric_binop($_[0], $gt_op) }
+    sub pp_le { bool_numeric_binop($_[0], $le_op) }
+    sub pp_ge { bool_numeric_binop($_[0], $ge_op) }
+
+    sub pp_i_eq { bool_int_binop($_[0], $eq_op) }
+    sub pp_i_ne { bool_int_binop($_[0], $ne_op) }
+    sub pp_i_lt { bool_int_binop($_[0], $lt_op) }
+    sub pp_i_gt { bool_int_binop($_[0], $gt_op) }
+    sub pp_i_le { bool_int_binop($_[0], $le_op) }
+    sub pp_i_ge { bool_int_binop($_[0], $ge_op) }
+
+    sub pp_scmp { sv_binop($_[0], $scmp_op, INT_RESULT) }
+    sub pp_slt { bool_sv_binop($_[0], $slt_op) }
+    sub pp_sgt { bool_sv_binop($_[0], $sgt_op) }
+    sub pp_sle { bool_sv_binop($_[0], $sle_op) }
+    sub pp_sge { bool_sv_binop($_[0], $sge_op) }
+    sub pp_seq { bool_sv_binop($_[0], $seq_op) }
+    sub pp_sne { bool_sv_binop($_[0], $sne_op) }
+}
+
+
+sub pp_sassign {
+    my $op = shift;
+    my $backwards = $op->private & OPpASSIGN_BACKWARDS;
+    my ($dst, $src);
+    if (@stack >= 2) {
+	$dst = pop @stack;
+	$src = pop @stack;
+	($src, $dst) = ($dst, $src) if $backwards;
+	my $type = $src->{type};
+	if ($type == T_INT) {
+	    $dst->set_int($src->as_int,$src->{flags} & VALID_UNSIGNED);
+	} elsif ($type == T_DOUBLE) {
+	    $dst->set_numeric($src->as_numeric);
+	} else {
+	    $dst->set_sv($src->as_sv);
+	}
+	push(@stack, $dst);
+    } elsif (@stack == 1) {
+	if ($backwards) {
+	    my $src = pop @stack;
+	    my $type = $src->{type};
+	    runtime("if (PL_tainting && PL_tainted) TAINT_NOT;");
+	    if ($type == T_INT) {
+                if ($src->{flags} & VALID_UNSIGNED){ 
+                     runtime sprintf("sv_setuv(TOPs, %s);", $src->as_int);
+                }else{
+                    runtime sprintf("sv_setiv(TOPs, %s);", $src->as_int);
+                }
+	    } elsif ($type == T_DOUBLE) {
+		runtime sprintf("sv_setnv(TOPs, %s);", $src->as_double);
+	    } else {
+		runtime sprintf("sv_setsv(TOPs, %s);", $src->as_sv);
+	    }
+	    runtime("SvSETMAGIC(TOPs);");
+	} else {
+	    my $dst = $stack[-1];
+	    my $type = $dst->{type};
+	    runtime("sv = POPs;");
+	    runtime("MAYBE_TAINT_SASSIGN_SRC(sv);");
+	    if ($type == T_INT) {
+		$dst->set_int("SvIV(sv)");
+	    } elsif ($type == T_DOUBLE) {
+		$dst->set_double("SvNV(sv)");
+	    } else {
+		runtime("SvSetMagicSV($dst->{sv}, sv);");
+		$dst->invalidate;
+	    }
+	}
+    } else {
+	if ($backwards) {
+	    runtime("src = POPs; dst = TOPs;");
+	} else {
+	    runtime("dst = POPs; src = TOPs;");
+	}
+	runtime("MAYBE_TAINT_SASSIGN_SRC(src);",
+		"SvSetSV(dst, src);",
+		"SvSETMAGIC(dst);",
+		"SETs(dst);");
+    }
+    return $op->next;
+}
+
+sub pp_preinc {
+    my $op = shift;
+    if (@stack >= 1) {
+	my $obj = $stack[-1];
+	my $type = $obj->{type};
+	if ($type == T_INT || $type == T_DOUBLE) {
+	    $obj->set_int($obj->as_int . " + 1");
+	} else {
+	    runtime sprintf("PP_PREINC(%s);", $obj->as_sv);
+	    $obj->invalidate();
+	}
+    } else {
+	runtime sprintf("PP_PREINC(TOPs);");
+    }
+    return $op->next;
+}
+
+
+sub pp_pushmark {
+    my $op = shift;
+    write_back_stack();
+    runtime("PUSHMARK(sp);");
+    return $op->next;
+}
+
+sub pp_list {
+    my $op = shift;
+    write_back_stack();
+    my $gimme = gimme($op);
+    if ($gimme == G_ARRAY) { # sic
+	runtime("POPMARK;"); # need this even though not a "full" pp_list
+    } else {
+	runtime("PP_LIST($gimme);");
+    }
+    return $op->next;
+}
+
+sub pp_entersub {
+    my $op = shift;
+    $curcop->write_back;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = doop($op);
+    runtime("while (PL_op != ($sym)->op_next && PL_op != (OP*)0 ){");
+    runtime("PL_op = (*PL_op->op_ppaddr)(aTHX);");
+    runtime("SPAGAIN;}");
+    $know_op = 0;
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+sub pp_formline {
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    write_back_lexicals() unless $skip_lexicals{$ppname};
+    write_back_stack() unless $skip_stack{$ppname};
+    my $sym=doop($op);
+    # See comment in pp_grepwhile to see why!
+    $init->add("((LISTOP*)$sym)->op_first = $sym;");    
+    runtime("if (PL_op == ((LISTOP*)($sym))->op_first){");
+    save_or_restore_lexical_state(${$op->first});
+    runtime( sprintf("goto %s;",label($op->first)));
+    runtime("}");
+    return $op->next;
+}
+
+sub pp_goto{
+
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    write_back_lexicals() unless $skip_lexicals{$ppname};
+    write_back_stack() unless $skip_stack{$ppname};
+    my $sym=doop($op);
+    runtime("if (PL_op != ($sym)->op_next && PL_op != (OP*)0){return PL_op;}");
+    invalidate_lexicals() unless $skip_invalidate{$ppname};
+    return $op->next;
+}
+sub pp_enterwrite {
+    my $op = shift;
+    pp_entersub($op);
+}
+sub pp_leavesub{
+    my $op = shift;
+    write_back_lexicals() unless $skip_lexicals{$ppname};
+    write_back_stack() unless $skip_stack{$ppname};
+    runtime("if (PL_curstackinfo->si_type == PERLSI_SORT){");   
+    runtime("\tPUTBACK;return 0;");
+    runtime("}");
+    doop($op);
+    return $op->next;
+}
+sub pp_leavewrite {
+    my $op = shift;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = doop($op);
+    # XXX Is this the right way to distinguish between it returning
+    # CvSTART(cv) (via doform) and pop_return()?
+    #runtime("if (PL_op) PL_op = (*PL_op->op_ppaddr)(aTHX);");
+    runtime("SPAGAIN;");
+    $know_op = 0;
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+
+sub doeval {
+    my $op = shift;
+    $curcop->write_back;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = loadop($op);
+    my $ppaddr = $op->ppaddr;
+    #runtime(qq/printf("$ppaddr type eval\n");/);
+    runtime("PP_EVAL($ppaddr, ($sym)->op_next);");
+    $know_op = 1;
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+
+sub pp_entereval { doeval(@_) }
+sub pp_dofile { doeval(@_) }
+
+#pp_require is protected by pp_entertry, so no protection for it.
+sub pp_require {
+    my $op = shift;
+    $curcop->write_back;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = doop($op);
+    runtime("while (PL_op != ($sym)->op_next && PL_op != (OP*)0 ){");
+    runtime("PL_op = (*PL_op->op_ppaddr)(ARGS);");
+    runtime("SPAGAIN;}");
+    $know_op = 1;
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+
+
+sub pp_entertry {
+    my $op = shift;
+    $curcop->write_back;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = doop($op);
+    my $jmpbuf = sprintf("jmpbuf%d", $jmpbuf_ix++);
+    declare("JMPENV", $jmpbuf);
+    runtime(sprintf("PP_ENTERTRY(%s,%s);", $jmpbuf, label($op->other->next)));
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+
+sub pp_leavetry{
+	my $op=shift;
+	default_pp($op);
+	runtime("PP_LEAVETRY;");
+    	return $op->next;
+}
+
+sub pp_grepstart {
+    my $op = shift;
+    if ($need_freetmps && $freetmps_each_loop) {
+	runtime("FREETMPS;"); # otherwise the grepwhile loop messes things up
+	$need_freetmps = 0;
+    }
+    write_back_stack();
+    my $sym= doop($op);
+    my $next=$op->next;
+    $next->save;
+    my $nexttonext=$next->next;
+    $nexttonext->save;
+    save_or_restore_lexical_state($$nexttonext);
+    runtime(sprintf("if (PL_op == (($sym)->op_next)->op_next) goto %s;",
+		    label($nexttonext)));
+    return $op->next->other;
+}
+
+sub pp_mapstart {
+    my $op = shift;
+    if ($need_freetmps && $freetmps_each_loop) {
+	runtime("FREETMPS;"); # otherwise the mapwhile loop messes things up
+	$need_freetmps = 0;
+    }
+    write_back_stack();
+    # pp_mapstart can return either op_next->op_next or op_next->op_other and
+    # we need to be able to distinguish the two at runtime. 
+    my $sym= doop($op);
+    my $next=$op->next;
+    $next->save;
+    my $nexttonext=$next->next;
+    $nexttonext->save;
+    save_or_restore_lexical_state($$nexttonext);
+    runtime(sprintf("if (PL_op == (($sym)->op_next)->op_next) goto %s;",
+		    label($nexttonext)));
+    return $op->next->other;
+}
+
+sub pp_grepwhile {
+    my $op = shift;
+    my $next = $op->next;
+    unshift(@bblock_todo, $next);
+    write_back_lexicals();
+    write_back_stack();
+    my $sym = doop($op);
+    # pp_grepwhile can return either op_next or op_other and we need to
+    # be able to distinguish the two at runtime. Since it's possible for
+    # both ops to be "inlined", the fields could both be zero. To get
+    # around that, we hack op_next to be our own op (purely because we
+    # know it's a non-NULL pointer and can't be the same as op_other).
+    $init->add("((LOGOP*)$sym)->op_next = $sym;");
+    save_or_restore_lexical_state($$next);
+    runtime(sprintf("if (PL_op == ($sym)->op_next) goto %s;", label($next)));
+    $know_op = 0;
+    return $op->other;
+}
+
+sub pp_mapwhile {
+    pp_grepwhile(@_);
+}
+
+sub pp_return {
+    my $op = shift;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    doop($op);
+    runtime("PUTBACK;", "return PL_op;");
+    $know_op = 0;
+    return $op->next;
+}
+
+sub nyi {
+    my $op = shift;
+    warn sprintf("%s not yet implemented properly\n", $op->ppaddr);
+    return default_pp($op);
+}
+
+sub pp_range {
+    my $op = shift;
+    my $flags = $op->flags;
+    if (!($flags & OPf_WANT)) {
+	error("context of range unknown at compile-time");
+    }
+    write_back_lexicals();
+    write_back_stack();
+    unless (($flags & OPf_WANT)== OPf_WANT_LIST) {
+	# We need to save our UNOP structure since pp_flop uses
+	# it to find and adjust out targ. We don't need it ourselves.
+	$op->save;
+        save_or_restore_lexical_state(${$op->other});
+	runtime sprintf("if (SvTRUE(PL_curpad[%d])) goto %s;",
+			$op->targ, label($op->other));
+	unshift(@bblock_todo, $op->other);
+    }
+    return $op->next;
+}
+
+sub pp_flip {
+    my $op = shift;
+    my $flags = $op->flags;
+    if (!($flags & OPf_WANT)) {
+	error("context of flip unknown at compile-time");
+    }
+    if (($flags & OPf_WANT)==OPf_WANT_LIST) {
+	return $op->first->other;
+    }
+    write_back_lexicals();
+    write_back_stack();
+    # We need to save our UNOP structure since pp_flop uses
+    # it to find and adjust out targ. We don't need it ourselves.
+    $op->save;
+    my $ix = $op->targ;
+    my $rangeix = $op->first->targ;
+    runtime(($op->private & OPpFLIP_LINENUM) ?
+	    "if (PL_last_in_gv && SvIV(TOPs) == IoLINES(GvIOp(PL_last_in_gv))) {"
+	  : "if (SvTRUE(TOPs)) {");
+    runtime("\tsv_setiv(PL_curpad[$rangeix], 1);");
+    if ($op->flags & OPf_SPECIAL) {
+	runtime("sv_setiv(PL_curpad[$ix], 1);");
+    } else {
+    	save_or_restore_lexical_state(${$op->first->other});
+	runtime("\tsv_setiv(PL_curpad[$ix], 0);",
+		"\tsp--;",
+		sprintf("\tgoto %s;", label($op->first->other)));
+    }
+    runtime("}",
+	  qq{sv_setpv(PL_curpad[$ix], "");},
+	    "SETs(PL_curpad[$ix]);");
+    $know_op = 0;
+    return $op->next;
+}
+
+sub pp_flop {
+    my $op = shift;
+    default_pp($op);
+    $know_op = 0;
+    return $op->next;
+}
+
+sub enterloop {
+    my $op = shift;
+    my $nextop = $op->nextop;
+    my $lastop = $op->lastop;
+    my $redoop = $op->redoop;
+    $curcop->write_back;
+    debug "enterloop: pushing on cxstack" if $debug_cxstack;
+    push(@cxstack, {
+	type => CXt_LOOP,
+	op => $op,
+	"label" => $curcop->[0]->label,
+	nextop => $nextop,
+	lastop => $lastop,
+	redoop => $redoop
+    });
+    $nextop->save;
+    $lastop->save;
+    $redoop->save;
+    return default_pp($op);
+}
+
+sub pp_enterloop { enterloop(@_) }
+sub pp_enteriter { enterloop(@_) }
+
+sub pp_leaveloop {
+    my $op = shift;
+    if (!@cxstack) {
+	die "panic: leaveloop";
+    }
+    debug "leaveloop: popping from cxstack" if $debug_cxstack;
+    pop(@cxstack);
+    return default_pp($op);
+}
+
+sub pp_next {
+    my $op = shift;
+    my $cxix;
+    if ($op->flags & OPf_SPECIAL) {
+	$cxix = dopoptoloop();
+	if ($cxix < 0) {
+	    error('"next" used outside loop');
+	    return $op->next; # ignore the op
+	}
+    } else {
+	$cxix = dopoptolabel($op->pv);
+	if ($cxix < 0) {
+	    error('Label not found at compile time for "next %s"', $op->pv);
+	    return $op->next; # ignore the op
+	}
+    }
+    default_pp($op);
+    my $nextop = $cxstack[$cxix]->{nextop};
+    push(@bblock_todo, $nextop);
+    save_or_restore_lexical_state($$nextop);
+    runtime(sprintf("goto %s;", label($nextop)));
+    return $op->next;
+}
+
+sub pp_redo {
+    my $op = shift;
+    my $cxix;
+    if ($op->flags & OPf_SPECIAL) {
+	$cxix = dopoptoloop();
+	if ($cxix < 0) {
+	    error('"redo" used outside loop');
+	    return $op->next; # ignore the op
+	}
+    } else {
+	$cxix = dopoptolabel($op->pv);
+	if ($cxix < 0) {
+	    error('Label not found at compile time for "redo %s"', $op->pv);
+	    return $op->next; # ignore the op
+	}
+    }
+    default_pp($op);
+    my $redoop = $cxstack[$cxix]->{redoop};
+    push(@bblock_todo, $redoop);
+    save_or_restore_lexical_state($$redoop);
+    runtime(sprintf("goto %s;", label($redoop)));
+    return $op->next;
+}
+
+sub pp_last {
+    my $op = shift;
+    my $cxix;
+    if ($op->flags & OPf_SPECIAL) {
+	$cxix = dopoptoloop();
+	if ($cxix < 0) {
+	    error('"last" used outside loop');
+	    return $op->next; # ignore the op
+	}
+    } else {
+	$cxix = dopoptolabel($op->pv);
+	if ($cxix < 0) {
+	    error('Label not found at compile time for "last %s"', $op->pv);
+	    return $op->next; # ignore the op
+	}
+	# XXX Add support for "last" to leave non-loop blocks
+	if ($cxstack[$cxix]->{type} != CXt_LOOP) {
+	    error('Use of "last" for non-loop blocks is not yet implemented');
+	    return $op->next; # ignore the op
+	}
+    }
+    default_pp($op);
+    my $lastop = $cxstack[$cxix]->{lastop}->next;
+    push(@bblock_todo, $lastop);
+    save_or_restore_lexical_state($$lastop);
+    runtime(sprintf("goto %s;", label($lastop)));
+    return $op->next;
+}
+
+sub pp_subst {
+    my $op = shift;
+    write_back_lexicals();
+    write_back_stack();
+    my $sym = doop($op);
+    my $replroot = $op->pmreplroot;
+    if ($$replroot) {
+        save_or_restore_lexical_state($$replroot);
+	runtime sprintf("if (PL_op == ((PMOP*)(%s))->op_pmreplroot) goto %s;",
+			$sym, label($replroot));
+	$op->pmreplstart->save;
+	push(@bblock_todo, $replroot);
+    }
+    invalidate_lexicals();
+    return $op->next;
+}
+
+sub pp_substcont {
+    my $op = shift;
+    write_back_lexicals();
+    write_back_stack();
+    doop($op);
+    my $pmop = $op->other;
+    # warn sprintf("substcont: op = %s, pmop = %s\n",
+    # 		 peekop($op), peekop($pmop));#debug
+#   my $pmopsym = objsym($pmop);
+    my $pmopsym = $pmop->save; # XXX can this recurse?
+#   warn "pmopsym = $pmopsym\n";#debug
+    save_or_restore_lexical_state(${$pmop->pmreplstart});
+    runtime sprintf("if (PL_op == ((PMOP*)(%s))->op_pmreplstart) goto %s;",
+		    $pmopsym, label($pmop->pmreplstart));
+    invalidate_lexicals();
+    return $pmop->next;
+}
+
+sub default_pp {
+    my $op = shift;
+    my $ppname = "pp_" . $op->name;
+    if ($curcop and $need_curcop{$ppname}){
+	$curcop->write_back;
+    }
+    write_back_lexicals() unless $skip_lexicals{$ppname};
+    write_back_stack() unless $skip_stack{$ppname};
+    doop($op);
+    # XXX If the only way that ops can write to a TEMPORARY lexical is
+    # when it's named in $op->targ then we could call
+    # invalidate_lexicals(TEMPORARY) and avoid having to write back all
+    # the temporaries. For now, we'll play it safe and write back the lot.
+    invalidate_lexicals() unless $skip_invalidate{$ppname};
+    return $op->next;
+}
+
+sub compile_op {
+    my $op = shift;
+    my $ppname = "pp_" . $op->name;
+    if (exists $ignore_op{$ppname}) {
+	return $op->next;
+    }
+    debug peek_stack() if $debug_stack;
+    if ($debug_op) {
+	debug sprintf("%s [%s]\n",
+		     peekop($op),
+		     $op->flags & OPf_STACKED ? "OPf_STACKED" : $op->targ);
+    }
+    no strict 'refs';
+    if (defined(&$ppname)) {
+	$know_op = 0;
+	return &$ppname($op);
+    } else {
+	return default_pp($op);
+    }
+}
+
+sub compile_bblock {
+    my $op = shift;
+    #warn "compile_bblock: ", peekop($op), "\n"; # debug
+    save_or_restore_lexical_state($$op);
+    write_label($op);
+    $know_op = 0;
+    do {
+	$op = compile_op($op);
+    } while (defined($op) && $$op && !exists($leaders->{$$op}));
+    write_back_stack(); # boo hoo: big loss
+    reload_lexicals();
+    return $op;
+}
+
+sub cc {
+    my ($name, $root, $start, @padlist) = @_;
+    my $op;
+    if($done{$$start}){ 
+    	#warn "repeat=>".ref($start)."$name,\n";#debug
+	$decl->add(sprintf("#define $name  %s",$done{$$start}));
+	return;
+    }
+    init_pp($name);
+    load_pad(@padlist);
+    %lexstate=();
+    B::Pseudoreg->new_scope;
+    @cxstack = ();
+    if ($debug_timings) {
+	warn sprintf("Basic block analysis at %s\n", timing_info);
+    }
+    $leaders = find_leaders($root, $start);
+    my @leaders= keys %$leaders; 
+    if ($#leaders > -1) { 
+    	@bblock_todo = ($start, values %$leaders) ;
+    } else{
+	runtime("return PL_op?PL_op->op_next:0;");
+    }
+    if ($debug_timings) {
+	warn sprintf("Compilation at %s\n", timing_info);
+    }
+    while (@bblock_todo) {
+	$op = shift @bblock_todo;
+	#warn sprintf("Considering basic block %s\n", peekop($op)); # debug
+	next if !defined($op) || !$$op || $done{$$op};
+	#warn "...compiling it\n"; # debug
+	do {
+	    $done{$$op} = $name;
+	    $op = compile_bblock($op);
+	    if ($need_freetmps && $freetmps_each_bblock) {
+		runtime("FREETMPS;");
+		$need_freetmps = 0;
+	    }
+	} while defined($op) && $$op && !$done{$$op};
+	if ($need_freetmps && $freetmps_each_loop) {
+	    runtime("FREETMPS;");
+	    $need_freetmps = 0;
+	}
+	if (!$$op) {
+	    runtime("PUTBACK;","return PL_op;");
+	} elsif ($done{$$op}) {
+    	    save_or_restore_lexical_state($$op);
+	    runtime(sprintf("goto %s;", label($op)));
+	}
+    }
+    if ($debug_timings) {
+	warn sprintf("Saving runtime at %s\n", timing_info);
+    }
+    declare_pad(@padlist) ;
+    save_runtime();
+}
+
+sub cc_recurse {
+    my $ccinfo;
+    my $start;
+    $start = cc_queue(@_) if @_;
+    while ($ccinfo = shift @cc_todo) {
+	cc(@$ccinfo);
+    }
+    return $start;
+}    
+
+sub cc_obj {
+    my ($name, $cvref) = @_;
+    my $cv = svref_2object($cvref);
+    my @padlist = $cv->PADLIST->ARRAY;
+    my $curpad_sym = $padlist[1]->save;
+    cc_recurse($name, $cv->ROOT, $cv->START, @padlist);
+}
+
+sub cc_main {
+    my @comppadlist = comppadlist->ARRAY;
+    my $curpad_nam  = $comppadlist[0]->save;
+    my $curpad_sym  = $comppadlist[1]->save;
+    my $init_av     = init_av->save; 
+    my $start = cc_recurse("pp_main", main_root, main_start, @comppadlist);
+    # Do save_unused_subs before saving inc_hv
+    save_unused_subs();
+    cc_recurse();
+
+    my $inc_hv      = svref_2object(\%INC)->save;
+    my $inc_av      = svref_2object(\@INC)->save;
+    my $amagic_generate= amagic_generation;
+    return if $errors;
+    if (!defined($module)) {
+	$init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
+		   "PL_main_start = $start;",
+		   "PL_curpad = AvARRAY($curpad_sym);",
+		   "PL_initav = (AV *) $init_av;",
+		   "GvHV(PL_incgv) = $inc_hv;",
+		   "GvAV(PL_incgv) = $inc_av;",
+		   "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
+		   "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));",
+		   "PL_amagic_generation= $amagic_generate;",
+		     );
+                 
+    }
+    seek(STDOUT,0,0); #prevent print statements from BEGIN{} into the output
+    output_boilerplate();
+    print "\n";
+    output_all("perl_init");
+    output_runtime();
+    print "\n";
+    output_main();
+    if (defined($module)) {
+	my $cmodule = $module;
+	$cmodule =~ s/::/__/g;
+	print <<"EOT";
+
+#include "XSUB.h"
+XS(boot_$cmodule)
+{
+    dXSARGS;
+    perl_init();
+    ENTER;
+    SAVETMPS;
+    SAVEVPTR(PL_curpad);
+    SAVEVPTR(PL_op);
+    PL_curpad = AvARRAY($curpad_sym);
+    PL_op = $start;
+    pp_main(aTHX);
+    FREETMPS;
+    LEAVE;
+    ST(0) = &PL_sv_yes;
+    XSRETURN(1);
+}
+EOT
+    }
+    if ($debug_timings) {
+	warn sprintf("Done at %s\n", timing_info);
+    }
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "o") {
+	    $arg ||= shift @options;
+	    open(STDOUT, ">$arg") or return "open '>$arg': $!\n";
+	} elsif ($opt eq "n") {
+	    $arg ||= shift @options;
+	    $module_name = $arg;
+	} elsif ($opt eq "u") {
+	    $arg ||= shift @options;
+	    mark_unused($arg,undef);
+	} elsif ($opt eq "f") {
+	    $arg ||= shift @options;
+	    my $value = $arg !~ s/^no-//;
+	    $arg =~ s/-/_/g;
+	    my $ref = $optimise{$arg};
+	    if (defined($ref)) {
+		$$ref = $value;
+	    } else {
+		warn qq(ignoring unknown optimisation option "$arg"\n);
+	    }
+	} elsif ($opt eq "O") {
+	    $arg = 1 if $arg eq "";
+	    my $ref;
+	    foreach $ref (values %optimise) {
+		$$ref = 0;
+	    }
+	    if ($arg >= 2) {
+		$freetmps_each_loop = 1;
+	    }
+	    if ($arg >= 1) {
+		$freetmps_each_bblock = 1 unless $freetmps_each_loop;
+	    }
+	} elsif ($opt eq "m") {
+	    $arg ||= shift @options;
+	    $module = $arg;
+	    mark_unused($arg,undef);
+	} elsif ($opt eq "p") {
+	    $arg ||= shift @options;
+	    $patchlevel = $arg;
+	} elsif ($opt eq "D") {
+            $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "O") {
+		    $debug_op = 1;
+		} elsif ($arg eq "s") {
+		    $debug_stack = 1;
+		} elsif ($arg eq "c") {
+		    $debug_cxstack = 1;
+		} elsif ($arg eq "p") {
+		    $debug_pad = 1;
+		} elsif ($arg eq "r") {
+		    $debug_runtime = 1;
+		} elsif ($arg eq "S") {
+		    $debug_shadow = 1;
+		} elsif ($arg eq "q") {
+		    $debug_queue = 1;
+		} elsif ($arg eq "l") {
+		    $debug_lineno = 1;
+		} elsif ($arg eq "t") {
+		    $debug_timings = 1;
+		}
+	    }
+	}
+    }
+    init_sections();
+    $init = B::Section->get("init");
+    $decl = B::Section->get("decl");
+
+    if (@options) {
+	return sub {
+	    my ($objname, $ppname);
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		($ppname = $objname) =~ s/^.*?:://;
+		eval "cc_obj(qq(pp_sub_$ppname), \\&$objname)";
+		die "cc_obj(qq(pp_sub_$ppname, \\&$objname) failed: $@" if $@;
+		return if $errors;
+	    }
+	    output_boilerplate();
+	    print "\n";
+	    output_all($module_name || "init_module");
+	    output_runtime();
+	}
+    } else {
+	return sub { cc_main() };
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::CC - Perl compiler's optimized C translation backend
+
+=head1 SYNOPSIS
+
+	perl -MO=CC[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This compiler backend takes Perl source and generates C source code
+corresponding to the flow of your program. In other words, this
+backend is somewhat a "real" compiler in the sense that many people
+think about compilers. Note however that, currently, it is a very
+poor compiler in that although it generates (mostly, or at least
+sometimes) correct code, it performs relatively few optimisations.
+This will change as the compiler develops. The result is that
+running an executable compiled with this backend may start up more
+quickly than running the original Perl program (a feature shared
+by the B<C> compiler backend--see F<B::C>) and may also execute
+slightly faster. This is by no means a good optimising compiler--yet.
+
+=head1 OPTIONS
+
+If there are any non-option arguments, they are taken to be
+names of objects to be saved (probably doesn't work properly yet).
+Without extra arguments, it saves the main program.
+
+=over 4
+
+=item B<-ofilename>
+
+Output to filename instead of STDOUT
+
+=item B<-v>
+
+Verbose compilation (currently gives a few compilation statistics).
+
+=item B<-->
+
+Force end of options
+
+=item B<-uPackname>
+
+Force apparently unused subs from package Packname to be compiled.
+This allows programs to use eval "foo()" even when sub foo is never
+seen to be used at compile time. The down side is that any subs which
+really are never used also have code generated. This option is
+necessary, for example, if you have a signal handler foo which you
+initialise with C<$SIG{BAR} = "foo">.  A better fix, though, is just
+to change it to C<$SIG{BAR} = \&foo>. You can have multiple B<-u>
+options. The compiler tries to figure out which packages may possibly
+have subs in which need compiling but the current version doesn't do
+it very well. In particular, it is confused by nested packages (i.e.
+of the form C<A::B>) where package C<A> does not contain any subs.
+
+=item B<-mModulename>
+
+Instead of generating source for a runnable executable, generate
+source for an XSUB module. The boot_Modulename function (which
+DynaLoader can look for) does the appropriate initialisation and runs
+the main part of the Perl source that is being compiled.
+
+
+=item B<-D>
+
+Debug options (concatenated or separate flags like C<perl -D>).
+
+=item B<-Dr>
+
+Writes debugging output to STDERR just as it's about to write to the
+program's runtime (otherwise writes debugging info as comments in
+its C output).
+
+=item B<-DO>
+
+Outputs each OP as it's compiled
+
+=item B<-Ds>
+
+Outputs the contents of the shadow stack at each OP
+
+=item B<-Dp>
+
+Outputs the contents of the shadow pad of lexicals as it's loaded for
+each sub or the main program.
+
+=item B<-Dq>
+
+Outputs the name of each fake PP function in the queue as it's about
+to process it.
+
+=item B<-Dl>
+
+Output the filename and line number of each original line of Perl
+code as it's processed (C<pp_nextstate>).
+
+=item B<-Dt>
+
+Outputs timing information of compilation stages.
+
+=item B<-f>
+
+Force optimisations on or off one at a time.
+
+=item B<-ffreetmps-each-bblock>
+
+Delays FREETMPS from the end of each statement to the end of the each
+basic block.
+
+=item B<-ffreetmps-each-loop>
+
+Delays FREETMPS from the end of each statement to the end of the group
+of basic blocks forming a loop. At most one of the freetmps-each-*
+options can be used.
+
+=item B<-fomit-taint>
+
+Omits generating code for handling perl's tainting mechanism.
+
+=item B<-On>
+
+Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>.
+Currently, B<-O1> sets B<-ffreetmps-each-bblock> and B<-O2>
+sets B<-ffreetmps-each-loop>.
+
+=back
+
+=head1 EXAMPLES
+
+        perl -MO=CC,-O2,-ofoo.c foo.pl
+        perl cc_harness -o foo foo.c
+
+Note that C<cc_harness> lives in the C<B> subdirectory of your perl
+library directory. The utility called C<perlcc> may also be used to
+help make use of this compiler.
+
+        perl -MO=CC,-mFoo,-oFoo.c Foo.pm
+        perl cc_harness -shared -c -o Foo.so Foo.c
+
+=head1 BUGS
+
+Plenty. Current status: experimental.
+
+=head1 DIFFERENCES
+
+These aren't really bugs but they are constructs which are heavily
+tied to perl's compile-and-go implementation and with which this
+compiler backend cannot cope.
+
+=head2 Loops
+
+Standard perl calculates the target of "next", "last", and "redo"
+at run-time. The compiler calculates the targets at compile-time.
+For example, the program
+
+    sub skip_on_odd { next NUMBER if $_[0] % 2 }
+    NUMBER: for ($i = 0; $i < 5; $i++) {
+        skip_on_odd($i);
+        print $i;
+    }
+
+produces the output
+
+    024
+
+with standard perl but gives a compile-time error with the compiler.
+
+=head2 Context of ".."
+
+The context (scalar or array) of the ".." operator determines whether
+it behaves as a range or a flip/flop. Standard perl delays until
+runtime the decision of which context it is in but the compiler needs
+to know the context at compile-time. For example,
+
+    @a = (4,6,1,0,0,1);
+    sub range { (shift @a)..(shift @a) }
+    print range();
+    while (@a) { print scalar(range()) }
+
+generates the output
+
+    456123E0
+
+with standard Perl but gives a compile-time error with compiled Perl.
+
+=head2 Arithmetic
+
+Compiled Perl programs use native C arithemtic much more frequently
+than standard perl. Operations on large numbers or on boundary
+cases may produce different behaviour.
+
+=head2 Deprecated features
+
+Features of standard perl such as C<$[> which have been deprecated
+in standard perl since Perl5 was released have not been implemented
+in the compiler.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Concise.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Concise.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Concise.pm	(revision 14265)
@@ -0,0 +1,823 @@
+package B::Concise;
+# Copyright (C) 2000, 2001 Stephen McCamant. All rights reserved.
+# This program is free software; you can redistribute and/or modify it
+# under the same terms as Perl itself.
+
+our $VERSION = "0.51";
+use strict;
+use B qw(class ppname main_start main_root main_cv cstring svref_2object
+	 SVf_IOK SVf_NOK SVf_POK OPf_KIDS);
+
+my %style = 
+  ("terse" =>
+   ["(?(#label =>\n)?)(*(    )*)#class (#addr) #name (?([#targ])?) "
+    . "#svclass~(?((#svaddr))?)~#svval~(?(label \"#coplabel\")?)\n",
+    "(*(    )*)goto #class (#addr)\n",
+    "#class pp_#name"],
+   "concise" =>
+   ["#hyphseq2 (*(   (x( ;)x))*)<#classsym> "
+    . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x)\n",
+    "  (*(    )*)     goto #seq\n",
+    "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"],
+   "linenoise" =>
+   ["(x(;(*( )*))x)#noise#arg(?([#targarg])?)(x( ;\n)x)",
+    "gt_#seq ",
+    "(?(#seq)?)#noise#arg(?([#targarg])?)"],
+   "debug" =>
+   ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
+    . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n\top_seq\t\t"
+    . "#seqnum\n\top_flags\t#flagval\n\top_private\t#privval\n"
+    . "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
+    . "(?(\top_sv\t\t#svaddr\n)?)",
+    "    GOTO #addr\n",
+    "#addr"],
+   "env" => [$ENV{B_CONCISE_FORMAT}, $ENV{B_CONCISE_GOTO_FORMAT},
+	     $ENV{B_CONCISE_TREE_FORMAT}],
+  );
+
+my($format, $gotofmt, $treefmt);
+my $curcv;
+my($seq_base, $cop_seq_base);
+
+sub concise_cv {
+    my ($order, $cvref) = @_;
+    my $cv = svref_2object($cvref);
+    $curcv = $cv;
+    if ($order eq "exec") {
+	walk_exec($cv->START);
+    } elsif ($order eq "basic") {
+	walk_topdown($cv->ROOT, sub { $_[0]->concise($_[1]) }, 0);
+    } else {
+	print tree($cv->ROOT, 0)
+    }
+}
+
+my $start_sym = "\e(0"; # "\cN" sometimes also works
+my $end_sym   = "\e(B"; # "\cO" respectively
+
+my @tree_decorations = 
+  (["  ", "--", "+-", "|-", "| ", "`-", "-", 1],
+   [" ", "-", "+", "+", "|", "`", "", 0],
+   ["  ", map("$start_sym$_$end_sym", "qq", "wq", "tq", "x ", "mq", "q"), 1],
+   [" ", map("$start_sym$_$end_sym", "q", "w", "t", "x", "m"), "", 0],
+  );
+my $tree_style = 0;
+
+my $base = 36;
+my $big_endian = 1;
+
+my $order = "basic";
+
+sub compile {
+    my @options = grep(/^-/, @_);
+    my @args = grep(!/^-/, @_);
+    my $do_main = 0;
+    ($format, $gotofmt, $treefmt) = @{$style{"concise"}};
+    for my $o (@options) {
+	if ($o eq "-basic") {
+	    $order = "basic";
+	} elsif ($o eq "-exec") {
+	    $order = "exec";
+	} elsif ($o eq "-tree") {
+	    $order = "tree";
+	} elsif ($o eq "-compact") {
+	    $tree_style |= 1;
+	} elsif ($o eq "-loose") {
+	    $tree_style &= ~1;
+	} elsif ($o eq "-vt") {
+	    $tree_style |= 2;
+	} elsif ($o eq "-ascii") {
+	    $tree_style &= ~2;
+	} elsif ($o eq "-main") {
+	    $do_main = 1;
+	} elsif ($o =~ /^-base(\d+)$/) {
+	    $base = $1;
+	} elsif ($o eq "-bigendian") {
+	    $big_endian = 1;
+	} elsif ($o eq "-littleendian") {
+	    $big_endian = 0;
+	} elsif (exists $style{substr($o, 1)}) {
+	    ($format, $gotofmt, $treefmt) = @{$style{substr($o, 1)}};
+	} else {
+	    warn "Option $o unrecognized";
+	}
+    }
+    if (@args) {
+	return sub {
+	    for my $objname (@args) {
+		$objname = "main::" . $objname unless $objname =~ /::/;
+		eval "concise_cv(\$order, \\&$objname)";
+		die "concise_cv($order, \\&$objname) failed: $@" if $@;
+	    }
+	}
+    }
+    if (!@args or $do_main) {
+	if ($order eq "exec") {
+	    return sub { return if class(main_start) eq "NULL";
+			 $curcv = main_cv;
+			 walk_exec(main_start) }
+	} elsif ($order eq "tree") {
+	    return sub { return if class(main_root) eq "NULL";
+			 $curcv = main_cv;
+			 print tree(main_root, 0) }
+	} elsif ($order eq "basic") {
+	    return sub { return if class(main_root) eq "NULL";
+			 $curcv = main_cv;
+			 walk_topdown(main_root,
+				      sub { $_[0]->concise($_[1]) }, 0); }
+	}
+    }
+}
+
+my %labels;
+my $lastnext;
+
+my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|",
+	       'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*",
+	       'PVOP' => '"', 'LOOP' => "{", 'COP' => ";");
+
+my @linenoise =
+  qw'#  () sc (  @? 1  $* gv *{ m$ m@ m% m? p/ *$ $  $# & a& pt \\ s\\ rf bl
+     `  *? <> ?? ?/ r/ c/ // qr s/ /c y/ =  @= C  sC Cp sp df un BM po +1 +I
+     -1 -I 1+ I+ 1- I- ** *  i* /  i/ %$ i% x  +  i+ -  i- .  "  << >> <  i<
+     >  i> <= i, >= i. == i= != i! <? i? s< s> s, s. s= s! s? b& b^ b| -0 -i
+     !  ~  a2 si cs rd sr e^ lg sq in %x %o ab le ss ve ix ri sf FL od ch cy
+     uf lf uc lc qm @  [f [  @[ eh vl ky dl ex %  ${ @{ uk pk st jn )  )[ a@
+     a% sl +] -] [- [+ so rv GS GW MS MW .. f. .f && || ^^ ?: &= |= -> s{ s}
+     v} ca wa di rs ;; ;  ;d }{ {  }  {} f{ it {l l} rt }l }n }r dm }g }e ^o
+     ^c ^| ^# um bm t~ u~ ~d DB db ^s se ^g ^r {w }w pf pr ^O ^K ^R ^W ^d ^v
+     ^e ^t ^k t. fc ic fl .s .p .b .c .l .a .h g1 s1 g2 s2 ?. l? -R -W -X -r
+     -w -x -e -o -O -z -s -M -A -C -S -c -b -f -d -p -l -u -g -k -t -T -B cd
+     co cr u. cm ut r. l@ s@ r@ mD uD oD rD tD sD wD cD f$ w$ p$ sh e$ k$ g3
+     g4 s4 g5 s5 T@ C@ L@ G@ A@ S@ Hg Hc Hr Hw Mg Mc Ms Mr Sg Sc So rq do {e
+     e} {t t} g6 G6 6e g7 G7 7e g8 G8 8e g9 G9 9e 6s 7s 8s 9s 6E 7E 8E 9E Pn
+     Pu GP SP EP Gn Gg GG SG EG g0 c$ lk t$ ;s n>';
+
+my $chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
+
+sub op_flags {
+    my($x) = @_;
+    my(@v);
+    push @v, "v" if ($x & 3) == 1;
+    push @v, "s" if ($x & 3) == 2;
+    push @v, "l" if ($x & 3) == 3;
+    push @v, "K" if $x & 4;
+    push @v, "P" if $x & 8;
+    push @v, "R" if $x & 16;
+    push @v, "M" if $x & 32;
+    push @v, "S" if $x & 64;
+    push @v, "*" if $x & 128;
+    return join("", @v);
+}
+
+sub base_n {
+    my $x = shift;
+    return "-" . base_n(-$x) if $x < 0;
+    my $str = "";
+    do { $str .= substr($chars, $x % $base, 1) } while $x = int($x / $base);
+    $str = reverse $str if $big_endian;
+    return $str;
+}
+
+sub seq { return $_[0]->seq ? base_n($_[0]->seq - $seq_base) : "-" }
+
+sub walk_topdown {
+    my($op, $sub, $level) = @_;
+    $sub->($op, $level);
+    if ($op->flags & OPf_KIDS) {
+	for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
+	    walk_topdown($kid, $sub, $level + 1);
+	}
+    }
+    if (class($op) eq "PMOP" and $ {$op->pmreplroot}
+	and $op->pmreplroot->isa("B::OP")) {
+	walk_topdown($op->pmreplroot, $sub, $level + 1);
+    }
+}
+
+sub walklines {
+    my($ar, $level) = @_;
+    for my $l (@$ar) {
+	if (ref($l) eq "ARRAY") {
+	    walklines($l, $level + 1);
+	} else {
+	    $l->concise($level);
+	}
+    }
+}
+
+sub walk_exec {
+    my($top, $level) = @_;
+    my %opsseen;
+    my @lines;
+    my @todo = ([$top, \@lines]);
+    while (@todo and my($op, $targ) = @{shift @todo}) {
+	for (; $$op; $op = $op->next) {
+	    last if $opsseen{$$op}++;
+	    push @$targ, $op;
+	    my $name = $op->name;
+	    if ($name
+		=~ /^(or|and|(map|grep)while|entertry|range|cond_expr)$/) {
+		my $ar = [];
+		push @$targ, $ar;
+		push @todo, [$op->other, $ar];
+	    } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
+		my $ar = [];
+		push @$targ, $ar;
+		push @todo, [$op->pmreplstart, $ar];
+	    } elsif ($name =~ /^enter(loop|iter)$/) {
+		$labels{$op->nextop->seq} = "NEXT";
+		$labels{$op->lastop->seq} = "LAST";
+		$labels{$op->redoop->seq} = "REDO";		
+	    }
+	}
+    }
+    walklines(\@lines, 0);
+}
+
+sub fmt_line {
+    my($hr, $fmt, $level) = @_;
+    my $text = $fmt;
+    $text =~ s/\(\?\(([^\#]*?)\#(\w+)([^\#]*?)\)\?\)/
+      $hr->{$2} ? $1.$hr->{$2}.$3 : ""/eg;
+    $text =~ s/\(x\((.*?);(.*?)\)x\)/$order eq "exec" ? $1 : $2/egs;
+    $text =~ s/\(\*\(([^;]*?)\)\*\)/$1 x $level/egs;
+    $text =~ s/\(\*\((.*?);(.*?)\)\*\)/$1 x ($level - 1) . $2 x ($level>0)/egs;
+    $text =~ s/#([a-zA-Z]+)(\d+)/sprintf("%-$2s", $hr->{$1})/eg;
+    $text =~ s/#([a-zA-Z]+)/$hr->{$1}/eg;
+    $text =~ s/[ \t]*~+[ \t]*/ /g;
+    return $text;
+}
+
+my %priv;
+$priv{$_}{128} = "LVINTRO"
+  for ("pos", "substr", "vec", "threadsv", "gvsv", "rv2sv", "rv2hv", "rv2gv",
+       "rv2av", "rv2arylen", "aelem", "helem", "aslice", "hslice", "padsv",
+       "padav", "padhv");
+$priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite");
+$priv{"aassign"}{64} = "COMMON";
+$priv{"aassign"}{32} = "PHASH";
+$priv{"sassign"}{64} = "BKWARD";
+$priv{$_}{64} = "RTIME" for ("match", "subst", "substcont");
+@{$priv{"trans"}}{1,2,4,8,16,64} = ("<UTF", ">UTF", "IDENT", "SQUASH", "DEL",
+				    "COMPL", "GROWS");
+$priv{"repeat"}{64} = "DOLIST";
+$priv{"leaveloop"}{64} = "CONT";
+@{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
+  for ("entersub", map("rv2${_}v", "a", "s", "h", "g"), "aelem", "helem");
+$priv{"entersub"}{16} = "DBG";
+$priv{"entersub"}{32} = "TARG";
+@{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv");
+$priv{"gv"}{32} = "EARLYCV";
+$priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER";
+$priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv");
+$priv{$_}{16} = "TARGMY"
+  for (map(($_,"s$_"),"chop", "chomp"),
+       map(($_,"i_$_"), "postinc", "postdec", "multiply", "divide", "modulo",
+	   "add", "subtract", "negate"), "pow", "concat", "stringify",
+       "left_shift", "right_shift", "bit_and", "bit_xor", "bit_or",
+       "complement", "atan2", "sin", "cos", "rand", "exp", "log", "sqrt",
+       "int", "hex", "oct", "abs", "length", "index", "rindex", "sprintf",
+       "ord", "chr", "crypt", "quotemeta", "join", "push", "unshift", "flock",
+       "chdir", "chown", "chroot", "unlink", "chmod", "utime", "rename",
+       "link", "symlink", "mkdir", "rmdir", "wait", "waitpid", "system",
+       "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority",
+       "setpriority", "time", "sleep");
+@{$priv{"const"}}{8,16,32,64,128} = ("STRICT","ENTERED", "$[", "BARE", "WARN");
+$priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM";
+$priv{"list"}{64} = "GUESSED";
+$priv{"delete"}{64} = "SLICE";
+$priv{"exists"}{64} = "SUB";
+$priv{$_}{64} = "LOCALE"
+  for ("sort", "prtf", "sprintf", "slt", "sle", "seq", "sne", "sgt", "sge",
+       "scmp", "lc", "uc", "lcfirst", "ucfirst");
+@{$priv{"sort"}}{1,2,4} = ("NUM", "INT", "REV");
+$priv{"threadsv"}{64} = "SVREFd";
+$priv{$_}{16} = "INBIN" for ("open", "backtick");
+$priv{$_}{32} = "INCR" for ("open", "backtick");
+$priv{$_}{64} = "OUTBIN" for ("open", "backtick");
+$priv{$_}{128} = "OUTCR" for ("open", "backtick");
+$priv{"exit"}{128} = "VMS";
+
+sub private_flags {
+    my($name, $x) = @_;
+    my @s;
+    for my $flag (128, 96, 64, 32, 16, 8, 4, 2, 1) {
+	if ($priv{$name}{$flag} and $x & $flag and $x >= $flag) {
+	    $x -= $flag;
+	    push @s, $priv{$name}{$flag};
+	}
+    }
+    push @s, $x if $x;
+    return join(",", @s);
+}
+
+sub concise_op {
+    my ($op, $level, $format) = @_;
+    my %h;
+    $h{exname} = $h{name} = $op->name;
+    $h{NAME} = uc $h{name};
+    $h{class} = class($op);
+    $h{extarg} = $h{targ} = $op->targ;
+    $h{extarg} = "" unless $h{extarg};
+    if ($h{name} eq "null" and $h{targ}) {
+	$h{exname} = "ex-" . substr(ppname($h{targ}), 3);
+	$h{extarg} = "";
+    } elsif ($h{targ}) {
+	my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}];
+	if (defined $padname and class($padname) ne "SPECIAL") {
+	    $h{targarg}  = $padname->PVX;
+	    my $intro = $padname->NVX - $cop_seq_base;
+	    my $finish = int($padname->IVX) - $cop_seq_base;
+	    $finish = "end" if $finish == 999999999 - $cop_seq_base;
+	    $h{targarglife} = "$h{targarg}:$intro,$finish";
+	} else {
+	    $h{targarglife} = $h{targarg} = "t" . $h{targ};
+	}
+    }
+    $h{arg} = "";
+    $h{svclass} = $h{svaddr} = $h{svval} = "";
+    if ($h{class} eq "PMOP") {
+	my $precomp = $op->precomp;
+	$precomp = defined($precomp) ? "/$precomp/" : "";
+	my $pmreplroot = $op->pmreplroot;
+	my ($pmreplroot, $pmreplstart);
+	if ($ {$pmreplroot = $op->pmreplroot} && $pmreplroot->isa("B::GV")) {
+	    # with C<@stash_array = split(/pat/, str);>,
+	    #  *stash_array is stored in pmreplroot.
+	    $h{arg} = "($precomp => \@" . $pmreplroot->NAME . ")";
+	} elsif ($ {$op->pmreplstart}) {
+	    undef $lastnext;
+	    $pmreplstart = "replstart->" . seq($op->pmreplstart);
+	    $h{arg} = "(" . join(" ", $precomp, $pmreplstart) . ")";
+	} else {
+	    $h{arg} = "($precomp)";
+	}
+    } elsif ($h{class} eq "PVOP" and $h{name} ne "trans") {
+	$h{arg} = '("' . $op->pv . '")';
+	$h{svval} = '"' . $op->pv . '"';
+    } elsif ($h{class} eq "COP") {
+	my $label = $op->label;
+	$h{coplabel} = $label;
+	$label = $label ? "$label: " : "";
+	my $loc = $op->file;
+	$loc =~ s[.*/][];
+	$loc .= ":" . $op->line;
+	my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base);
+	my $arybase = $op->arybase;
+	$arybase = $arybase ? ' $[=' . $arybase : "";
+	$h{arg} = "($label$stash $cseq $loc$arybase)";
+    } elsif ($h{class} eq "LOOP") {
+	$h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop)
+	  . " redo->" . seq($op->redoop) . ")";
+    } elsif ($h{class} eq "LOGOP") {
+	undef $lastnext;
+	$h{arg} = "(other->" . seq($op->other) . ")";
+    } elsif ($h{class} eq "SVOP") {
+	my $sv = $op->sv;
+	$h{svclass} = class($sv);
+	$h{svaddr} = sprintf("%#x", $$sv);
+	if ($h{svclass} eq "GV") {
+	    my $gv = $sv;
+	    my $stash = $gv->STASH->NAME;
+	    if ($stash eq "main") {
+		$stash = "";
+	    } else {
+		$stash = $stash . "::";
+	    }
+	    $h{arg} = "(*$stash" . $gv->SAFENAME . ")";
+	    $h{svval} = "*$stash" . $gv->SAFENAME;
+	} else {
+	    while (class($sv) eq "RV") {
+		$h{svval} .= "\\";
+		$sv = $sv->RV;
+	    }
+	    if (class($sv) eq "SPECIAL") {
+		$h{svval} = ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];
+	    } elsif ($sv->FLAGS & SVf_NOK) {
+		$h{svval} = $sv->NV;
+	    } elsif ($sv->FLAGS & SVf_IOK) {
+		$h{svval} = $sv->IV;
+	    } elsif ($sv->FLAGS & SVf_POK) {
+		$h{svval} = cstring($sv->PV);
+	    }
+	    $h{arg} = "($h{svclass} $h{svval})";
+	}
+    }
+    $h{seq} = $h{hyphseq} = seq($op);
+    $h{seq} = "" if $h{seq} eq "-";
+    $h{seqnum} = $op->seq;
+    $h{next} = $op->next;
+    $h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next});
+    $h{nextaddr} = sprintf("%#x", $ {$op->next});
+    $h{sibaddr} = sprintf("%#x", $ {$op->sibling});
+    $h{firstaddr} = sprintf("%#x", $ {$op->first}) if $op->can("first");
+    $h{lastaddr} = sprintf("%#x", $ {$op->last}) if $op->can("last");
+
+    $h{classsym} = $opclass{$h{class}};
+    $h{flagval} = $op->flags;
+    $h{flags} = op_flags($op->flags);
+    $h{privval} = $op->private;
+    $h{private} = private_flags($h{name}, $op->private);
+    $h{addr} = sprintf("%#x", $$op);
+    $h{label} = $labels{$op->seq};
+    $h{typenum} = $op->type;
+    $h{noise} = $linenoise[$op->type];
+    return fmt_line(\%h, $format, $level);
+}
+
+sub B::OP::concise {
+    my($op, $level) = @_;
+    if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
+	my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
+		 "addr" => sprintf("%#x", $$lastnext)};
+	print fmt_line($h, $gotofmt, $level+1);
+    }
+    $lastnext = $op->next;
+    print concise_op($op, $level, $format);
+}
+
+sub tree {
+    my $op = shift;
+    my $level = shift;
+    my $style = $tree_decorations[$tree_style];
+    my($space, $single, $kids, $kid, $nokid, $last, $lead, $size) = @$style;
+    my $name = concise_op($op, $level, $treefmt);
+    if (not $op->flags & OPf_KIDS) {
+	return $name . "\n";
+    }
+    my @lines;
+    for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
+	push @lines, tree($kid, $level+1);
+    }
+    my $i;
+    for ($i = $#lines; substr($lines[$i], 0, 1) eq " "; $i--) {
+	$lines[$i] = $space . $lines[$i];
+    }
+    if ($i > 0) {
+	$lines[$i] = $last . $lines[$i];
+	while ($i-- > 1) {
+	    if (substr($lines[$i], 0, 1) eq " ") {
+		$lines[$i] = $nokid . $lines[$i];
+	    } else {
+		$lines[$i] = $kid . $lines[$i];		
+	    }
+	}
+	$lines[$i] = $kids . $lines[$i];
+    } else {
+	$lines[0] = $single . $lines[0];
+    }
+    return("$name$lead" . shift @lines,
+           map(" " x (length($name)+$size) . $_, @lines));
+}
+
+# This is a bit of a hack; the 2 and 15 were determined empirically.
+# These need to stay the last things in the module.
+$cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + 2;
+$seq_base = svref_2object(eval 'sub{}')->START->seq + 15;
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Concise - Walk Perl syntax tree, printing concise info about ops
+
+=head1 SYNOPSIS
+
+    perl -MO=Concise[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This compiler backend prints the internal OPs of a Perl program's syntax
+tree in one of several space-efficient text formats suitable for debugging
+the inner workings of perl or other compiler backends. It can print OPs in
+the order they appear in the OP tree, in the order they will execute, or
+in a text approximation to their tree structure, and the format of the
+information displyed is customizable. Its function is similar to that of
+perl's B<-Dx> debugging flag or the B<B::Terse> module, but it is more
+sophisticated and flexible.
+
+=head1 OPTIONS
+
+Arguments that don't start with a hyphen are taken to be the names of
+subroutines to print the OPs of; if no such functions are specified, the
+main body of the program (outside any subroutines, and not including use'd
+or require'd files) is printed.
+
+=over 4
+
+=item B<-basic>
+
+Print OPs in the order they appear in the OP tree (a preorder
+traversal, starting at the root). The indentation of each OP shows its
+level in the tree.  This mode is the default, so the flag is included
+simply for completeness.
+
+=item B<-exec>
+
+Print OPs in the order they would normally execute (for the majority
+of constructs this is a postorder traversal of the tree, ending at the
+root). In most cases the OP that usually follows a given OP will
+appear directly below it; alternate paths are shown by indentation. In
+cases like loops when control jumps out of a linear path, a 'goto'
+line is generated.
+
+=item B<-tree>
+
+Print OPs in a text approximation of a tree, with the root of the tree
+at the left and 'left-to-right' order of children transformed into
+'top-to-bottom'. Because this mode grows both to the right and down,
+it isn't suitable for large programs (unless you have a very wide
+terminal).
+
+=item B<-compact>
+
+Use a tree format in which the minimum amount of space is used for the
+lines connecting nodes (one character in most cases). This squeezes out
+a few precious columns of screen real estate.
+
+=item B<-loose>
+
+Use a tree format that uses longer edges to separate OP nodes. This format
+tends to look better than the compact one, especially in ASCII, and is
+the default.
+
+=item B<-vt>
+
+Use tree connecting characters drawn from the VT100 line-drawing set.
+This looks better if your terminal supports it.
+
+=item B<-ascii>
+
+Draw the tree with standard ASCII characters like C<+> and C<|>. These don't
+look as clean as the VT100 characters, but they'll work with almost any
+terminal (or the horizontal scrolling mode of less(1)) and are suitable
+for text documentation or email. This is the default.
+
+=item B<-main>
+
+Include the main program in the output, even if subroutines were also
+specified.
+
+=item B<-base>I<n>
+
+Print OP sequence numbers in base I<n>. If I<n> is greater than 10, the
+digit for 11 will be 'a', and so on. If I<n> is greater than 36, the digit
+for 37 will be 'A', and so on until 62. Values greater than 62 are not
+currently supported. The default is 36.
+
+=item B<-bigendian>
+
+Print sequence numbers with the most significant digit first. This is the
+usual convention for Arabic numerals, and the default.
+
+=item B<-littleendian>
+
+Print seqence numbers with the least significant digit first.
+
+=item B<-concise>
+
+Use the author's favorite set of formatting conventions. This is the
+default, of course.
+
+=item B<-terse>
+
+Use formatting conventions that emulate the ouput of B<B::Terse>. The
+basic mode is almost indistinguishable from the real B<B::Terse>, and the
+exec mode looks very similar, but is in a more logical order and lacks
+curly brackets. B<B::Terse> doesn't have a tree mode, so the tree mode
+is only vaguely reminiscient of B<B::Terse>.
+
+=item B<-linenoise>
+
+Use formatting conventions in which the name of each OP, rather than being
+written out in full, is represented by a one- or two-character abbreviation.
+This is mainly a joke.
+
+=item B<-debug>
+
+Use formatting conventions reminiscient of B<B::Debug>; these aren't
+very concise at all.
+
+=item B<-env>
+
+Use formatting conventions read from the environment variables
+C<B_CONCISE_FORMAT>, C<B_CONCISE_GOTO_FORMAT>, and C<B_CONCISE_TREE_FORMAT>.
+
+=back
+
+=head1 FORMATTING SPECIFICATIONS
+
+For each general style ('concise', 'terse', 'linenoise', etc.) there are
+three specifications: one of how OPs should appear in the basic or exec
+modes, one of how 'goto' lines should appear (these occur in the exec
+mode only), and one of how nodes should appear in tree mode. Each has the
+same format, described below. Any text that doesn't match a special
+pattern is copied verbatim.
+
+=over 4
+
+=item B<(x(>I<exec_text>B<;>I<basic_text>B<)x)>
+
+Generates I<exec_text> in exec mode, or I<basic_text> in basic mode.
+
+=item B<(*(>I<text>B<)*)>
+
+Generates one copy of I<text> for each indentation level.
+
+=item B<(*(>I<text1>B<;>I<text2>B<)*)>
+
+Generates one fewer copies of I<text1> than the indentation level, followed
+by one copy of I<text2> if the indentation level is more than 0.
+
+=item B<(?(>I<text1>B<#>I<var>I<Text2>B<)?)>
+
+If the value of I<var> is true (not empty or zero), generates the
+value of I<var> surrounded by I<text1> and I<Text2>, otherwise
+nothing.
+
+=item B<#>I<var>
+
+Generates the value of the variable I<var>.
+
+=item B<#>I<var>I<N>
+
+Generates the value of I<var>, left jutified to fill I<N> spaces.
+
+=item B<~>
+
+Any number of tildes and surrounding whitespace will be collapsed to
+a single space.
+
+=back
+
+The following variables are recognized:
+
+=over 4
+
+=item B<#addr>
+
+The address of the OP, in hexidecimal.
+
+=item B<#arg>
+
+The OP-specific information of the OP (such as the SV for an SVOP, the
+non-local exit pointers for a LOOP, etc.) enclosed in paretheses.
+
+=item B<#class>
+
+The B-determined class of the OP, in all caps.
+
+=item B<#classym>
+
+A single symbol abbreviating the class of the OP.
+
+=item B<#coplabel>
+
+The label of the statement or block the OP is the start of, if any.
+
+=item B<#exname>
+
+The name of the OP, or 'ex-foo' if the OP is a null that used to be a foo.
+
+=item B<#extarg>
+
+The target of the OP, or nothing for a nulled OP.
+
+=item B<#firstaddr>
+
+The address of the OP's first child, in hexidecimal.
+
+=item B<#flags>
+
+The OP's flags, abbreviated as a series of symbols.
+
+=item B<#flagval>
+
+The numeric value of the OP's flags.
+
+=item B<#hyphenseq>
+
+The sequence number of the OP, or a hyphen if it doesn't have one.
+
+=item B<#label>
+
+'NEXT', 'LAST', or 'REDO' if the OP is a target of one of those in exec
+mode, or empty otherwise.
+
+=item B<#lastaddr>
+
+The address of the OP's last child, in hexidecimal.
+
+=item B<#name>
+
+The OP's name.
+
+=item B<#NAME>
+
+The OP's name, in all caps.
+
+=item B<#next>
+
+The sequence number of the OP's next OP.
+
+=item B<#nextaddr>
+
+The address of the OP's next OP, in hexidecimal.
+
+=item B<#noise>
+
+The two-character abbreviation for the OP's name.
+
+=item B<#private>
+
+The OP's private flags, rendered with abbreviated names if possible.
+
+=item B<#privval>
+
+The numeric value of the OP's private flags.
+
+=item B<#seq>
+
+The sequence number of the OP.
+
+=item B<#seqnum>
+
+The real sequence number of the OP, as a regular number and not adjusted
+to be relative to the start of the real program. (This will generally be
+a fairly large number because all of B<B::Concise> is compiled before
+your program is).
+
+=item B<#sibaddr>
+
+The address of the OP's next youngest sibling, in hexidecimal.
+
+=item B<#svaddr>
+
+The address of the OP's SV, if it has an SV, in hexidecimal.
+
+=item B<#svclass>
+
+The class of the OP's SV, if it has one, in all caps (e.g., 'IV').
+
+=item B<#svval>
+
+The value of the OP's SV, if it has one, in a short human-readable format.
+
+=item B<#targ>
+
+The numeric value of the OP's targ.
+
+=item B<#targarg>
+
+The name of the variable the OP's targ refers to, if any, otherwise the
+letter t followed by the OP's targ in decimal.
+
+=item B<#targarglife>
+
+Same as B<#targarg>, but followed by the COP sequence numbers that delimit
+the variable's lifetime (or 'end' for a variable in an open scope) for a
+variable.
+
+=item B<#typenum>
+
+The numeric value of the OP's type, in decimal.
+
+=back
+
+=head1 ABBREVIATIONS
+
+=head2 OP flags abbreviations
+
+    v      OPf_WANT_VOID    Want nothing (void context)
+    s      OPf_WANT_SCALAR  Want single value (scalar context)
+    l      OPf_WANT_LIST    Want list of any length (list context)
+    K      OPf_KIDS         There is a firstborn child.
+    P      OPf_PARENS       This operator was parenthesized.
+                             (Or block needs explicit scope entry.)
+    R      OPf_REF          Certified reference.
+                             (Return container, not containee).
+    M      OPf_MOD          Will modify (lvalue).
+    S      OPf_STACKED      Some arg is arriving on the stack.
+    *      OPf_SPECIAL      Do something weird for this op (see op.h)
+
+=head2 OP class abbreviations
+
+    0      OP (aka BASEOP)  An OP with no children
+    1      UNOP             An OP with one child
+    2      BINOP            An OP with two children
+    |      LOGOP            A control branch OP
+    @      LISTOP           An OP that could have lots of children
+    /      PMOP             An OP with a regular expression
+    $      SVOP             An OP with an SV
+    "      PVOP             An OP with a string
+    {      LOOP             An OP that holds pointers for a loop
+    ;      COP              An OP that marks the start of a statement
+
+=head1 AUTHOR
+
+Stephen McCamant, C<smcc@CSUA.Berkeley.EDU>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Debug.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Debug.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Debug.pm	(revision 14265)
@@ -0,0 +1,283 @@
+package B::Debug;
+use strict;
+use B qw(peekop class walkoptree walkoptree_exec
+         main_start main_root cstring sv_undef);
+use B::Asmdata qw(@specialsv_name);
+
+my %done_gv;
+
+sub B::OP::debug {
+    my ($op) = @_;
+    printf <<'EOT', class($op), $$op, ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type, $op->seq, $op->flags, $op->private;
+%s (0x%lx)
+	op_next		0x%x
+	op_sibling	0x%x
+	op_ppaddr	%s
+	op_targ		%d
+	op_type		%d
+	op_seq		%d
+	op_flags	%d
+	op_private	%d
+EOT
+}
+
+sub B::UNOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_first\t0x%x\n", ${$op->first};
+}
+
+sub B::BINOP::debug {
+    my ($op) = @_;
+    $op->B::UNOP::debug();
+    printf "\top_last\t\t0x%x\n", ${$op->last};
+}
+
+sub B::LOOP::debug {
+    my ($op) = @_;
+    $op->B::BINOP::debug();
+    printf <<'EOT', ${$op->redoop}, ${$op->nextop}, ${$op->lastop};
+       op_redoop       0x%x
+       op_nextop       0x%x
+       op_lastop       0x%x
+EOT
+}
+
+sub B::LOGOP::debug {
+    my ($op) = @_;
+    $op->B::UNOP::debug();
+    printf "\top_other\t0x%x\n", ${$op->other};
+}
+
+sub B::LISTOP::debug {
+    my ($op) = @_;
+    $op->B::BINOP::debug();
+    printf "\top_children\t%d\n", $op->children;
+}
+
+sub B::PMOP::debug {
+    my ($op) = @_;
+    $op->B::LISTOP::debug();
+    printf "\top_pmreplroot\t0x%x\n", ${$op->pmreplroot};
+    printf "\top_pmreplstart\t0x%x\n", ${$op->pmreplstart};
+    printf "\top_pmnext\t0x%x\n", ${$op->pmnext};
+    printf "\top_pmregexp->precomp\t%s\n", cstring($op->precomp);
+    printf "\top_pmflags\t0x%x\n", $op->pmflags;
+    $op->pmreplroot->debug;
+}
+
+sub B::COP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf <<'EOT', $op->label, $op->stashpv, $op->file, $op->seq, $op->arybase, $op->line, ${$op->warnings};
+	cop_label	%s
+	cop_stashpv	%s
+	cop_file	%s
+	cop_seq		%d
+	cop_arybase	%d
+	cop_line	%d
+	cop_warnings	0x%x
+EOT
+}
+
+sub B::SVOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_sv\t\t0x%x\n", ${$op->sv};
+    $op->sv->debug;
+}
+
+sub B::PVOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_pv\t\t0x%x\n", $op->pv;
+}
+
+sub B::PADOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_padix\t\t%ld\n", $op->padix;
+}
+
+sub B::CVOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_cv\t\t0x%x\n", ${$op->cv};
+}
+
+sub B::NULL::debug {
+    my ($sv) = @_;
+    if ($$sv == ${sv_undef()}) {
+	print "&sv_undef\n";
+    } else {
+	printf "NULL (0x%x)\n", $$sv;
+    }
+}
+
+sub B::SV::debug {
+    my ($sv) = @_;
+    if (!$$sv) {
+	print class($sv), " = NULL\n";
+	return;
+    }
+    printf <<'EOT', class($sv), $$sv, $sv->REFCNT, $sv->FLAGS;
+%s (0x%x)
+	REFCNT		%d
+	FLAGS		0x%x
+EOT
+}
+
+sub B::PV::debug {
+    my ($sv) = @_;
+    $sv->B::SV::debug();
+    my $pv = $sv->PV();
+    printf <<'EOT', cstring($pv), length($pv);
+	xpv_pv		%s
+	xpv_cur		%d
+EOT
+}
+
+sub B::IV::debug {
+    my ($sv) = @_;
+    $sv->B::SV::debug();
+    printf "\txiv_iv\t\t%d\n", $sv->IV;
+}
+
+sub B::NV::debug {
+    my ($sv) = @_;
+    $sv->B::IV::debug();
+    printf "\txnv_nv\t\t%s\n", $sv->NV;
+}
+
+sub B::PVIV::debug {
+    my ($sv) = @_;
+    $sv->B::PV::debug();
+    printf "\txiv_iv\t\t%d\n", $sv->IV;
+}
+
+sub B::PVNV::debug {
+    my ($sv) = @_;
+    $sv->B::PVIV::debug();
+    printf "\txnv_nv\t\t%s\n", $sv->NV;
+}
+
+sub B::PVLV::debug {
+    my ($sv) = @_;
+    $sv->B::PVNV::debug();
+    printf "\txlv_targoff\t%d\n", $sv->TARGOFF;
+    printf "\txlv_targlen\t%u\n", $sv->TARGLEN;
+    printf "\txlv_type\t%s\n", cstring(chr($sv->TYPE));
+}
+
+sub B::BM::debug {
+    my ($sv) = @_;
+    $sv->B::PVNV::debug();
+    printf "\txbm_useful\t%d\n", $sv->USEFUL;
+    printf "\txbm_previous\t%u\n", $sv->PREVIOUS;
+    printf "\txbm_rare\t%s\n", cstring(chr($sv->RARE));
+}
+
+sub B::CV::debug {
+    my ($sv) = @_;
+    $sv->B::PVNV::debug();
+    my ($stash) = $sv->STASH;
+    my ($start) = $sv->START;
+    my ($root) = $sv->ROOT;
+    my ($padlist) = $sv->PADLIST;
+    my ($file) = $sv->FILE;
+    my ($gv) = $sv->GV;
+    printf <<'EOT', $$stash, $$start, $$root, $$gv, $file, $sv->DEPTH, $padlist, ${$sv->OUTSIDE};
+	STASH		0x%x
+	START		0x%x
+	ROOT		0x%x
+	GV		0x%x
+	FILE		%s
+	DEPTH		%d
+	PADLIST		0x%x			       
+	OUTSIDE		0x%x
+EOT
+    $start->debug if $start;
+    $root->debug if $root;
+    $gv->debug if $gv;
+    $padlist->debug if $padlist;
+}
+
+sub B::AV::debug {
+    my ($av) = @_;
+    $av->B::SV::debug;
+    my(@array) = $av->ARRAY;
+    print "\tARRAY\t\t(", join(", ", map("0x" . $$_, @array)), ")\n";
+    printf <<'EOT', scalar(@array), $av->MAX, $av->OFF, $av->AvFLAGS;
+	FILL		%d    
+	MAX		%d
+	OFF		%d
+	AvFLAGS		%d
+EOT
+}
+    
+sub B::GV::debug {
+    my ($gv) = @_;
+    if ($done_gv{$$gv}++) {
+	printf "GV %s::%s\n", $gv->STASH->NAME, $gv->SAFENAME;
+	return;
+    }
+    my ($sv) = $gv->SV;
+    my ($av) = $gv->AV;
+    my ($cv) = $gv->CV;
+    $gv->B::SV::debug;
+    printf <<'EOT', $gv->SAFENAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILE, $gv->GvFLAGS;
+	NAME		%s
+	STASH		%s (0x%x)
+	SV		0x%x
+	GvREFCNT	%d
+	FORM		0x%x
+	AV		0x%x
+	HV		0x%x
+	EGV		0x%x
+	CV		0x%x
+	CVGEN		%d
+	LINE		%d
+	FILE		%s
+	GvFLAGS		0x%x
+EOT
+    $sv->debug if $sv;
+    $av->debug if $av;
+    $cv->debug if $cv;
+}
+
+sub B::SPECIAL::debug {
+    my $sv = shift;
+    print $specialsv_name[$$sv], "\n";
+}
+
+sub compile {
+    my $order = shift;
+    B::clearsym();
+    if ($order && $order eq "exec") {
+        return sub { walkoptree_exec(main_start, "debug") }
+    } else {
+        return sub { walkoptree(main_root, "debug") }
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Debug - Walk Perl syntax tree, printing debug info about ops
+
+=head1 SYNOPSIS
+
+	perl -MO=Debug[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+See F<ext/B/README>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Deparse.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Deparse.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Deparse.pm	(revision 14265)
@@ -0,0 +1,3128 @@
+# B::Deparse.pm
+# Copyright (c) 1998, 1999, 2000 Stephen McCamant. All rights reserved.
+# This module is free software; you can redistribute and/or modify
+# it under the same terms as Perl itself.
+
+# This is based on the module of the same name by Malcolm Beattie,
+# but essentially none of his code remains.
+
+package B::Deparse;
+use Carp 'cluck', 'croak';
+use B qw(class main_root main_start main_cv svref_2object opnumber
+	 OPf_WANT OPf_WANT_VOID OPf_WANT_SCALAR OPf_WANT_LIST
+	 OPf_KIDS OPf_REF OPf_STACKED OPf_SPECIAL
+	 OPpLVAL_INTRO OPpENTERSUB_AMPER OPpSLICE OPpCONST_BARE
+	 OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY
+	 SVf_IOK SVf_NOK SVf_ROK SVf_POK
+         CVf_METHOD CVf_LOCKED CVf_LVALUE
+	 PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE
+	 PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED);
+$VERSION = 0.60;
+use strict;
+
+# Changes between 0.50 and 0.51:
+# - fixed nulled leave with live enter in sort { }
+# - fixed reference constants (\"str")
+# - handle empty programs gracefully
+# - handle infinte loops (for (;;) {}, while (1) {})
+# - differentiate between `for my $x ...' and `my $x; for $x ...'
+# - various minor cleanups
+# - moved globals into an object
+# - added `-u', like B::C
+# - package declarations using cop_stash
+# - subs, formats and code sorted by cop_seq
+# Changes between 0.51 and 0.52:
+# - added pp_threadsv (special variables under USE_THREADS)
+# - added documentation
+# Changes between 0.52 and 0.53:
+# - many changes adding precedence contexts and associativity
+# - added `-p' and `-s' output style options
+# - various other minor fixes
+# Changes between 0.53 and 0.54:
+# - added support for new `for (1..100)' optimization,
+#   thanks to Gisle Aas
+# Changes between 0.54 and 0.55:
+# - added support for new qr// construct
+# - added support for new pp_regcreset OP
+# Changes between 0.55 and 0.56:
+# - tested on base/*.t, cmd/*.t, comp/*.t, io/*.t
+# - fixed $# on non-lexicals broken in last big rewrite
+# - added temporary fix for change in opcode of OP_STRINGIFY
+# - fixed problem in 0.54's for() patch in `for (@ary)'
+# - fixed precedence in conditional of ?:
+# - tweaked list paren elimination in `my($x) = @_'
+# - made continue-block detection trickier wrt. null ops
+# - fixed various prototype problems in pp_entersub
+# - added support for sub prototypes that never get GVs
+# - added unquoting for special filehandle first arg in truncate
+# - print doubled rv2gv (a bug) as `*{*GV}' instead of illegal `**GV'
+# - added semicolons at the ends of blocks
+# - added -l `#line' declaration option -- fixes cmd/subval.t 27,28
+# Changes between 0.56 and 0.561:
+# - fixed multiply-declared my var in pp_truncate (thanks to Sarathy)
+# - used new B.pm symbolic constants (done by Nick Ing-Simmons)
+# Changes between 0.561 and 0.57:
+# - stylistic changes to symbolic constant stuff
+# - handled scope in s///e replacement code
+# - added unquote option for expanding "" into concats, etc.
+# - split method and proto parts of pp_entersub into separate functions
+# - various minor cleanups
+# Changes after 0.57:
+# - added parens in \&foo (patch by Albert Dvornik)
+# Changes between 0.57 and 0.58:
+# - fixed `0' statements that weren't being printed
+# - added methods for use from other programs
+#   (based on patches from James Duncan and Hugo van der Sanden)
+# - added -si and -sT to control indenting (also based on a patch from Hugo)
+# - added -sv to print something else instead of '???'
+# - preliminary version of utf8 tr/// handling
+# Changes after 0.58:
+# - uses of $op->ppaddr changed to new $op->name (done by Sarathy)
+# - added support for Hugo's new OP_SETSTATE (like nextstate) 
+# Changes between 0.58 and 0.59
+# - added support for Chip's OP_METHOD_NAMED
+# - added support for Ilya's OPpTARGET_MY optimization
+# - elided arrows before `()' subscripts when possible
+# Changes between 0.59 and 0.60
+# - support for method attribues was added
+# - some warnings fixed
+# - separate recognition of constant subs
+# - rewrote continue block handling, now recoginizing for loops
+# - added more control of expanding control structures
+
+# Todo:
+# - finish tr/// changes
+# - add option for even more parens (generalize \&foo change)
+# - {} around variables in strings ("${var}letters")
+#   base/lex.t 25-27
+#   comp/term.t 11
+# - left/right context
+# - recognize `use utf8', `use integer', etc
+# - treat top-level block specially for incremental output
+# - interpret high bit chars in string as utf8 \x{...} (when?)
+# - copy comments (look at real text with $^P?)
+# - avoid semis in one-statement blocks
+# - associativity of &&=, ||=, ?:
+# - ',' => '=>' (auto-unquote?)
+# - break long lines ("\r" as discretionary break?)
+# - configurable syntax highlighting: ANSI color, HTML, TeX, etc.
+# - more style options: brace style, hex vs. octal, quotes, ...
+# - print big ints as hex/octal instead of decimal (heuristic?)
+# - handle `my $x if 0'?
+# - include values of variables (e.g. set in BEGIN)
+# - coordinate with Data::Dumper (both directions? see previous)
+# - version using op_next instead of op_first/sibling?
+# - avoid string copies (pass arrays, one big join?)
+# - auto-apply `-u'?
+# - -uPackage:: descend recursively?
+# - here-docs?
+# - <DATA>?
+
+# Tests that will always fail:
+# comp/redef.t -- all (redefinition happens at compile time)
+
+# Object fields (were globals):
+#
+# avoid_local:
+# (local($a), local($b)) and local($a, $b) have the same internal
+# representation but the short form looks better. We notice we can
+# use a large-scale local when checking the list, but need to prevent
+# individual locals too. This hash holds the addresses of OPs that 
+# have already had their local-ness accounted for. The same thing
+# is done with my().
+#
+# curcv:
+# CV for current sub (or main program) being deparsed
+#
+# curstash:
+# name of the current package for deparsed code
+#
+# subs_todo:
+# array of [cop_seq, GV, is_format?] for subs and formats we still
+# want to deparse
+#
+# protos_todo:
+# as above, but [name, prototype] for subs that never got a GV
+#
+# subs_done, forms_done:
+# keys are addresses of GVs for subs and formats we've already
+# deparsed (or at least put into subs_todo)
+#
+# parens: -p
+# linenums: -l
+# unquote: -q
+# cuddle: ` ' or `\n', depending on -sC
+# indent_size: -si
+# use_tabs: -sT
+# ex_const: -sv
+
+# A little explanation of how precedence contexts and associativity
+# work:
+#
+# deparse() calls each per-op subroutine with an argument $cx (short
+# for context, but not the same as the cx* in the perl core), which is
+# a number describing the op's parents in terms of precedence, whether
+# they're inside an expression or at statement level, etc.  (see
+# chart below). When ops with children call deparse on them, they pass
+# along their precedence. Fractional values are used to implement
+# associativity (`($x + $y) + $z' => `$x + $y + $y') and related
+# parentheses hacks. The major disadvantage of this scheme is that
+# it doesn't know about right sides and left sides, so say if you
+# assign a listop to a variable, it can't tell it's allowed to leave
+# the parens off the listop.
+
+# Precedences:
+# 26             [TODO] inside interpolation context ("")
+# 25 left        terms and list operators (leftward)
+# 24 left        ->
+# 23 nonassoc    ++ --
+# 22 right       **
+# 21 right       ! ~ \ and unary + and -
+# 20 left        =~ !~
+# 19 left        * / % x
+# 18 left        + - .
+# 17 left        << >>
+# 16 nonassoc    named unary operators
+# 15 nonassoc    < > <= >= lt gt le ge
+# 14 nonassoc    == != <=> eq ne cmp
+# 13 left        &
+# 12 left        | ^
+# 11 left        &&
+# 10 left        ||
+#  9 nonassoc    ..  ...
+#  8 right       ?:
+#  7 right       = += -= *= etc.
+#  6 left        , =>
+#  5 nonassoc    list operators (rightward)
+#  4 right       not
+#  3 left        and
+#  2 left        or xor
+#  1             statement modifiers
+#  0             statement level
+
+# Nonprinting characters with special meaning:
+# \cS - steal parens (see maybe_parens_unop)
+# \n - newline and indent
+# \t - increase indent
+# \b - decrease indent (`outdent')
+# \f - flush left (no indent)
+# \cK - kill following semicolon, if any
+
+sub null {
+    my $op = shift;
+    return class($op) eq "NULL";
+}
+
+sub todo {
+    my $self = shift;
+    my($gv, $cv, $is_form) = @_;
+    my $seq;
+    if (!null($cv->START) and is_state($cv->START)) {
+	$seq = $cv->START->cop_seq;
+    } else {
+	$seq = 0;
+    }
+    push @{$self->{'subs_todo'}}, [$seq, $gv, $is_form];
+}
+
+sub next_todo {
+    my $self = shift;
+    my $ent = shift @{$self->{'subs_todo'}};
+    my $name = $self->gv_name($ent->[1]);
+    if ($ent->[2]) {
+	return "format $name =\n"
+	    . $self->deparse_format($ent->[1]->FORM). "\n";
+    } else {
+	return "sub $name " . $self->deparse_sub($ent->[1]->CV);
+    }
+}
+
+sub walk_tree {
+    my($op, $sub) = @_;
+    $sub->($op);
+    if ($op->flags & OPf_KIDS) {
+	my $kid;
+	for ($kid = $op->first; not null $kid; $kid = $kid->sibling) {
+	    walk_tree($kid, $sub);
+	}
+    }
+}
+
+sub walk_sub {
+    my $self = shift;
+    my $cv = shift;
+    my $op = $cv->ROOT;
+    $op = shift if null $op;
+    return if !$op or null $op;
+    walk_tree($op, sub {
+	my $op = shift;
+	if ($op->name eq "gv") {
+	    my $gv = $self->gv_or_padgv($op);
+	    if ($op->next->name eq "entersub") {
+		return if $self->{'subs_done'}{$$gv}++;
+		return if class($gv->CV) eq "SPECIAL";
+		$self->todo($gv, $gv->CV, 0);
+		$self->walk_sub($gv->CV);
+	    } elsif ($op->next->name eq "enterwrite"
+		     or ($op->next->name eq "rv2gv"
+			 and $op->next->next->name eq "enterwrite")) {
+		return if $self->{'forms_done'}{$$gv}++;
+		return if class($gv->FORM) eq "SPECIAL";
+		$self->todo($gv, $gv->FORM, 1);
+		$self->walk_sub($gv->FORM);
+	    }
+	}
+    });
+}
+
+sub stash_subs {
+    my $self = shift;
+    my $pack = shift;
+    my(%stash, @ret);
+    { no strict 'refs'; %stash = svref_2object(\%{$pack . "::"})->ARRAY }
+    if ($pack eq "main") {
+	$pack = "";
+    } else {
+	$pack = $pack . "::";
+    }
+    my($key, $val);
+    while (($key, $val) = each %stash) {
+	my $class = class($val);
+	if ($class eq "PV") {
+	    # Just a prototype
+	    push @{$self->{'protos_todo'}}, [$pack . $key, $val->PV];
+	} elsif ($class eq "IV") {
+	    # Just a name
+	    push @{$self->{'protos_todo'}}, [$pack . $key, undef];	    
+	} elsif ($class eq "GV") {
+	    if (class($val->CV) ne "SPECIAL") {
+		next if $self->{'subs_done'}{$$val}++;
+		$self->todo($val, $val->CV, 0);
+		$self->walk_sub($val->CV);
+	    }
+	    if (class($val->FORM) ne "SPECIAL") {
+		next if $self->{'forms_done'}{$$val}++;
+		$self->todo($val, $val->FORM, 1);
+		$self->walk_sub($val->FORM);
+	    }
+	}
+    }
+}
+
+sub print_protos {
+    my $self = shift;
+    my $ar;
+    my @ret;
+    foreach $ar (@{$self->{'protos_todo'}}) {
+	my $proto = (defined $ar->[1] ? " (". $ar->[1] . ")" : "");
+	push @ret, "sub " . $ar->[0] .  "$proto;\n";
+    }
+    delete $self->{'protos_todo'};
+    return @ret;
+}
+
+sub style_opts {
+    my $self = shift;
+    my $opts = shift;
+    my $opt;
+    while (length($opt = substr($opts, 0, 1))) {
+	if ($opt eq "C") {
+	    $self->{'cuddle'} = " ";
+	    $opts = substr($opts, 1);
+	} elsif ($opt eq "i") {
+	    $opts =~ s/^i(\d+)//;
+	    $self->{'indent_size'} = $1;
+	} elsif ($opt eq "T") {
+	    $self->{'use_tabs'} = 1;
+	    $opts = substr($opts, 1);
+	} elsif ($opt eq "v") {
+	    $opts =~ s/^v([^.]*)(.|$)//;
+	    $self->{'ex_const'} = $1;
+	}
+    }
+}
+
+sub new {
+    my $class = shift;
+    my $self = bless {}, $class;
+    $self->{'subs_todo'} = [];
+    $self->{'curstash'} = "main";
+    $self->{'cuddle'} = "\n";
+    $self->{'indent_size'} = 4;
+    $self->{'use_tabs'} = 0;
+    $self->{'expand'} = 0;
+    $self->{'unquote'} = 0;
+    $self->{'linenums'} = 0;
+    $self->{'parens'} = 0;
+    $self->{'ex_const'} = "'???'";
+    while (my $arg = shift @_) {
+	if (substr($arg, 0, 2) eq "-u") {
+	    $self->stash_subs(substr($arg, 2));
+	} elsif ($arg eq "-p") {
+	    $self->{'parens'} = 1;
+	} elsif ($arg eq "-l") {
+	    $self->{'linenums'} = 1;
+	} elsif ($arg eq "-q") {
+	    $self->{'unquote'} = 1;
+	} elsif (substr($arg, 0, 2) eq "-s") {
+	    $self->style_opts(substr $arg, 2);
+	} elsif ($arg =~ /^-x(\d)$/) {
+	    $self->{'expand'} = $1;
+	}
+    }
+    return $self;
+}
+
+sub compile {
+    my(@args) = @_;
+    return sub { 
+	my $self = B::Deparse->new(@args);
+	$self->stash_subs("main");
+	$self->{'curcv'} = main_cv;
+	$self->walk_sub(main_cv, main_start);
+	print $self->print_protos;
+	@{$self->{'subs_todo'}} =
+	  sort {$a->[0] <=> $b->[0]} @{$self->{'subs_todo'}};
+	print $self->indent($self->deparse(main_root, 0)), "\n"
+	  unless null main_root;
+	my @text;
+	while (scalar(@{$self->{'subs_todo'}})) {
+	    push @text, $self->next_todo;
+	}
+	print $self->indent(join("", @text)), "\n" if @text;
+    }
+}
+
+sub coderef2text {
+    my $self = shift;
+    my $sub = shift;
+    croak "Usage: ->coderef2text(CODEREF)" unless ref($sub) eq "CODE";
+    return $self->indent($self->deparse_sub(svref_2object($sub)));
+}
+
+sub deparse {
+    my $self = shift;
+    my($op, $cx) = @_;
+#    cluck if class($op) eq "NULL";
+#    cluck unless $op;
+#    return $self->$ {\("pp_" . $op->name)}($op, $cx);
+    my $meth = "pp_" . $op->name;
+    return $self->$meth($op, $cx);
+}
+
+sub indent {
+    my $self = shift;
+    my $txt = shift;
+    my @lines = split(/\n/, $txt);
+    my $leader = "";
+    my $level = 0;
+    my $line;
+    for $line (@lines) {
+	my $cmd = substr($line, 0, 1);
+	if ($cmd eq "\t" or $cmd eq "\b") {
+	    $level += ($cmd eq "\t" ? 1 : -1) * $self->{'indent_size'};
+	    if ($self->{'use_tabs'}) {
+		$leader = "\t" x ($level / 8) . " " x ($level % 8);
+	    } else {
+		$leader = " " x $level;
+	    }
+	    $line = substr($line, 1);
+	}
+	if (substr($line, 0, 1) eq "\f") {
+	    $line = substr($line, 1); # no indent
+	} else {
+	    $line = $leader . $line;
+	}
+	$line =~ s/\cK;?//g;
+    }
+    return join("\n", @lines);
+}
+
+sub deparse_sub {
+    my $self = shift;
+    my $cv = shift;
+    my $proto = "";
+    if ($cv->FLAGS & SVf_POK) {
+	$proto = "(". $cv->PV . ") ";
+    }
+    if ($cv->CvFLAGS & (CVf_METHOD|CVf_LOCKED|CVf_LVALUE)) {
+        $proto .= ": ";
+        $proto .= "lvalue " if $cv->CvFLAGS & CVf_LVALUE;
+        $proto .= "locked " if $cv->CvFLAGS & CVf_LOCKED;
+        $proto .= "method " if $cv->CvFLAGS & CVf_METHOD;
+    }
+
+    local($self->{'curcv'}) = $cv;
+    local($self->{'curstash'}) = $self->{'curstash'};
+    if (not null $cv->ROOT) {
+	# skip leavesub
+	return $proto . "{\n\t" . 
+	    $self->deparse($cv->ROOT->first, 0) . "\n\b}\n"; 
+    } else { # XSUB?
+	return $proto  . "{}\n";
+    }
+}
+
+sub deparse_format {
+    my $self = shift;
+    my $form = shift;
+    my @text;
+    local($self->{'curcv'}) = $form;
+    local($self->{'curstash'}) = $self->{'curstash'};
+    my $op = $form->ROOT;
+    my $kid;
+    $op = $op->first->first; # skip leavewrite, lineseq
+    while (not null $op) {
+	$op = $op->sibling; # skip nextstate
+	my @exprs;
+	$kid = $op->first->sibling; # skip pushmark
+	push @text, $self->const_sv($kid)->PV;
+	$kid = $kid->sibling;
+	for (; not null $kid; $kid = $kid->sibling) {
+	    push @exprs, $self->deparse($kid, 0);
+	}
+	push @text, join(", ", @exprs)."\n" if @exprs;
+	$op = $op->sibling;
+    }
+    return join("", @text) . ".";
+}
+
+sub is_scope {
+    my $op = shift;
+    return $op->name eq "leave" || $op->name eq "scope"
+      || $op->name eq "lineseq"
+	|| ($op->name eq "null" && class($op) eq "UNOP" 
+	    && (is_scope($op->first) || $op->first->name eq "enter"));
+}
+
+sub is_state {
+    my $name = $_[0]->name;
+    return $name eq "nextstate" || $name eq "dbstate" || $name eq "setstate";
+}
+
+sub is_miniwhile { # check for one-line loop (`foo() while $y--')
+    my $op = shift;
+    return (!null($op) and null($op->sibling) 
+	    and $op->name eq "null" and class($op) eq "UNOP"
+	    and (($op->first->name =~ /^(and|or)$/
+		  and $op->first->first->sibling->name eq "lineseq")
+		 or ($op->first->name eq "lineseq"
+		     and not null $op->first->first->sibling
+		     and $op->first->first->sibling->name eq "unstack")
+		 ));
+}
+
+sub is_scalar {
+    my $op = shift;
+    return ($op->name eq "rv2sv" or
+	    $op->name eq "padsv" or
+	    $op->name eq "gv" or # only in array/hash constructs
+	    $op->flags & OPf_KIDS && !null($op->first)
+	      && $op->first->name eq "gvsv");
+}
+
+sub maybe_parens {
+    my $self = shift;
+    my($text, $cx, $prec) = @_;
+    if ($prec < $cx              # unary ops nest just fine
+	or $prec == $cx and $cx != 4 and $cx != 16 and $cx != 21
+	or $self->{'parens'})
+    {
+	$text = "($text)";
+	# In a unop, let parent reuse our parens; see maybe_parens_unop
+	$text = "\cS" . $text if $cx == 16;
+	return $text;
+    } else {
+	return $text;
+    }
+}
+
+# same as above, but get around the `if it looks like a function' rule
+sub maybe_parens_unop {
+    my $self = shift;
+    my($name, $kid, $cx) = @_;
+    if ($cx > 16 or $self->{'parens'}) {
+	return "$name(" . $self->deparse($kid, 1) . ")";
+    } else {
+	$kid = $self->deparse($kid, 16);
+	if (substr($kid, 0, 1) eq "\cS") {
+	    # use kid's parens
+	    return $name . substr($kid, 1);
+	} elsif (substr($kid, 0, 1) eq "(") {
+	    # avoid looks-like-a-function trap with extra parens
+	    # (`+' can lead to ambiguities)
+	    return "$name(" . $kid  . ")";
+	} else {
+	    return "$name $kid";
+	}
+    }
+}
+
+sub maybe_parens_func {
+    my $self = shift;
+    my($func, $text, $cx, $prec) = @_;
+    if ($prec <= $cx or substr($text, 0, 1) eq "(" or $self->{'parens'}) {
+	return "$func($text)";
+    } else {
+	return "$func $text";
+    }
+}
+
+sub maybe_local {
+    my $self = shift;
+    my($op, $cx, $text) = @_;
+    if ($op->private & OPpLVAL_INTRO and not $self->{'avoid_local'}{$$op}) {
+        if (want_scalar($op)) {
+	    return "local $text";
+	} else {
+	    return $self->maybe_parens_func("local", $text, $cx, 16);
+	}
+    } else {
+	return $text;
+    }
+}
+
+sub maybe_targmy {
+    my $self = shift;
+    my($op, $cx, $func, @args) = @_;
+    if ($op->private & OPpTARGET_MY) {
+	my $var = $self->padname($op->targ);
+	my $val = $func->($self, $op, 7, @args);
+	return $self->maybe_parens("$var = $val", $cx, 7);
+    } else {
+	return $func->($self, $op, $cx, @args);
+    }
+}
+
+sub padname_sv {
+    my $self = shift;
+    my $targ = shift;
+    return (($self->{'curcv'}->PADLIST->ARRAY)[0]->ARRAY)[$targ];
+}
+
+sub maybe_my {
+    my $self = shift;
+    my($op, $cx, $text) = @_;
+    if ($op->private & OPpLVAL_INTRO and not $self->{'avoid_local'}{$$op}) {
+	if (want_scalar($op)) {
+	    return "my $text";
+	} else {
+	    return $self->maybe_parens_func("my", $text, $cx, 16);
+	}
+    } else {
+	return $text;
+    }
+}
+
+# The following OPs don't have functions:
+
+# pp_padany -- does not exist after parsing
+# pp_rcatline -- does not exist
+
+sub pp_enter { # see also leave
+    cluck "unexpected OP_ENTER";
+    return "XXX";
+}
+
+sub pp_pushmark { # see also list
+    cluck "unexpected OP_PUSHMARK";
+    return "XXX";
+}
+
+sub pp_leavesub { # see also deparse_sub
+    cluck "unexpected OP_LEAVESUB";
+    return "XXX";
+}
+
+sub pp_leavewrite { # see also deparse_format
+    cluck "unexpected OP_LEAVEWRITE";
+    return "XXX";
+}
+
+sub pp_method { # see also entersub
+    cluck "unexpected OP_METHOD";
+    return "XXX";
+}
+
+sub pp_regcmaybe { # see also regcomp
+    cluck "unexpected OP_REGCMAYBE";
+    return "XXX";
+}
+
+sub pp_regcreset { # see also regcomp
+    cluck "unexpected OP_REGCRESET";
+    return "XXX";
+}
+
+sub pp_substcont { # see also subst
+    cluck "unexpected OP_SUBSTCONT";
+    return "XXX";
+}
+
+sub pp_grepstart { # see also grepwhile
+    cluck "unexpected OP_GREPSTART";
+    return "XXX";
+}
+
+sub pp_mapstart { # see also mapwhile
+    cluck "unexpected OP_MAPSTART";
+    return "XXX";
+}
+
+sub pp_flip { # see also flop
+    cluck "unexpected OP_FLIP";
+    return "XXX";
+}
+
+sub pp_iter { # see also leaveloop
+    cluck "unexpected OP_ITER";
+    return "XXX";
+}
+
+sub pp_enteriter { # see also leaveloop
+    cluck "unexpected OP_ENTERITER";
+    return "XXX";
+}
+
+sub pp_enterloop { # see also leaveloop
+    cluck "unexpected OP_ENTERLOOP";
+    return "XXX";
+}
+
+sub pp_leaveeval { # see also entereval
+    cluck "unexpected OP_LEAVEEVAL";
+    return "XXX";
+}
+
+sub pp_entertry { # see also leavetry
+    cluck "unexpected OP_ENTERTRY";
+    return "XXX";
+}
+
+sub lineseq {
+    my $self = shift;
+    my(@ops) = @_;
+    my($expr, @exprs);
+    for (my $i = 0; $i < @ops; $i++) {
+	$expr = "";
+	if (is_state $ops[$i]) {
+	    $expr = $self->deparse($ops[$i], 0);
+	    $i++;
+	    last if $i > $#ops;
+	}
+	if (!is_state $ops[$i] and $ops[$i+1] and !null($ops[$i+1]) and
+	    $ops[$i+1]->name eq "leaveloop" and $self->{'expand'} < 3)
+	{
+	    push @exprs, $expr . $self->for_loop($ops[$i], 0);
+	    $i++;
+	    next;
+	}
+	$expr .= $self->deparse($ops[$i], 0);
+	push @exprs, $expr if length $expr;
+    }
+    return join(";\n", @exprs);
+}
+
+sub scopeop {
+    my($real_block, $self, $op, $cx) = @_;
+    my $kid;
+    my @kids;
+    local($self->{'curstash'}) = $self->{'curstash'} if $real_block;
+    if ($real_block) {
+	$kid = $op->first->sibling; # skip enter
+	if (is_miniwhile($kid)) {
+	    my $top = $kid->first;
+	    my $name = $top->name;
+	    if ($name eq "and") {
+		$name = "while";
+	    } elsif ($name eq "or") {
+		$name = "until";
+	    } else { # no conditional -> while 1 or until 0
+		return $self->deparse($top->first, 1) . " while 1";
+	    }
+	    my $cond = $top->first;
+	    my $body = $cond->sibling->first; # skip lineseq
+	    $cond = $self->deparse($cond, 1);
+	    $body = $self->deparse($body, 1);
+	    return "$body $name $cond";
+	}
+    } else {
+	$kid = $op->first;
+    }
+    for (; !null($kid); $kid = $kid->sibling) {
+	push @kids, $kid;
+    }
+    if ($cx > 0) { # inside an expression, (a do {} while for lineseq)
+	return "do { " . $self->lineseq(@kids) . " }";
+    } else {
+	return $self->lineseq(@kids) . ";";
+    }
+}
+
+sub pp_scope { scopeop(0, @_); }
+sub pp_lineseq { scopeop(0, @_); }
+sub pp_leave { scopeop(1, @_); }
+
+# The BEGIN {} is used here because otherwise this code isn't executed
+# when you run B::Deparse on itself.
+my %globalnames;
+BEGIN { map($globalnames{$_}++, "SIG", "STDIN", "STDOUT", "STDERR", "INC",
+	    "ENV", "ARGV", "ARGVOUT", "_"); }
+
+sub gv_name {
+    my $self = shift;
+    my $gv = shift;
+    my $stash = $gv->STASH->NAME;
+    my $name = $gv->SAFENAME;
+    if ($stash eq $self->{'curstash'} or $globalnames{$name}
+	or $name =~ /^[^A-Za-z_]/)
+    {
+	$stash = "";
+    } else {
+	$stash = $stash . "::";
+    }
+    if ($name =~ /^\^../) {
+        $name = "{$name}";       # ${^WARNING_BITS} etc
+    }
+    return $stash . $name;
+}
+
+# Notice how subs and formats are inserted between statements here
+sub pp_nextstate {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my @text;
+    @text = $op->label . ": " if $op->label;
+    my $seq = $op->cop_seq;
+    while (scalar(@{$self->{'subs_todo'}})
+	   and $seq > $self->{'subs_todo'}[0][0]) {
+	push @text, $self->next_todo;
+    }
+    my $stash = $op->stashpv;
+    if ($stash ne $self->{'curstash'}) {
+	push @text, "package $stash;\n";
+	$self->{'curstash'} = $stash;
+    }
+    if ($self->{'linenums'}) {
+	push @text, "\f#line " . $op->line . 
+	  ' "' . $op->file, qq'"\n';
+    }
+    return join("", @text);
+}
+
+sub pp_dbstate { pp_nextstate(@_) }
+sub pp_setstate { pp_nextstate(@_) }
+
+sub pp_unstack { return "" } # see also leaveloop
+
+sub baseop {
+    my $self = shift;
+    my($op, $cx, $name) = @_;
+    return $name;
+}
+
+sub pp_stub { baseop(@_, "()") }
+sub pp_wantarray { baseop(@_, "wantarray") }
+sub pp_fork { baseop(@_, "fork") }
+sub pp_wait { maybe_targmy(@_, \&baseop, "wait") }
+sub pp_getppid { maybe_targmy(@_, \&baseop, "getppid") }
+sub pp_time { maybe_targmy(@_, \&baseop, "time") }
+sub pp_tms { baseop(@_, "times") }
+sub pp_ghostent { baseop(@_, "gethostent") }
+sub pp_gnetent { baseop(@_, "getnetent") }
+sub pp_gprotoent { baseop(@_, "getprotoent") }
+sub pp_gservent { baseop(@_, "getservent") }
+sub pp_ehostent { baseop(@_, "endhostent") }
+sub pp_enetent { baseop(@_, "endnetent") }
+sub pp_eprotoent { baseop(@_, "endprotoent") }
+sub pp_eservent { baseop(@_, "endservent") }
+sub pp_gpwent { baseop(@_, "getpwent") }
+sub pp_spwent { baseop(@_, "setpwent") }
+sub pp_epwent { baseop(@_, "endpwent") }
+sub pp_ggrent { baseop(@_, "getgrent") }
+sub pp_sgrent { baseop(@_, "setgrent") }
+sub pp_egrent { baseop(@_, "endgrent") }
+sub pp_getlogin { baseop(@_, "getlogin") }
+
+sub POSTFIX () { 1 }
+
+# I couldn't think of a good short name, but this is the category of
+# symbolic unary operators with interesting precedence
+
+sub pfixop {
+    my $self = shift;
+    my($op, $cx, $name, $prec, $flags) = (@_, 0);
+    my $kid = $op->first;
+    $kid = $self->deparse($kid, $prec);
+    return $self->maybe_parens(($flags & POSTFIX) ? "$kid$name" : "$name$kid",
+			       $cx, $prec);
+}
+
+sub pp_preinc { pfixop(@_, "++", 23) }
+sub pp_predec { pfixop(@_, "--", 23) }
+sub pp_postinc { maybe_targmy(@_, \&pfixop, "++", 23, POSTFIX) }
+sub pp_postdec { maybe_targmy(@_, \&pfixop, "--", 23, POSTFIX) }
+sub pp_i_preinc { pfixop(@_, "++", 23) }
+sub pp_i_predec { pfixop(@_, "--", 23) }
+sub pp_i_postinc { maybe_targmy(@_, \&pfixop, "++", 23, POSTFIX) }
+sub pp_i_postdec { maybe_targmy(@_, \&pfixop, "--", 23, POSTFIX) }
+sub pp_complement { maybe_targmy(@_, \&pfixop, "~", 21) }
+
+sub pp_negate { maybe_targmy(@_, \&real_negate) }
+sub real_negate {
+    my $self = shift;
+    my($op, $cx) = @_;
+    if ($op->first->name =~ /^(i_)?negate$/) {
+	# avoid --$x
+	$self->pfixop($op, $cx, "-", 21.5);
+    } else {
+	$self->pfixop($op, $cx, "-", 21);	
+    }
+}
+sub pp_i_negate { pp_negate(@_) }
+
+sub pp_not {
+    my $self = shift;
+    my($op, $cx) = @_;
+    if ($cx <= 4) {
+	$self->pfixop($op, $cx, "not ", 4);
+    } else {
+	$self->pfixop($op, $cx, "!", 21);	
+    }
+}
+
+sub unop {
+    my $self = shift;
+    my($op, $cx, $name) = @_;
+    my $kid;
+    if ($op->flags & OPf_KIDS) {
+	$kid = $op->first;
+	return $self->maybe_parens_unop($name, $kid, $cx);
+    } else {
+	return $name .  ($op->flags & OPf_SPECIAL ? "()" : "");       
+    }
+}
+
+sub pp_chop { maybe_targmy(@_, \&unop, "chop") }
+sub pp_chomp { maybe_targmy(@_, \&unop, "chomp") }
+sub pp_schop { maybe_targmy(@_, \&unop, "chop") }
+sub pp_schomp { maybe_targmy(@_, \&unop, "chomp") }
+sub pp_defined { unop(@_, "defined") }
+sub pp_undef { unop(@_, "undef") }
+sub pp_study { unop(@_, "study") }
+sub pp_ref { unop(@_, "ref") }
+sub pp_pos { maybe_local(@_, unop(@_, "pos")) }
+
+sub pp_sin { maybe_targmy(@_, \&unop, "sin") }
+sub pp_cos { maybe_targmy(@_, \&unop, "cos") }
+sub pp_rand { maybe_targmy(@_, \&unop, "rand") }
+sub pp_srand { unop(@_, "srand") }
+sub pp_exp { maybe_targmy(@_, \&unop, "exp") }
+sub pp_log { maybe_targmy(@_, \&unop, "log") }
+sub pp_sqrt { maybe_targmy(@_, \&unop, "sqrt") }
+sub pp_int { maybe_targmy(@_, \&unop, "int") }
+sub pp_hex { maybe_targmy(@_, \&unop, "hex") }
+sub pp_oct { maybe_targmy(@_, \&unop, "oct") }
+sub pp_abs { maybe_targmy(@_, \&unop, "abs") }
+
+sub pp_length { maybe_targmy(@_, \&unop, "length") }
+sub pp_ord { maybe_targmy(@_, \&unop, "ord") }
+sub pp_chr { maybe_targmy(@_, \&unop, "chr") }
+
+sub pp_each { unop(@_, "each") }
+sub pp_values { unop(@_, "values") }
+sub pp_keys { unop(@_, "keys") }
+sub pp_pop { unop(@_, "pop") }
+sub pp_shift { unop(@_, "shift") }
+
+sub pp_caller { unop(@_, "caller") }
+sub pp_reset { unop(@_, "reset") }
+sub pp_exit { unop(@_, "exit") }
+sub pp_prototype { unop(@_, "prototype") }
+
+sub pp_close { unop(@_, "close") }
+sub pp_fileno { unop(@_, "fileno") }
+sub pp_umask { unop(@_, "umask") }
+sub pp_untie { unop(@_, "untie") }
+sub pp_tied { unop(@_, "tied") }
+sub pp_dbmclose { unop(@_, "dbmclose") }
+sub pp_getc { unop(@_, "getc") }
+sub pp_eof { unop(@_, "eof") }
+sub pp_tell { unop(@_, "tell") }
+sub pp_getsockname { unop(@_, "getsockname") }
+sub pp_getpeername { unop(@_, "getpeername") }
+
+sub pp_chdir { maybe_targmy(@_, \&unop, "chdir") }
+sub pp_chroot { maybe_targmy(@_, \&unop, "chroot") }
+sub pp_readlink { unop(@_, "readlink") }
+sub pp_rmdir { maybe_targmy(@_, \&unop, "rmdir") }
+sub pp_readdir { unop(@_, "readdir") }
+sub pp_telldir { unop(@_, "telldir") }
+sub pp_rewinddir { unop(@_, "rewinddir") }
+sub pp_closedir { unop(@_, "closedir") }
+sub pp_getpgrp { maybe_targmy(@_, \&unop, "getpgrp") }
+sub pp_localtime { unop(@_, "localtime") }
+sub pp_gmtime { unop(@_, "gmtime") }
+sub pp_alarm { unop(@_, "alarm") }
+sub pp_sleep { maybe_targmy(@_, \&unop, "sleep") }
+
+sub pp_dofile { unop(@_, "do") }
+sub pp_entereval { unop(@_, "eval") }
+
+sub pp_ghbyname { unop(@_, "gethostbyname") }
+sub pp_gnbyname { unop(@_, "getnetbyname") }
+sub pp_gpbyname { unop(@_, "getprotobyname") }
+sub pp_shostent { unop(@_, "sethostent") }
+sub pp_snetent { unop(@_, "setnetent") }
+sub pp_sprotoent { unop(@_, "setprotoent") }
+sub pp_sservent { unop(@_, "setservent") }
+sub pp_gpwnam { unop(@_, "getpwnam") }
+sub pp_gpwuid { unop(@_, "getpwuid") }
+sub pp_ggrnam { unop(@_, "getgrnam") }
+sub pp_ggrgid { unop(@_, "getgrgid") }
+
+sub pp_lock { unop(@_, "lock") }
+
+sub pp_exists {
+    my $self = shift;
+    my($op, $cx) = @_;
+    return $self->maybe_parens_func("exists", $self->pp_helem($op->first, 16),
+				    $cx, 16);
+}
+
+sub pp_delete {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $arg;
+    if ($op->private & OPpSLICE) {
+	return $self->maybe_parens_func("delete",
+					$self->pp_hslice($op->first, 16),
+					$cx, 16);
+    } else {
+	return $self->maybe_parens_func("delete",
+					$self->pp_helem($op->first, 16),
+					$cx, 16);
+    }
+}
+
+sub pp_require {
+    my $self = shift;
+    my($op, $cx) = @_;
+    if (class($op) eq "UNOP" and $op->first->name eq "const"
+	and $op->first->private & OPpCONST_BARE)
+    {
+	my $name = $self->const_sv($op->first)->PV;
+	$name =~ s[/][::]g;
+	$name =~ s/\.pm//g;
+	return "require($name)";
+    } else {	
+	$self->unop($op, $cx, "require");
+    }
+}
+
+sub pp_scalar { 
+    my $self = shift;
+    my($op, $cv) = @_;
+    my $kid = $op->first;
+    if (not null $kid->sibling) {
+	# XXX Was a here-doc
+	return $self->dquote($op);
+    }
+    $self->unop(@_, "scalar");
+}
+
+
+sub padval {
+    my $self = shift;
+    my $targ = shift;
+    #cluck "curcv was undef" unless $self->{curcv};
+    return (($self->{'curcv'}->PADLIST->ARRAY)[1]->ARRAY)[$targ];
+}
+
+sub pp_refgen {
+    my $self = shift;	
+    my($op, $cx) = @_;
+    my $kid = $op->first;
+    if ($kid->name eq "null") {
+	$kid = $kid->first;
+	if ($kid->name eq "anonlist" || $kid->name eq "anonhash") {
+	    my($pre, $post) = @{{"anonlist" => ["[","]"],
+				 "anonhash" => ["{","}"]}->{$kid->name}};
+	    my($expr, @exprs);
+	    $kid = $kid->first->sibling; # skip pushmark
+	    for (; !null($kid); $kid = $kid->sibling) {
+		$expr = $self->deparse($kid, 6);
+		push @exprs, $expr;
+	    }
+	    return $pre . join(", ", @exprs) . $post;
+	} elsif (!null($kid->sibling) and 
+		 $kid->sibling->name eq "anoncode") {
+	    return "sub " .
+		$self->deparse_sub($self->padval($kid->sibling->targ));
+	} elsif ($kid->name eq "pushmark") {
+            my $sib_name = $kid->sibling->name;
+            if ($sib_name =~ /^(pad|rv2)[ah]v$/
+                and not $kid->sibling->flags & OPf_REF)
+            {
+                # The @a in \(@a) isn't in ref context, but only when the
+                # parens are there.
+                return "\\(" . $self->deparse($kid->sibling, 1) . ")";
+            } elsif ($sib_name eq 'entersub') {
+                my $text = $self->deparse($kid->sibling, 1);
+                # Always show parens for \(&func()), but only with -p otherwise
+                $text = "($text)" if $self->{'parens'}
+                                 or $kid->sibling->private & OPpENTERSUB_AMPER;
+                return "\\$text";
+            }
+        }
+    }
+    $self->pfixop($op, $cx, "\\", 20);
+}
+
+sub pp_srefgen { pp_refgen(@_) }
+
+sub pp_readline {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $kid = $op->first;
+    $kid = $kid->first if $kid->name eq "rv2gv"; # <$fh>
+    return "<" . $self->deparse($kid, 1) . ">";
+}
+
+# Unary operators that can occur as pseudo-listops inside double quotes
+sub dq_unop {
+    my $self = shift;
+    my($op, $cx, $name, $prec, $flags) = (@_, 0, 0);
+    my $kid;
+    if ($op->flags & OPf_KIDS) {
+       $kid = $op->first;
+       # If there's more than one kid, the first is an ex-pushmark.
+       $kid = $kid->sibling if not null $kid->sibling;
+       return $self->maybe_parens_unop($name, $kid, $cx);
+    } else {
+       return $name .  ($op->flags & OPf_SPECIAL ? "()" : "");       
+    }
+}
+
+sub pp_ucfirst { dq_unop(@_, "ucfirst") }
+sub pp_lcfirst { dq_unop(@_, "lcfirst") }
+sub pp_uc { dq_unop(@_, "uc") }
+sub pp_lc { dq_unop(@_, "lc") }
+sub pp_quotemeta { maybe_targmy(@_, \&dq_unop, "quotemeta") }
+
+sub loopex {
+    my $self = shift;
+    my ($op, $cx, $name) = @_;
+    if (class($op) eq "PVOP") {
+	return "$name " . $op->pv;
+    } elsif (class($op) eq "OP") {
+	return $name;
+    } elsif (class($op) eq "UNOP") {
+	# Note -- loop exits are actually exempt from the
+	# looks-like-a-func rule, but a few extra parens won't hurt
+	return $self->maybe_parens_unop($name, $op->first, $cx);
+    }
+}
+
+sub pp_last { loopex(@_, "last") }
+sub pp_next { loopex(@_, "next") }
+sub pp_redo { loopex(@_, "redo") }
+sub pp_goto { loopex(@_, "goto") }
+sub pp_dump { loopex(@_, "dump") }
+
+sub ftst {
+    my $self = shift;
+    my($op, $cx, $name) = @_;
+    if (class($op) eq "UNOP") {
+	# Genuine `-X' filetests are exempt from the LLAFR, but not
+	# l?stat(); for the sake of clarity, give'em all parens
+	return $self->maybe_parens_unop($name, $op->first, $cx);
+    } elsif (class($op) eq "SVOP") {
+	return $self->maybe_parens_func($name, $self->pp_gv($op, 1), $cx, 16);
+    } else { # I don't think baseop filetests ever survive ck_ftst, but...
+	return $name;
+    }
+}
+
+sub pp_lstat { ftst(@_, "lstat") }
+sub pp_stat { ftst(@_, "stat") }
+sub pp_ftrread { ftst(@_, "-R") }
+sub pp_ftrwrite { ftst(@_, "-W") }
+sub pp_ftrexec { ftst(@_, "-X") }
+sub pp_fteread { ftst(@_, "-r") }
+sub pp_ftewrite { ftst(@_, "-r") }
+sub pp_fteexec { ftst(@_, "-r") }
+sub pp_ftis { ftst(@_, "-e") }
+sub pp_fteowned { ftst(@_, "-O") }
+sub pp_ftrowned { ftst(@_, "-o") }
+sub pp_ftzero { ftst(@_, "-z") }
+sub pp_ftsize { ftst(@_, "-s") }
+sub pp_ftmtime { ftst(@_, "-M") }
+sub pp_ftatime { ftst(@_, "-A") }
+sub pp_ftctime { ftst(@_, "-C") }
+sub pp_ftsock { ftst(@_, "-S") }
+sub pp_ftchr { ftst(@_, "-c") }
+sub pp_ftblk { ftst(@_, "-b") }
+sub pp_ftfile { ftst(@_, "-f") }
+sub pp_ftdir { ftst(@_, "-d") }
+sub pp_ftpipe { ftst(@_, "-p") }
+sub pp_ftlink { ftst(@_, "-l") }
+sub pp_ftsuid { ftst(@_, "-u") }
+sub pp_ftsgid { ftst(@_, "-g") }
+sub pp_ftsvtx { ftst(@_, "-k") }
+sub pp_fttty { ftst(@_, "-t") }
+sub pp_fttext { ftst(@_, "-T") }
+sub pp_ftbinary { ftst(@_, "-B") }
+
+sub SWAP_CHILDREN () { 1 }
+sub ASSIGN () { 2 } # has OP= variant
+
+my(%left, %right);
+
+sub assoc_class {
+    my $op = shift;
+    my $name = $op->name;
+    if ($name eq "concat" and $op->first->name eq "concat") {
+	# avoid spurious `=' -- see comment in pp_concat
+	return "concat";
+    }
+    if ($name eq "null" and class($op) eq "UNOP"
+	and $op->first->name =~ /^(and|x?or)$/
+	and null $op->first->sibling)
+    {
+	# Like all conditional constructs, OP_ANDs and OP_ORs are topped
+	# with a null that's used as the common end point of the two
+	# flows of control. For precedence purposes, ignore it.
+	# (COND_EXPRs have these too, but we don't bother with
+	# their associativity).
+	return assoc_class($op->first);
+    }
+    return $name . ($op->flags & OPf_STACKED ? "=" : "");
+}
+
+# Left associative operators, like `+', for which
+# $a + $b + $c is equivalent to ($a + $b) + $c
+
+BEGIN {
+    %left = ('multiply' => 19, 'i_multiply' => 19,
+	     'divide' => 19, 'i_divide' => 19,
+	     'modulo' => 19, 'i_modulo' => 19,
+	     'repeat' => 19,
+	     'add' => 18, 'i_add' => 18,
+	     'subtract' => 18, 'i_subtract' => 18,
+	     'concat' => 18,
+	     'left_shift' => 17, 'right_shift' => 17,
+	     'bit_and' => 13,
+	     'bit_or' => 12, 'bit_xor' => 12,
+	     'and' => 3,
+	     'or' => 2, 'xor' => 2,
+	    );
+}
+
+sub deparse_binop_left {
+    my $self = shift;
+    my($op, $left, $prec) = @_;
+    if ($left{assoc_class($op)} && $left{assoc_class($left)}
+	and $left{assoc_class($op)} == $left{assoc_class($left)})
+    {
+	return $self->deparse($left, $prec - .00001);
+    } else {
+	return $self->deparse($left, $prec);	
+    }
+}
+
+# Right associative operators, like `=', for which
+# $a = $b = $c is equivalent to $a = ($b = $c)
+
+BEGIN {
+    %right = ('pow' => 22,
+	      'sassign=' => 7, 'aassign=' => 7,
+	      'multiply=' => 7, 'i_multiply=' => 7,
+	      'divide=' => 7, 'i_divide=' => 7,
+	      'modulo=' => 7, 'i_modulo=' => 7,
+	      'repeat=' => 7,
+	      'add=' => 7, 'i_add=' => 7,
+	      'subtract=' => 7, 'i_subtract=' => 7,
+	      'concat=' => 7,
+	      'left_shift=' => 7, 'right_shift=' => 7,
+	      'bit_and=' => 7,
+	      'bit_or=' => 7, 'bit_xor=' => 7,
+	      'andassign' => 7,
+	      'orassign' => 7,
+	     );
+}
+
+sub deparse_binop_right {
+    my $self = shift;
+    my($op, $right, $prec) = @_;
+    if ($right{assoc_class($op)} && $right{assoc_class($right)}
+	and $right{assoc_class($op)} == $right{assoc_class($right)})
+    {
+	return $self->deparse($right, $prec - .00001);
+    } else {
+	return $self->deparse($right, $prec);	
+    }
+}
+
+sub binop {
+    my $self = shift;
+    my ($op, $cx, $opname, $prec, $flags) = (@_, 0);
+    my $left = $op->first;
+    my $right = $op->last;
+    my $eq = "";
+    if ($op->flags & OPf_STACKED && $flags & ASSIGN) {
+	$eq = "=";
+	$prec = 7;
+    }
+    if ($flags & SWAP_CHILDREN) {
+	($left, $right) = ($right, $left);
+    }
+    $left = $self->deparse_binop_left($op, $left, $prec);
+    $right = $self->deparse_binop_right($op, $right, $prec);
+    return $self->maybe_parens("$left $opname$eq $right", $cx, $prec);
+}
+
+sub pp_add { maybe_targmy(@_, \&binop, "+", 18, ASSIGN) }
+sub pp_multiply { maybe_targmy(@_, \&binop, "*", 19, ASSIGN) }
+sub pp_subtract { maybe_targmy(@_, \&binop, "-",18,  ASSIGN) }
+sub pp_divide { maybe_targmy(@_, \&binop, "/", 19, ASSIGN) }
+sub pp_modulo { maybe_targmy(@_, \&binop, "%", 19, ASSIGN) }
+sub pp_i_add { maybe_targmy(@_, \&binop, "+", 18, ASSIGN) }
+sub pp_i_multiply { maybe_targmy(@_, \&binop, "*", 19, ASSIGN) }
+sub pp_i_subtract { maybe_targmy(@_, \&binop, "-", 18, ASSIGN) }
+sub pp_i_divide { maybe_targmy(@_, \&binop, "/", 19, ASSIGN) }
+sub pp_i_modulo { maybe_targmy(@_, \&binop, "%", 19, ASSIGN) }
+sub pp_pow { maybe_targmy(@_, \&binop, "**", 22, ASSIGN) }
+
+sub pp_left_shift { maybe_targmy(@_, \&binop, "<<", 17, ASSIGN) }
+sub pp_right_shift { maybe_targmy(@_, \&binop, ">>", 17, ASSIGN) }
+sub pp_bit_and { maybe_targmy(@_, \&binop, "&", 13, ASSIGN) }
+sub pp_bit_or { maybe_targmy(@_, \&binop, "|", 12, ASSIGN) }
+sub pp_bit_xor { maybe_targmy(@_, \&binop, "^", 12, ASSIGN) }
+
+sub pp_eq { binop(@_, "==", 14) }
+sub pp_ne { binop(@_, "!=", 14) }
+sub pp_lt { binop(@_, "<", 15) }
+sub pp_gt { binop(@_, ">", 15) }
+sub pp_ge { binop(@_, ">=", 15) }
+sub pp_le { binop(@_, "<=", 15) }
+sub pp_ncmp { binop(@_, "<=>", 14) }
+sub pp_i_eq { binop(@_, "==", 14) }
+sub pp_i_ne { binop(@_, "!=", 14) }
+sub pp_i_lt { binop(@_, "<", 15) }
+sub pp_i_gt { binop(@_, ">", 15) }
+sub pp_i_ge { binop(@_, ">=", 15) }
+sub pp_i_le { binop(@_, "<=", 15) }
+sub pp_i_ncmp { binop(@_, "<=>", 14) }
+
+sub pp_seq { binop(@_, "eq", 14) }
+sub pp_sne { binop(@_, "ne", 14) }
+sub pp_slt { binop(@_, "lt", 15) }
+sub pp_sgt { binop(@_, "gt", 15) }
+sub pp_sge { binop(@_, "ge", 15) }
+sub pp_sle { binop(@_, "le", 15) }
+sub pp_scmp { binop(@_, "cmp", 14) }
+
+sub pp_sassign { binop(@_, "=", 7, SWAP_CHILDREN) }
+sub pp_aassign { binop(@_, "=", 7, SWAP_CHILDREN) }
+
+# `.' is special because concats-of-concats are optimized to save copying
+# by making all but the first concat stacked. The effect is as if the
+# programmer had written `($a . $b) .= $c', except legal.
+sub pp_concat { maybe_targmy(@_, \&real_concat) }
+sub real_concat {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $left = $op->first;
+    my $right = $op->last;
+    my $eq = "";
+    my $prec = 18;
+    if ($op->flags & OPf_STACKED and $op->first->name ne "concat") {
+	$eq = "=";
+	$prec = 7;
+    }
+    $left = $self->deparse_binop_left($op, $left, $prec);
+    $right = $self->deparse_binop_right($op, $right, $prec);
+    return $self->maybe_parens("$left .$eq $right", $cx, $prec);
+}
+
+# `x' is weird when the left arg is a list
+sub pp_repeat {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $left = $op->first;
+    my $right = $op->last;
+    my $eq = "";
+    my $prec = 19;
+    if ($op->flags & OPf_STACKED) {
+	$eq = "=";
+	$prec = 7;
+    }
+    if (null($right)) { # list repeat; count is inside left-side ex-list
+	my $kid = $left->first->sibling; # skip pushmark
+	my @exprs;
+	for (; !null($kid->sibling); $kid = $kid->sibling) {
+	    push @exprs, $self->deparse($kid, 6);
+	}
+	$right = $kid;
+	$left = "(" . join(", ", @exprs). ")";
+    } else {
+	$left = $self->deparse_binop_left($op, $left, $prec);
+    }
+    $right = $self->deparse_binop_right($op, $right, $prec);
+    return $self->maybe_parens("$left x$eq $right", $cx, $prec);
+}
+
+sub range {
+    my $self = shift;
+    my ($op, $cx, $type) = @_;
+    my $left = $op->first;
+    my $right = $left->sibling;
+    $left = $self->deparse($left, 9);
+    $right = $self->deparse($right, 9);
+    return $self->maybe_parens("$left $type $right", $cx, 9);
+}
+
+sub pp_flop {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $flip = $op->first;
+    my $type = ($flip->flags & OPf_SPECIAL) ? "..." : "..";
+    return $self->range($flip->first, $cx, $type);
+}
+
+# one-line while/until is handled in pp_leave
+
+sub logop {
+    my $self = shift;
+    my ($op, $cx, $lowop, $lowprec, $highop, $highprec, $blockname) = @_;
+    my $left = $op->first;
+    my $right = $op->first->sibling;
+    if ($cx == 0 and is_scope($right) and $blockname
+	and $self->{'expand'} < 7)
+    { # if ($a) {$b}
+	$left = $self->deparse($left, 1);
+	$right = $self->deparse($right, 0);
+	return "$blockname ($left) {\n\t$right\n\b}\cK";
+    } elsif ($cx == 0 and $blockname and not $self->{'parens'}
+	     and $self->{'expand'} < 7) { # $b if $a
+	$right = $self->deparse($right, 1);
+	$left = $self->deparse($left, 1);
+	return "$right $blockname $left";
+    } elsif ($cx > $lowprec and $highop) { # $a && $b
+	$left = $self->deparse_binop_left($op, $left, $highprec);
+	$right = $self->deparse_binop_right($op, $right, $highprec);
+	return $self->maybe_parens("$left $highop $right", $cx, $highprec);
+    } else { # $a and $b
+	$left = $self->deparse_binop_left($op, $left, $lowprec);
+	$right = $self->deparse_binop_right($op, $right, $lowprec);
+	return $self->maybe_parens("$left $lowop $right", $cx, $lowprec); 
+    }
+}
+
+sub pp_and { logop(@_, "and", 3, "&&", 11, "if") }
+sub pp_or  { logop(@_, "or",  2, "||", 10, "unless") }
+
+# xor is syntactically a logop, but it's really a binop (contrary to
+# old versions of opcode.pl). Syntax is what matters here.
+sub pp_xor { logop(@_, "xor", 2, "",   0,  "") }
+
+sub logassignop {
+    my $self = shift;
+    my ($op, $cx, $opname) = @_;
+    my $left = $op->first;
+    my $right = $op->first->sibling->first; # skip sassign
+    $left = $self->deparse($left, 7);
+    $right = $self->deparse($right, 7);
+    return $self->maybe_parens("$left $opname $right", $cx, 7);
+}
+
+sub pp_andassign { logassignop(@_, "&&=") }
+sub pp_orassign { logassignop(@_, "||=") }
+
+sub listop {
+    my $self = shift;
+    my($op, $cx, $name) = @_;
+    my(@exprs);
+    my $parens = ($cx >= 5) || $self->{'parens'};
+    my $kid = $op->first->sibling;
+    return $name if null $kid;
+    my $first = $self->deparse($kid, 6);
+    $first = "+$first" if not $parens and substr($first, 0, 1) eq "(";
+    push @exprs, $first;
+    $kid = $kid->sibling;
+    for (; !null($kid); $kid = $kid->sibling) {
+	push @exprs, $self->deparse($kid, 6);
+    }
+    if ($parens) {
+	return "$name(" . join(", ", @exprs) . ")";
+    } else {
+	return "$name " . join(", ", @exprs);
+    }
+}
+
+sub pp_bless { listop(@_, "bless") }
+sub pp_atan2 { maybe_targmy(@_, \&listop, "atan2") }
+sub pp_substr { maybe_local(@_, listop(@_, "substr")) }
+sub pp_vec { maybe_local(@_, listop(@_, "vec")) }
+sub pp_index { maybe_targmy(@_, \&listop, "index") }
+sub pp_rindex { maybe_targmy(@_, \&listop, "rindex") }
+sub pp_sprintf { maybe_targmy(@_, \&listop, "sprintf") }
+sub pp_formline { listop(@_, "formline") } # see also deparse_format
+sub pp_crypt { maybe_targmy(@_, \&listop, "crypt") }
+sub pp_unpack { listop(@_, "unpack") }
+sub pp_pack { listop(@_, "pack") }
+sub pp_join { maybe_targmy(@_, \&listop, "join") }
+sub pp_splice { listop(@_, "splice") }
+sub pp_push { maybe_targmy(@_, \&listop, "push") }
+sub pp_unshift { maybe_targmy(@_, \&listop, "unshift") }
+sub pp_reverse { listop(@_, "reverse") }
+sub pp_warn { listop(@_, "warn") }
+sub pp_die { listop(@_, "die") }
+# Actually, return is exempt from the LLAFR (see examples in this very
+# module!), but for consistency's sake, ignore that fact
+sub pp_return { listop(@_, "return") }
+sub pp_open { listop(@_, "open") }
+sub pp_pipe_op { listop(@_, "pipe") }
+sub pp_tie { listop(@_, "tie") }
+sub pp_binmode { listop(@_, "binmode") }
+sub pp_dbmopen { listop(@_, "dbmopen") }
+sub pp_sselect { listop(@_, "select") }
+sub pp_select { listop(@_, "select") }
+sub pp_read { listop(@_, "read") }
+sub pp_sysopen { listop(@_, "sysopen") }
+sub pp_sysseek { listop(@_, "sysseek") }
+sub pp_sysread { listop(@_, "sysread") }
+sub pp_syswrite { listop(@_, "syswrite") }
+sub pp_send { listop(@_, "send") }
+sub pp_recv { listop(@_, "recv") }
+sub pp_seek { listop(@_, "seek") }
+sub pp_fcntl { listop(@_, "fcntl") }
+sub pp_ioctl { listop(@_, "ioctl") }
+sub pp_flock { maybe_targmy(@_, \&listop, "flock") }
+sub pp_socket { listop(@_, "socket") }
+sub pp_sockpair { listop(@_, "sockpair") }
+sub pp_bind { listop(@_, "bind") }
+sub pp_connect { listop(@_, "connect") }
+sub pp_listen { listop(@_, "listen") }
+sub pp_accept { listop(@_, "accept") }
+sub pp_shutdown { listop(@_, "shutdown") }
+sub pp_gsockopt { listop(@_, "getsockopt") }
+sub pp_ssockopt { listop(@_, "setsockopt") }
+sub pp_chown { maybe_targmy(@_, \&listop, "chown") }
+sub pp_unlink { maybe_targmy(@_, \&listop, "unlink") }
+sub pp_chmod { maybe_targmy(@_, \&listop, "chmod") }
+sub pp_utime { maybe_targmy(@_, \&listop, "utime") }
+sub pp_rename { maybe_targmy(@_, \&listop, "rename") }
+sub pp_link { maybe_targmy(@_, \&listop, "link") }
+sub pp_symlink { maybe_targmy(@_, \&listop, "symlink") }
+sub pp_mkdir { maybe_targmy(@_, \&listop, "mkdir") }
+sub pp_open_dir { listop(@_, "opendir") }
+sub pp_seekdir { listop(@_, "seekdir") }
+sub pp_waitpid { maybe_targmy(@_, \&listop, "waitpid") }
+sub pp_system { maybe_targmy(@_, \&listop, "system") }
+sub pp_exec { maybe_targmy(@_, \&listop, "exec") }
+sub pp_kill { maybe_targmy(@_, \&listop, "kill") }
+sub pp_setpgrp { maybe_targmy(@_, \&listop, "setpgrp") }
+sub pp_getpriority { maybe_targmy(@_, \&listop, "getpriority") }
+sub pp_setpriority { maybe_targmy(@_, \&listop, "setpriority") }
+sub pp_shmget { listop(@_, "shmget") }
+sub pp_shmctl { listop(@_, "shmctl") }
+sub pp_shmread { listop(@_, "shmread") }
+sub pp_shmwrite { listop(@_, "shmwrite") }
+sub pp_msgget { listop(@_, "msgget") }
+sub pp_msgctl { listop(@_, "msgctl") }
+sub pp_msgsnd { listop(@_, "msgsnd") }
+sub pp_msgrcv { listop(@_, "msgrcv") }
+sub pp_semget { listop(@_, "semget") }
+sub pp_semctl { listop(@_, "semctl") }
+sub pp_semop { listop(@_, "semop") }
+sub pp_ghbyaddr { listop(@_, "gethostbyaddr") }
+sub pp_gnbyaddr { listop(@_, "getnetbyaddr") }
+sub pp_gpbynumber { listop(@_, "getprotobynumber") }
+sub pp_gsbyname { listop(@_, "getservbyname") }
+sub pp_gsbyport { listop(@_, "getservbyport") }
+sub pp_syscall { listop(@_, "syscall") }
+
+sub pp_glob {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $text = $self->dq($op->first->sibling);  # skip pushmark
+    if ($text =~ /^\$?(\w|::|\`)+$/ # could look like a readline
+	or $text =~ /[<>]/) { 
+	return 'glob(' . single_delim('qq', '"', $text) . ')';
+    } else {
+	return '<' . $text . '>';
+    }
+}
+
+# Truncate is special because OPf_SPECIAL makes a bareword first arg
+# be a filehandle. This could probably be better fixed in the core
+# by moving the GV lookup into ck_truc.
+
+sub pp_truncate {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my(@exprs);
+    my $parens = ($cx >= 5) || $self->{'parens'};
+    my $kid = $op->first->sibling;
+    my $fh;
+    if ($op->flags & OPf_SPECIAL) {
+	# $kid is an OP_CONST
+	$fh = $self->const_sv($kid)->PV;
+    } else {
+	$fh = $self->deparse($kid, 6);
+        $fh = "+$fh" if not $parens and substr($fh, 0, 1) eq "(";
+    }
+    my $len = $self->deparse($kid->sibling, 6);
+    if ($parens) {
+	return "truncate($fh, $len)";
+    } else {
+	return "truncate $fh, $len";
+    }
+}
+
+sub indirop {
+    my $self = shift;
+    my($op, $cx, $name) = @_;
+    my($expr, @exprs);
+    my $kid = $op->first->sibling;
+    my $indir = "";
+    if ($op->flags & OPf_STACKED) {
+	$indir = $kid;
+	$indir = $indir->first; # skip rv2gv
+	if (is_scope($indir)) {
+	    $indir = "{" . $self->deparse($indir, 0) . "}";
+	} else {
+	    $indir = $self->deparse($indir, 24);
+	}
+	$indir = $indir . " ";
+	$kid = $kid->sibling;
+    }
+    for (; !null($kid); $kid = $kid->sibling) {
+	$expr = $self->deparse($kid, 6);
+	push @exprs, $expr;
+    }
+    return $self->maybe_parens_func($name, $indir . join(", ", @exprs),
+				    $cx, 5);
+}
+
+sub pp_prtf { indirop(@_, "printf") }
+sub pp_print { indirop(@_, "print") }
+sub pp_sort { indirop(@_, "sort") }
+
+sub mapop {
+    my $self = shift;
+    my($op, $cx, $name) = @_;
+    my($expr, @exprs);
+    my $kid = $op->first; # this is the (map|grep)start
+    $kid = $kid->first->sibling; # skip a pushmark
+    my $code = $kid->first; # skip a null
+    if (is_scope $code) {
+	$code = "{" . $self->deparse($code, 0) . "} ";
+    } else {
+	$code = $self->deparse($code, 24) . ", ";
+    }
+    $kid = $kid->sibling;
+    for (; !null($kid); $kid = $kid->sibling) {
+	$expr = $self->deparse($kid, 6);
+	push @exprs, $expr if $expr;
+    }
+    return $self->maybe_parens_func($name, $code . join(", ", @exprs), $cx, 5);
+}
+
+sub pp_mapwhile { mapop(@_, "map") }   
+sub pp_grepwhile { mapop(@_, "grep") }   
+
+sub pp_list {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my($expr, @exprs);
+    my $kid = $op->first->sibling; # skip pushmark
+    my $lop;
+    my $local = "either"; # could be local(...) or my(...)
+    for ($lop = $kid; !null($lop); $lop = $lop->sibling) {
+	# This assumes that no other private flags equal 128, and that
+	# OPs that store things other than flags in their op_private,
+	# like OP_AELEMFAST, won't be immediate children of a list.
+	unless ($lop->private & OPpLVAL_INTRO or $lop->name eq "undef")
+	{
+	    $local = ""; # or not
+	    last;
+	}
+	if ($lop->name =~ /^pad[ash]v$/) { # my()
+	    ($local = "", last) if $local eq "local";
+	    $local = "my";
+	} elsif ($lop->name ne "undef") { # local()
+	    ($local = "", last) if $local eq "my";
+	    $local = "local";
+	}
+    }
+    $local = "" if $local eq "either"; # no point if it's all undefs
+    return $self->deparse($kid, $cx) if null $kid->sibling and not $local;
+    for (; !null($kid); $kid = $kid->sibling) {
+	if ($local) {
+	    if (class($kid) eq "UNOP" and $kid->first->name eq "gvsv") {
+		$lop = $kid->first;
+	    } else {
+		$lop = $kid;
+	    }
+	    $self->{'avoid_local'}{$$lop}++;
+	    $expr = $self->deparse($kid, 6);
+	    delete $self->{'avoid_local'}{$$lop};
+	} else {
+	    $expr = $self->deparse($kid, 6);
+	}
+	push @exprs, $expr;
+    }
+    if ($local) {
+	return "$local(" . join(", ", @exprs) . ")";
+    } else {
+	return $self->maybe_parens( join(", ", @exprs), $cx, 6);	
+    }
+}
+
+sub is_ifelse_cont {
+    my $op = shift;
+    return ($op->name eq "null" and class($op) eq "UNOP"
+	    and $op->first->name =~ /^(and|cond_expr)$/
+	    and is_scope($op->first->first->sibling));
+}
+
+sub pp_cond_expr {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $cond = $op->first;
+    my $true = $cond->sibling;
+    my $false = $true->sibling;
+    my $cuddle = $self->{'cuddle'};
+    unless ($cx == 0 and (is_scope($true) and $true->name ne "null") and
+	    (is_scope($false) || is_ifelse_cont($false))
+	    and $self->{'expand'} < 7) {
+	$cond = $self->deparse($cond, 8);
+	$true = $self->deparse($true, 8);
+	$false = $self->deparse($false, 8);
+	return $self->maybe_parens("$cond ? $true : $false", $cx, 8);
+    }
+
+    $cond = $self->deparse($cond, 1);
+    $true = $self->deparse($true, 0);    
+    my $head = "if ($cond) {\n\t$true\n\b}";
+    my @elsifs;
+    while (!null($false) and is_ifelse_cont($false)) {
+	my $newop = $false->first;
+	my $newcond = $newop->first;
+	my $newtrue = $newcond->sibling;
+	$false = $newtrue->sibling; # last in chain is OP_AND => no else
+	$newcond = $self->deparse($newcond, 1);
+	$newtrue = $self->deparse($newtrue, 0);
+	push @elsifs, "elsif ($newcond) {\n\t$newtrue\n\b}";
+    }
+    if (!null($false)) {	    
+	$false = $cuddle . "else {\n\t" .
+	  $self->deparse($false, 0) . "\n\b}\cK";
+    } else {
+	$false = "\cK";
+    }
+    return $head . join($cuddle, "", @elsifs) . $false; 
+}
+
+sub loop_common {
+    my $self = shift;
+    my($op, $cx, $init) = @_;
+    my $enter = $op->first;
+    my $kid = $enter->sibling;
+    local($self->{'curstash'}) = $self->{'curstash'};
+    my $head = "";
+    my $bare = 0;
+    my $body;
+    my $cond = undef;
+    if ($kid->name eq "lineseq") { # bare or infinite loop 
+	if (is_state $kid->last) { # infinite
+	    $head = "for (;;) "; # shorter than while (1)
+	    $cond = "";
+	} else {
+	    $bare = 1;
+	}
+	$body = $kid;
+    } elsif ($enter->name eq "enteriter") { # foreach
+	my $ary = $enter->first->sibling; # first was pushmark
+	my $var = $ary->sibling;
+	if ($enter->flags & OPf_STACKED
+	    and not null $ary->first->sibling->sibling)
+	{
+	    $ary = $self->deparse($ary->first->sibling, 9) . " .. " .
+	      $self->deparse($ary->first->sibling->sibling, 9);
+	} else {
+	    $ary = $self->deparse($ary, 1);
+	}
+	if (null $var) {
+	    if ($enter->flags & OPf_SPECIAL) { # thread special var
+		$var = $self->pp_threadsv($enter, 1);
+	    } else { # regular my() variable
+		$var = $self->pp_padsv($enter, 1);
+		if ($self->padname_sv($enter->targ)->IVX ==
+		    $kid->first->first->sibling->last->cop_seq)
+		{
+		    # If the scope of this variable closes at the last
+		    # statement of the loop, it must have been
+		    # declared here.
+		    $var = "my " . $var;
+		}
+	    }
+	} elsif ($var->name eq "rv2gv") {
+	    $var = $self->pp_rv2sv($var, 1);
+	} elsif ($var->name eq "gv") {
+	    $var = "\$" . $self->deparse($var, 1);
+	}
+	$head = "foreach $var ($ary) ";
+	$body = $kid->first->first->sibling; # skip OP_AND and OP_ITER
+    } elsif ($kid->name eq "null") { # while/until
+	$kid = $kid->first;
+	my $name = {"and" => "while", "or" => "until"}->{$kid->name};
+	$cond = $self->deparse($kid->first, 1);
+	$head = "$name ($cond) ";
+	$body = $kid->first->sibling;
+    } elsif ($kid->name eq "stub") { # bare and empty
+	return "{;}"; # {} could be a hashref
+    }
+    # If there isn't a continue block, then the next pointer for the loop
+    # will point to the unstack, which is kid's penultimate child, except
+    # in a bare loop, when it will point to the leaveloop. When neither of
+    # these conditions hold, then the third-to-last child in the continue
+    # block (or the last in a bare loop).
+    my $cont_start = $enter->nextop;
+    my $cont;
+    if ($$cont_start != $$op and $ {$cont_start->sibling} != $ {$body->last}) {
+	if ($bare) {
+	    $cont = $body->last;
+	} else {
+	    $cont = $body->first;
+	    while (!null($cont->sibling->sibling->sibling)) {
+		$cont = $cont->sibling;
+	    }
+	}
+	my $state = $body->first;
+	my $cuddle = $self->{'cuddle'};
+	my @states;
+	for (; $$state != $$cont; $state = $state->sibling) {
+	    push @states, $state;
+	}
+	$body = $self->lineseq(@states);
+	if (defined $cond and not is_scope $cont and $self->{'expand'} < 3) {
+	    $head = "for ($init; $cond; " . $self->deparse($cont, 1) .") ";
+	    $cont = "\cK";
+	} else {
+	    $cont = $cuddle . "continue {\n\t" .
+	      $self->deparse($cont, 0) . "\n\b}\cK";
+	}
+    } else {
+	$cont = "\cK";
+	$body = $self->deparse($body, 0);
+    }
+    return $head . "{\n\t" . $body . "\n\b}" . $cont;
+}
+
+sub pp_leaveloop { loop_common(@_, "") }
+
+sub for_loop {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $init = $self->deparse($op, 1);
+    return $self->loop_common($op->sibling, $cx, $init);
+}
+
+sub pp_leavetry {
+    my $self = shift;
+    return "eval {\n\t" . $self->pp_leave(@_) . "\n\b}";
+}
+
+BEGIN { eval "sub OP_CONST () {" . opnumber("const") . "}" }
+BEGIN { eval "sub OP_STRINGIFY () {" . opnumber("stringify") . "}" }
+
+sub pp_null {
+    my $self = shift;
+    my($op, $cx) = @_;
+    if (class($op) eq "OP") {
+	# old value is lost
+	return $self->{'ex_const'} if $op->targ == OP_CONST;
+    } elsif ($op->first->name eq "pushmark") {
+	return $self->pp_list($op, $cx);
+    } elsif ($op->first->name eq "enter") {
+	return $self->pp_leave($op, $cx);
+    } elsif ($op->targ == OP_STRINGIFY) {
+	return $self->dquote($op, $cx);
+    } elsif (!null($op->first->sibling) and
+	     $op->first->sibling->name eq "readline" and
+	     $op->first->sibling->flags & OPf_STACKED) {
+	return $self->maybe_parens($self->deparse($op->first, 7) . " = "
+				   . $self->deparse($op->first->sibling, 7),
+				   $cx, 7);
+    } elsif (!null($op->first->sibling) and
+	     $op->first->sibling->name eq "trans" and
+	     $op->first->sibling->flags & OPf_STACKED) {
+	return $self->maybe_parens($self->deparse($op->first, 20) . " =~ "
+				   . $self->deparse($op->first->sibling, 20),
+				   $cx, 20);
+    } else {
+	return $self->deparse($op->first, $cx);
+    }
+}
+
+sub padname {
+    my $self = shift;
+    my $targ = shift;
+    return $self->padname_sv($targ)->PVX;
+}
+
+sub padany {
+    my $self = shift;
+    my $op = shift;
+    return substr($self->padname($op->targ), 1); # skip $/@/%
+}
+
+sub pp_padsv {
+    my $self = shift;
+    my($op, $cx) = @_;
+    return $self->maybe_my($op, $cx, $self->padname($op->targ));
+}
+
+sub pp_padav { pp_padsv(@_) }
+sub pp_padhv { pp_padsv(@_) }
+
+my @threadsv_names;
+
+BEGIN {
+    @threadsv_names = ("_", "1", "2", "3", "4", "5", "6", "7", "8", "9",
+		       "&", "`", "'", "+", "/", ".", ",", "\\", '"', ";",
+		       "^", "-", "%", "=", "|", "~", ":", "^A", "^E",
+		       "!", "@");
+}
+
+sub pp_threadsv {
+    my $self = shift;
+    my($op, $cx) = @_;
+    return $self->maybe_local($op, $cx, "\$" .  $threadsv_names[$op->targ]);
+}    
+
+sub gv_or_padgv {
+    my $self = shift;
+    my $op = shift;
+    if (class($op) eq "PADOP") {
+	return $self->padval($op->padix);
+    } else { # class($op) eq "SVOP"
+	return $op->gv;
+    }
+}
+
+sub pp_gvsv {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $gv = $self->gv_or_padgv($op);
+    return $self->maybe_local($op, $cx, "\$" . $self->gv_name($gv));
+}
+
+sub pp_gv {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $gv = $self->gv_or_padgv($op);
+    return $self->gv_name($gv);
+}
+
+sub pp_aelemfast {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $gv = $self->gv_or_padgv($op);
+    return "\$" . $self->gv_name($gv) . "[" . $op->private . "]";
+}
+
+sub rv2x {
+    my $self = shift;
+    my($op, $cx, $type) = @_;
+    my $kid = $op->first;
+    my $str = $self->deparse($kid, 0);
+    return $type . (is_scalar($kid) ? $str : "{$str}");
+}
+
+sub pp_rv2sv { maybe_local(@_, rv2x(@_, "\$")) }
+sub pp_rv2hv { maybe_local(@_, rv2x(@_, "%")) }
+sub pp_rv2gv { maybe_local(@_, rv2x(@_, "*")) }
+
+# skip rv2av
+sub pp_av2arylen {
+    my $self = shift;
+    my($op, $cx) = @_;
+    if ($op->first->name eq "padav") {
+	return $self->maybe_local($op, $cx, '$#' . $self->padany($op->first));
+    } else {
+	return $self->maybe_local($op, $cx,
+				  $self->rv2x($op->first, $cx, '$#'));
+    }
+}
+
+# skip down to the old, ex-rv2cv
+sub pp_rv2cv { $_[0]->rv2x($_[1]->first->first->sibling, $_[2], "&") }
+
+sub pp_rv2av {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $kid = $op->first;
+    if ($kid->name eq "const") { # constant list
+	my $av = $self->const_sv($kid);
+	return "(" . join(", ", map(const($_), $av->ARRAY)) . ")";
+    } else {
+	return $self->maybe_local($op, $cx, $self->rv2x($op, $cx, "\@"));
+    }
+ }
+
+sub is_subscriptable {
+    my $op = shift;
+    if ($op->name =~ /^[ahg]elem/) {
+	return 1;
+    } elsif ($op->name eq "entersub") {
+	my $kid = $op->first;
+	return 0 unless null $kid->sibling;
+	$kid = $kid->first;
+	$kid = $kid->sibling until null $kid->sibling;
+	return 0 if is_scope($kid);
+	$kid = $kid->first;
+	return 0 if $kid->name eq "gv";
+	return 0 if is_scalar($kid);
+	return is_subscriptable($kid);	
+    } else {
+	return 0;
+    }
+}
+
+sub elem {
+    my $self = shift;
+    my ($op, $cx, $left, $right, $padname) = @_;
+    my($array, $idx) = ($op->first, $op->first->sibling);
+    unless ($array->name eq $padname) { # Maybe this has been fixed	
+	$array = $array->first; # skip rv2av (or ex-rv2av in _53+)
+    }
+    if ($array->name eq $padname) {
+	$array = $self->padany($array);
+    } elsif (is_scope($array)) { # ${expr}[0]
+	$array = "{" . $self->deparse($array, 0) . "}";
+    } elsif (is_scalar $array) { # $x[0], $$x[0], ...
+	$array = $self->deparse($array, 24);
+    } else {
+	# $x[20][3]{hi} or expr->[20]
+	my $arrow = is_subscriptable($array) ? "" : "->";
+	return $self->deparse($array, 24) . $arrow .
+	    $left . $self->deparse($idx, 1) . $right;
+    }
+    $idx = $self->deparse($idx, 1);
+    return "\$" . $array . $left . $idx . $right;
+}
+
+sub pp_aelem { maybe_local(@_, elem(@_, "[", "]", "padav")) }
+sub pp_helem { maybe_local(@_, elem(@_, "{", "}", "padhv")) }
+
+sub pp_gelem {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my($glob, $part) = ($op->first, $op->last);
+    $glob = $glob->first; # skip rv2gv
+    $glob = $glob->first if $glob->name eq "rv2gv"; # this one's a bug
+    my $scope = is_scope($glob);
+    $glob = $self->deparse($glob, 0);
+    $part = $self->deparse($part, 1);
+    return "*" . ($scope ? "{$glob}" : $glob) . "{$part}";
+}
+
+sub slice {
+    my $self = shift;
+    my ($op, $cx, $left, $right, $regname, $padname) = @_;
+    my $last;
+    my(@elems, $kid, $array, $list);
+    if (class($op) eq "LISTOP") {
+	$last = $op->last;
+    } else { # ex-hslice inside delete()
+	for ($kid = $op->first; !null $kid->sibling; $kid = $kid->sibling) {}
+	$last = $kid;
+    }
+    $array = $last;
+    $array = $array->first
+	if $array->name eq $regname or $array->name eq "null";
+    if (is_scope($array)) {
+	$array = "{" . $self->deparse($array, 0) . "}";
+    } elsif ($array->name eq $padname) {
+	$array = $self->padany($array);
+    } else {
+	$array = $self->deparse($array, 24);
+    }
+    $kid = $op->first->sibling; # skip pushmark
+    if ($kid->name eq "list") {
+	$kid = $kid->first->sibling; # skip list, pushmark
+	for (; !null $kid; $kid = $kid->sibling) {
+	    push @elems, $self->deparse($kid, 6);
+	}
+	$list = join(", ", @elems);
+    } else {
+	$list = $self->deparse($kid, 1);
+    }
+    return "\@" . $array . $left . $list . $right;
+}
+
+sub pp_aslice { maybe_local(@_, slice(@_, "[", "]", "rv2av", "padav")) }
+sub pp_hslice { maybe_local(@_, slice(@_, "{", "}", "rv2hv", "padhv")) }
+
+sub pp_lslice {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $idx = $op->first;
+    my $list = $op->last;
+    my(@elems, $kid);
+    $list = $self->deparse($list, 1);
+    $idx = $self->deparse($idx, 1);
+    return "($list)" . "[$idx]";
+}
+
+sub want_scalar {
+    my $op = shift;
+    return ($op->flags & OPf_WANT) == OPf_WANT_SCALAR;
+}
+
+sub want_list {
+    my $op = shift;
+    return ($op->flags & OPf_WANT) == OPf_WANT_LIST;
+}
+
+sub method {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $kid = $op->first->sibling; # skip pushmark
+    my($meth, $obj, @exprs);
+    if ($kid->name eq "list" and want_list $kid) {
+	# When an indirect object isn't a bareword but the args are in
+	# parens, the parens aren't part of the method syntax (the LLAFR
+	# doesn't apply), but they make a list with OPf_PARENS set that
+	# doesn't get flattened by the append_elem that adds the method,
+	# making a (object, arg1, arg2, ...) list where the object
+	# usually is. This can be distinguished from 
+	# `($obj, $arg1, $arg2)->meth()' (which is legal if $arg2 is an
+	# object) because in the later the list is in scalar context
+	# as the left side of -> always is, while in the former
+	# the list is in list context as method arguments always are.
+	# (Good thing there aren't method prototypes!)
+	$meth = $kid->sibling;
+	$kid = $kid->first->sibling; # skip pushmark
+	$obj = $kid;
+	$kid = $kid->sibling;
+	for (; not null $kid; $kid = $kid->sibling) {
+	    push @exprs, $self->deparse($kid, 6);
+	}
+    } else {
+	$obj = $kid;
+	$kid = $kid->sibling;
+	for (; not null $kid->sibling; $kid = $kid->sibling) {
+	    push @exprs, $self->deparse($kid, 6);
+	}
+	$meth = $kid;
+    }
+    $obj = $self->deparse($obj, 24);
+    if ($meth->name eq "method_named") {
+	$meth = $self->const_sv($meth)->PV;
+    } else {
+	$meth = $meth->first;
+	if ($meth->name eq "const") {
+	    # As of 5.005_58, this case is probably obsoleted by the
+	    # method_named case above
+	    $meth = $self->const_sv($meth)->PV; # needs to be bare
+	} else {
+	    $meth = $self->deparse($meth, 1);
+	}
+    }
+    my $args = join(", ", @exprs);	
+    $kid = $obj . "->" . $meth;
+    if ($args) {
+	return $kid . "(" . $args . ")"; # parens mandatory
+    } else {
+	return $kid;
+    }
+}
+
+# returns "&" if the prototype doesn't match the args,
+# or ("", $args_after_prototype_demunging) if it does.
+sub check_proto {
+    my $self = shift;
+    my($proto, @args) = @_;
+    my($arg, $real);
+    my $doneok = 0;
+    my @reals;
+    # An unbackslashed @ or % gobbles up the rest of the args
+    $proto =~ s/([^\\]|^)([@%])(.*)$/$1$2/;
+    while ($proto) {
+	$proto =~ s/^ *([\\]?[\$\@&%*]|;)//;
+	my $chr = $1;
+	if ($chr eq "") {
+	    return "&" if @args;
+	} elsif ($chr eq ";") {
+	    $doneok = 1;
+	} elsif ($chr eq "@" or $chr eq "%") {
+	    push @reals, map($self->deparse($_, 6), @args);
+	    @args = ();
+	} else {
+	    $arg = shift @args;
+	    last unless $arg;
+	    if ($chr eq "\$") {
+		if (want_scalar $arg) {
+		    push @reals, $self->deparse($arg, 6);
+		} else {
+		    return "&";
+		}
+	    } elsif ($chr eq "&") {
+		if ($arg->name =~ /^(s?refgen|undef)$/) {
+		    push @reals, $self->deparse($arg, 6);
+		} else {
+		    return "&";
+		}
+	    } elsif ($chr eq "*") {
+		if ($arg->name =~ /^s?refgen$/
+		    and $arg->first->first->name eq "rv2gv")
+		  {
+		      $real = $arg->first->first; # skip refgen, null
+		      if ($real->first->name eq "gv") {
+			  push @reals, $self->deparse($real, 6);
+		      } else {
+			  push @reals, $self->deparse($real->first, 6);
+		      }
+		  } else {
+		      return "&";
+		  }
+	    } elsif (substr($chr, 0, 1) eq "\\") {
+		$chr = substr($chr, 1);
+		if ($arg->name =~ /^s?refgen$/ and
+		    !null($real = $arg->first) and
+		    ($chr eq "\$" && is_scalar($real->first)
+		     or ($chr eq "\@"
+			 && $real->first->sibling->name
+			 =~ /^(rv2|pad)av$/)
+		     or ($chr eq "%"
+			 && $real->first->sibling->name
+			 =~ /^(rv2|pad)hv$/)
+		     #or ($chr eq "&" # This doesn't work
+		     #   && $real->first->name eq "rv2cv")
+		     or ($chr eq "*"
+			 && $real->first->name eq "rv2gv")))
+		  {
+		      push @reals, $self->deparse($real, 6);
+		  } else {
+		      return "&";
+		  }
+	    }
+       }
+    }
+    return "&" if $proto and !$doneok; # too few args and no `;'
+    return "&" if @args;               # too many args
+    return ("", join ", ", @reals);
+}
+
+sub pp_entersub {
+    my $self = shift;
+    my($op, $cx) = @_;
+    return $self->method($op, $cx) unless null $op->first->sibling;
+    my $prefix = "";
+    my $amper = "";
+    my($kid, @exprs);
+    if ($op->flags & OPf_SPECIAL) {
+	$prefix = "do ";
+    } elsif ($op->private & OPpENTERSUB_AMPER) {
+	$amper = "&";
+    }
+    $kid = $op->first;
+    $kid = $kid->first->sibling; # skip ex-list, pushmark
+    for (; not null $kid->sibling; $kid = $kid->sibling) {
+	push @exprs, $kid;
+    }
+    my $simple = 0;
+    my $proto = undef;
+    if (is_scope($kid)) {
+	$amper = "&";
+	$kid = "{" . $self->deparse($kid, 0) . "}";
+    } elsif ($kid->first->name eq "gv") {
+	my $gv = $self->gv_or_padgv($kid->first);
+	if (class($gv->CV) ne "SPECIAL") {
+	    $proto = $gv->CV->PV if $gv->CV->FLAGS & SVf_POK;
+	}
+	$simple = 1; # only calls of named functions can be prototyped
+	$kid = $self->deparse($kid, 24);
+    } elsif (is_scalar $kid->first) {
+	$amper = "&";
+	$kid = $self->deparse($kid, 24);
+    } else {
+	$prefix = "";
+	my $arrow = is_subscriptable($kid->first) ? "" : "->";
+	$kid = $self->deparse($kid, 24) . $arrow;
+    }
+    my $args;
+    if (defined $proto and not $amper) {
+	($amper, $args) = $self->check_proto($proto, @exprs);
+	if ($amper eq "&") {
+	    $args = join(", ", map($self->deparse($_, 6), @exprs));
+	}
+    } else {
+	$args = join(", ", map($self->deparse($_, 6), @exprs));
+    }
+    if ($prefix or $amper) {
+	if ($op->flags & OPf_STACKED) {
+	    return $prefix . $amper . $kid . "(" . $args . ")";
+	} else {
+	    return $prefix . $amper. $kid;
+	}
+    } else {
+	if (defined $proto and $proto eq "") {
+	    return $kid;
+	} elsif (defined $proto and $proto eq "\$") {
+	    return $self->maybe_parens_func($kid, $args, $cx, 16);
+	} elsif (defined($proto) && $proto or $simple) {
+	    return $self->maybe_parens_func($kid, $args, $cx, 5);
+	} else {
+	    return "$kid(" . $args . ")";
+	}
+    }
+}
+
+sub pp_enterwrite { unop(@_, "write") }
+
+# escape things that cause interpolation in double quotes,
+# but not character escapes
+sub uninterp {
+    my($str) = @_;
+    $str =~ s/(^|[^\\])([\$\@]|\\[uUlLQE])/$1\\$2/g;
+    return $str;
+}
+
+# the same, but treat $|, $), and $ at the end of the string differently
+sub re_uninterp {
+    my($str) = @_;
+    $str =~ s/(^|[^\\])(\@|\\[uUlLQE])/$1\\$2/g;
+    $str =~ s/(^|[^\\])(\$[^)|])/$1\\$2/g;
+    return $str;
+}
+
+# character escapes, but not delimiters that might need to be escaped
+sub escape_str { # ASCII
+    my($str) = @_;
+    $str =~ s/\a/\\a/g;
+#    $str =~ s/\cH/\\b/g; # \b means someting different in a regex 
+    $str =~ s/\t/\\t/g;
+    $str =~ s/\n/\\n/g;
+    $str =~ s/\e/\\e/g;
+    $str =~ s/\f/\\f/g;
+    $str =~ s/\r/\\r/g;
+    $str =~ s/([\cA-\cZ])/'\\c' . chr(ord('@') + ord($1))/ge;
+    $str =~ s/([\0\033-\037\177-\377])/'\\' . sprintf("%03o", ord($1))/ge;
+    return $str;
+}
+
+# Don't do this for regexen
+sub unback {
+    my($str) = @_;
+    $str =~ s/\\/\\\\/g;
+    return $str;
+}
+
+sub balanced_delim {
+    my($str) = @_;
+    my @str = split //, $str;
+    my($ar, $open, $close, $fail, $c, $cnt);
+    for $ar (['[',']'], ['(',')'], ['<','>'], ['{','}']) {
+	($open, $close) = @$ar;
+	$fail = 0; $cnt = 0;
+	for $c (@str) {
+	    if ($c eq $open) {
+		$cnt++;
+	    } elsif ($c eq $close) {
+		$cnt--;
+		if ($cnt < 0) {
+		    # qq()() isn't ")("
+		    $fail = 1;
+		    last;
+		}
+	    }
+	}
+	$fail = 1 if $cnt != 0;
+	return ($open, "$open$str$close") if not $fail;
+    }
+    return ("", $str);
+}
+
+sub single_delim {
+    my($q, $default, $str) = @_;
+    return "$default$str$default" if $default and index($str, $default) == -1;
+    my($succeed, $delim);
+    ($succeed, $str) = balanced_delim($str);
+    return "$q$str" if $succeed;
+    for $delim ('/', '"', '#') {
+	return "$q$delim" . $str . $delim if index($str, $delim) == -1;
+    }
+    if ($default) {
+	$str =~ s/$default/\\$default/g;
+	return "$default$str$default";
+    } else {
+	$str =~ s[/][\\/]g;
+	return "$q/$str/";
+    }
+}
+
+sub const {
+    my $sv = shift;
+    if (class($sv) eq "SPECIAL") {
+	return ('undef', '1', '0')[$$sv-1]; # sv_undef, sv_yes, sv_no
+    } elsif ($sv->FLAGS & SVf_IOK) {
+	return $sv->int_value;
+    } elsif ($sv->FLAGS & SVf_NOK) {
+	return $sv->NV;
+    } elsif ($sv->FLAGS & SVf_ROK) {
+	return "\\(" . const($sv->RV) . ")"; # constant folded
+    } else {
+	my $str = $sv->PV;
+	if ($str =~ /[^ -~]/) { # ASCII for non-printing
+	    return single_delim("qq", '"', uninterp escape_str unback $str);
+	} else {
+	    return single_delim("q", "'", unback $str);
+	}
+    }
+}
+
+sub const_sv {
+    my $self = shift;
+    my $op = shift;
+    my $sv = $op->sv;
+    # the constant could be in the pad (under useithreads)
+    $sv = $self->padval($op->targ) unless $$sv;
+    return $sv;
+}
+
+sub pp_const {
+    my $self = shift;
+    my($op, $cx) = @_;
+#    if ($op->private & OPpCONST_BARE) { # trouble with `=>' autoquoting 
+#	return $self->const_sv($op)->PV;
+#    }
+    my $sv = $self->const_sv($op);
+#    return const($sv);
+    my $c = const $sv; 
+    return $c =~ /^-\d/ ? $self->maybe_parens($c, $cx, 21) : $c;
+}
+
+sub dq {
+    my $self = shift;
+    my $op = shift;
+    my $type = $op->name;
+    if ($type eq "const") {
+	return uninterp(escape_str(unback($self->const_sv($op)->PV)));
+    } elsif ($type eq "concat") {
+	my $first = $self->dq($op->first);
+	my $last  = $self->dq($op->last);
+	# Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]"
+        if ($last =~ /^[{\[\w]/) {
+	    $first =~ s/([%\$@])([A-Za-z_]\w*)$/${1}{$2}/;
+	}
+	return $first . $last;
+    } elsif ($type eq "uc") {
+	return '\U' . $self->dq($op->first->sibling) . '\E';
+    } elsif ($type eq "lc") {
+	return '\L' . $self->dq($op->first->sibling) . '\E';
+    } elsif ($type eq "ucfirst") {
+	return '\u' . $self->dq($op->first->sibling);
+    } elsif ($type eq "lcfirst") {
+	return '\l' . $self->dq($op->first->sibling);
+    } elsif ($type eq "quotemeta") {
+	return '\Q' . $self->dq($op->first->sibling) . '\E';
+    } elsif ($type eq "join") {
+	return $self->deparse($op->last, 26); # was join($", @ary)
+    } else {
+	return $self->deparse($op, 26);
+    }
+}
+
+sub pp_backtick {
+    my $self = shift;
+    my($op, $cx) = @_;
+    # skip pushmark
+    return single_delim("qx", '`', $self->dq($op->first->sibling));
+}
+
+sub dquote {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $kid = $op->first->sibling; # skip ex-stringify, pushmark
+    return $self->deparse($kid, $cx) if $self->{'unquote'};
+    $self->maybe_targmy($kid, $cx,
+			sub {single_delim("qq", '"', $self->dq($_[1]))});
+}
+
+# OP_STRINGIFY is a listop, but it only ever has one arg
+sub pp_stringify { maybe_targmy(@_, \&dquote) }
+
+# tr/// and s/// (and tr[][], tr[]//, tr###, etc)
+# note that tr(from)/to/ is OK, but not tr/from/(to)
+sub double_delim {
+    my($from, $to) = @_;
+    my($succeed, $delim);
+    if ($from !~ m[/] and $to !~ m[/]) {
+	return "/$from/$to/";
+    } elsif (($succeed, $from) = balanced_delim($from) and $succeed) {
+	if (($succeed, $to) = balanced_delim($to) and $succeed) {
+	    return "$from$to";
+	} else {
+	    for $delim ('/', '"', '#') { # note no `'' -- s''' is special
+		return "$from$delim$to$delim" if index($to, $delim) == -1;
+	    }
+	    $to =~ s[/][\\/]g;
+	    return "$from/$to/";
+	}
+    } else {
+	for $delim ('/', '"', '#') { # note no '
+	    return "$delim$from$delim$to$delim"
+		if index($to . $from, $delim) == -1;
+	}
+	$from =~ s[/][\\/]g;
+	$to =~ s[/][\\/]g;
+	return "/$from/$to/";	
+    }
+}
+
+sub pchr { # ASCII
+    my($n) = @_;
+    if ($n == ord '\\') {
+	return '\\\\';
+    } elsif ($n >= ord(' ') and $n <= ord('~')) {
+	return chr($n);
+    } elsif ($n == ord "\a") {
+	return '\\a';
+    } elsif ($n == ord "\b") {
+	return '\\b';
+    } elsif ($n == ord "\t") {
+	return '\\t';
+    } elsif ($n == ord "\n") {
+	return '\\n';
+    } elsif ($n == ord "\e") {
+	return '\\e';
+    } elsif ($n == ord "\f") {
+	return '\\f';
+    } elsif ($n == ord "\r") {
+	return '\\r';
+    } elsif ($n >= ord("\cA") and $n <= ord("\cZ")) {
+	return '\\c' . chr(ord("@") + $n);
+    } else {
+#	return '\x' . sprintf("%02x", $n);
+	return '\\' . sprintf("%03o", $n);
+    }
+}
+
+sub collapse {
+    my(@chars) = @_;
+    my($str, $c, $tr) = ("");
+    for ($c = 0; $c < @chars; $c++) {
+	$tr = $chars[$c];
+	$str .= pchr($tr);
+	if ($c <= $#chars - 2 and $chars[$c + 1] == $tr + 1 and
+	    $chars[$c + 2] == $tr + 2)
+	{
+	    for (; $c <= $#chars-1 and $chars[$c + 1] == $chars[$c] + 1; $c++)
+	      {}
+	    $str .= "-";
+	    $str .= pchr($chars[$c]);
+	}
+    }
+    return $str;
+}
+
+# XXX This has trouble with hyphens in the replacement (tr/bac/-AC/),
+# and backslashes.
+
+sub tr_decode_byte {
+    my($table, $flags) = @_;
+    my(@table) = unpack("s256", $table);
+    my($c, $tr, @from, @to, @delfrom, $delhyphen);
+    if ($table[ord "-"] != -1 and 
+	$table[ord("-") - 1] == -1 || $table[ord("-") + 1] == -1)
+    {
+	$tr = $table[ord "-"];
+	$table[ord "-"] = -1;
+	if ($tr >= 0) {
+	    @from = ord("-");
+	    @to = $tr;
+	} else { # -2 ==> delete
+	    $delhyphen = 1;
+	}
+    }
+    for ($c = 0; $c < 256; $c++) {
+	$tr = $table[$c];
+	if ($tr >= 0) {
+	    push @from, $c; push @to, $tr;
+	} elsif ($tr == -2) {
+	    push @delfrom, $c;
+	}
+    }
+    @from = (@from, @delfrom);
+    if ($flags & OPpTRANS_COMPLEMENT) {
+	my @newfrom = ();
+	my %from;
+	@from{@from} = (1) x @from;
+	for ($c = 0; $c < 256; $c++) {
+	    push @newfrom, $c unless $from{$c};
+	}
+	@from = @newfrom;
+    }
+    unless ($flags & OPpTRANS_DELETE || !@to) {
+	pop @to while $#to and $to[$#to] == $to[$#to -1];
+    }
+    my($from, $to);
+    $from = collapse(@from);
+    $to = collapse(@to);
+    $from .= "-" if $delhyphen;
+    return ($from, $to);
+}
+
+sub tr_chr {
+    my $x = shift;
+    if ($x == ord "-") {
+	return "\\-";
+    } else {
+	return chr $x;
+    }
+}
+
+# XXX This doesn't yet handle all cases correctly either
+
+sub tr_decode_utf8 {
+    my($swash_hv, $flags) = @_;
+    my %swash = $swash_hv->ARRAY;
+    my $final = undef;
+    $final = $swash{'FINAL'}->IV if exists $swash{'FINAL'};
+    my $none = $swash{"NONE"}->IV;
+    my $extra = $none + 1;
+    my(@from, @delfrom, @to);
+    my $line;
+    foreach $line (split /\n/, $swash{'LIST'}->PV) {
+	my($min, $max, $result) = split(/\t/, $line);
+	$min = hex $min;
+	if (length $max) {
+	    $max = hex $max;
+	} else {
+	    $max = $min;
+	}
+	$result = hex $result;
+	if ($result == $extra) {
+	    push @delfrom, [$min, $max];	    
+	} else {
+	    push @from, [$min, $max];
+	    push @to, [$result, $result + $max - $min];
+	}
+    }
+    for my $i (0 .. $#from) {
+	if ($from[$i][0] == ord '-') {
+	    unshift @from, splice(@from, $i, 1);
+	    unshift @to, splice(@to, $i, 1);
+	    last;
+	} elsif ($from[$i][1] == ord '-') {
+	    $from[$i][1]--;
+	    $to[$i][1]--;
+	    unshift @from, ord '-';
+	    unshift @to, ord '-';
+	    last;
+	}
+    }
+    for my $i (0 .. $#delfrom) {
+	if ($delfrom[$i][0] == ord '-') {
+	    push @delfrom, splice(@delfrom, $i, 1);
+	    last;
+	} elsif ($delfrom[$i][1] == ord '-') {
+	    $delfrom[$i][1]--;
+	    push @delfrom, ord '-';
+	    last;
+	}
+    }
+    if (defined $final and $to[$#to][1] != $final) {
+	push @to, [$final, $final];
+    }
+    push @from, @delfrom;
+    if ($flags & OPpTRANS_COMPLEMENT) {
+	my @newfrom;
+	my $next = 0;
+	for my $i (0 .. $#from) {
+	    push @newfrom, [$next, $from[$i][0] - 1];
+	    $next = $from[$i][1] + 1;
+	}
+	@from = ();
+	for my $range (@newfrom) {
+	    if ($range->[0] <= $range->[1]) {
+		push @from, $range;
+	    }
+	}
+    }
+    my($from, $to, $diff);
+    for my $chunk (@from) {
+	$diff = $chunk->[1] - $chunk->[0];
+	if ($diff > 1) {
+	    $from .= tr_chr($chunk->[0]) . "-" . tr_chr($chunk->[1]);
+	} elsif ($diff == 1) {
+	    $from .= tr_chr($chunk->[0]) . tr_chr($chunk->[1]);
+	} else {
+	    $from .= tr_chr($chunk->[0]);
+	}
+    }
+    for my $chunk (@to) {
+	$diff = $chunk->[1] - $chunk->[0];
+	if ($diff > 1) {
+	    $to .= tr_chr($chunk->[0]) . "-" . tr_chr($chunk->[1]);
+	} elsif ($diff == 1) {
+	    $to .= tr_chr($chunk->[0]) . tr_chr($chunk->[1]);
+	} else {
+	    $to .= tr_chr($chunk->[0]);
+	}
+    }
+    #$final = sprintf("%04x", $final) if defined $final;
+    #$none = sprintf("%04x", $none) if defined $none;
+    #$extra = sprintf("%04x", $extra) if defined $extra;    
+    #print STDERR "final: $final\n none: $none\nextra: $extra\n";
+    #print STDERR $swash{'LIST'}->PV;
+    return (escape_str($from), escape_str($to));
+}
+
+sub pp_trans {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my($from, $to);
+    if (class($op) eq "PVOP") {
+	($from, $to) = tr_decode_byte($op->pv, $op->private);
+    } else { # class($op) eq "SVOP"
+	($from, $to) = tr_decode_utf8($op->sv->RV, $op->private);
+    }
+    my $flags = "";
+    $flags .= "c" if $op->private & OPpTRANS_COMPLEMENT;
+    $flags .= "d" if $op->private & OPpTRANS_DELETE;
+    $to = "" if $from eq $to and $flags eq "";
+    $flags .= "s" if $op->private & OPpTRANS_SQUASH;
+    return "tr" . double_delim($from, $to) . $flags;
+}
+
+# Like dq(), but different
+sub re_dq {
+    my $self = shift;
+    my $op = shift;
+    my $type = $op->name;
+    if ($type eq "const") {
+	return re_uninterp($self->const_sv($op)->PV);
+    } elsif ($type eq "concat") {
+	my $first = $self->re_dq($op->first);
+	my $last  = $self->re_dq($op->last);
+	# Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]"
+	if ($last =~ /^[{\[\w]/) {
+	    $first =~ s/([%\$@])([A-Za-z_]\w*)$/${1}{$2}/;
+	}
+	return $first . $last;
+    } elsif ($type eq "uc") {
+	return '\U' . $self->re_dq($op->first->sibling) . '\E';
+    } elsif ($type eq "lc") {
+	return '\L' . $self->re_dq($op->first->sibling) . '\E';
+    } elsif ($type eq "ucfirst") {
+	return '\u' . $self->re_dq($op->first->sibling);
+    } elsif ($type eq "lcfirst") {
+	return '\l' . $self->re_dq($op->first->sibling);
+    } elsif ($type eq "quotemeta") {
+	return '\Q' . $self->re_dq($op->first->sibling) . '\E';
+    } elsif ($type eq "join") {
+	return $self->deparse($op->last, 26); # was join($", @ary)
+    } else {
+	return $self->deparse($op, 26);
+    }
+}
+
+sub pp_regcomp {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $kid = $op->first;
+    $kid = $kid->first if $kid->name eq "regcmaybe";
+    $kid = $kid->first if $kid->name eq "regcreset";
+    return $self->re_dq($kid);
+}
+
+# osmic acid -- see osmium tetroxide
+
+my %matchwords;
+map($matchwords{join "", sort split //, $_} = $_, 'cig', 'cog', 'cos', 'cogs',
+    'cox', 'go', 'is', 'ism', 'iso', 'mig', 'mix', 'osmic', 'ox', 'sic', 
+    'sig', 'six', 'smog', 'so', 'soc', 'sog', 'xi'); 
+
+sub matchop {
+    my $self = shift;
+    my($op, $cx, $name, $delim) = @_;
+    my $kid = $op->first;
+    my ($binop, $var, $re) = ("", "", "");
+    if ($op->flags & OPf_STACKED) {
+	$binop = 1;
+	$var = $self->deparse($kid, 20);
+	$kid = $kid->sibling;
+    }
+    if (null $kid) {
+	$re = re_uninterp(escape_str($op->precomp));
+    } else {
+	$re = $self->deparse($kid, 1);
+    }
+    my $flags = "";
+    $flags .= "c" if $op->pmflags & PMf_CONTINUE;
+    $flags .= "g" if $op->pmflags & PMf_GLOBAL;
+    $flags .= "i" if $op->pmflags & PMf_FOLD;
+    $flags .= "m" if $op->pmflags & PMf_MULTILINE;
+    $flags .= "o" if $op->pmflags & PMf_KEEP;
+    $flags .= "s" if $op->pmflags & PMf_SINGLELINE;
+    $flags .= "x" if $op->pmflags & PMf_EXTENDED;
+    $flags = $matchwords{$flags} if $matchwords{$flags};
+    if ($op->pmflags & PMf_ONCE) { # only one kind of delimiter works here
+	$re =~ s/\?/\\?/g;
+	$re = "?$re?";
+    } else {
+	$re = single_delim($name, $delim, $re);
+    }
+    $re = $re . $flags;
+    if ($binop) {
+	return $self->maybe_parens("$var =~ $re", $cx, 20);
+    } else {
+	return $re;
+    }
+}
+
+sub pp_match { matchop(@_, "m", "/") }
+sub pp_pushre { matchop(@_, "m", "/") }
+sub pp_qr { matchop(@_, "qr", "") }
+
+sub pp_split {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my($kid, @exprs, $ary, $expr);
+    $kid = $op->first;
+    if ($ {$kid->pmreplroot}) {
+	$ary = '@' . $self->gv_name($kid->pmreplroot);
+    }
+    for (; !null($kid); $kid = $kid->sibling) {
+	push @exprs, $self->deparse($kid, 6);
+    }
+    $expr = "split(" . join(", ", @exprs) . ")";
+    if ($ary) {
+	return $self->maybe_parens("$ary = $expr", $cx, 7);
+    } else {
+	return $expr;
+    }
+}
+
+# oxime -- any of various compounds obtained chiefly by the action of
+# hydroxylamine on aldehydes and ketones and characterized by the
+# bivalent grouping C=NOH [Webster's Tenth]
+
+my %substwords;
+map($substwords{join "", sort split //, $_} = $_, 'ego', 'egoism', 'em',
+    'es', 'ex', 'exes', 'gee', 'go', 'goes', 'ie', 'ism', 'iso', 'me',
+    'meese', 'meso', 'mig', 'mix', 'os', 'ox', 'oxime', 'see', 'seem',
+    'seg', 'sex', 'sig', 'six', 'smog', 'sog', 'some', 'xi');
+
+sub pp_subst {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $kid = $op->first;
+    my($binop, $var, $re, $repl) = ("", "", "", "");
+    if ($op->flags & OPf_STACKED) {
+	$binop = 1;
+	$var = $self->deparse($kid, 20);
+	$kid = $kid->sibling;
+    }
+    my $flags = "";    
+    if (null($op->pmreplroot)) {
+	$repl = $self->dq($kid);
+	$kid = $kid->sibling;
+    } else {
+	$repl = $op->pmreplroot->first; # skip substcont
+	while ($repl->name eq "entereval") {
+	    $repl = $repl->first;
+	    $flags .= "e";
+	}
+	if ($op->pmflags & PMf_EVAL) {
+	    $repl = $self->deparse($repl, 0);
+	} else {
+	    $repl = $self->dq($repl);	
+	}
+    }
+    if (null $kid) {
+	$re = re_uninterp(escape_str($op->precomp));
+    } else {
+	$re = $self->deparse($kid, 1);
+    }
+    $flags .= "e" if $op->pmflags & PMf_EVAL;
+    $flags .= "g" if $op->pmflags & PMf_GLOBAL;
+    $flags .= "i" if $op->pmflags & PMf_FOLD;
+    $flags .= "m" if $op->pmflags & PMf_MULTILINE;
+    $flags .= "o" if $op->pmflags & PMf_KEEP;
+    $flags .= "s" if $op->pmflags & PMf_SINGLELINE;
+    $flags .= "x" if $op->pmflags & PMf_EXTENDED;
+    $flags = $substwords{$flags} if $substwords{$flags};
+    if ($binop) {
+	return $self->maybe_parens("$var =~ s"
+				   . double_delim($re, $repl) . $flags,
+				   $cx, 20);
+    } else {
+	return "s". double_delim($re, $repl) . $flags;	
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+B::Deparse - Perl compiler backend to produce perl code
+
+=head1 SYNOPSIS
+
+B<perl> B<-MO=Deparse>[B<,-u>I<PACKAGE>][B<,-p>][B<,-q>][B<,-l>]
+        [B<,-s>I<LETTERS>][B<,-x>I<LEVEL>] I<prog.pl>
+
+=head1 DESCRIPTION
+
+B::Deparse is a backend module for the Perl compiler that generates
+perl source code, based on the internal compiled structure that perl
+itself creates after parsing a program. The output of B::Deparse won't
+be exactly the same as the original source, since perl doesn't keep
+track of comments or whitespace, and there isn't a one-to-one
+correspondence between perl's syntactical constructions and their
+compiled form, but it will often be close. When you use the B<-p>
+option, the output also includes parentheses even when they are not
+required by precedence, which can make it easy to see if perl is
+parsing your expressions the way you intended.
+
+Please note that this module is mainly new and untested code and is
+still under development, so it may change in the future.
+
+=head1 OPTIONS
+
+As with all compiler backend options, these must follow directly after
+the '-MO=Deparse', separated by a comma but not any white space.
+
+=over 4
+
+=item B<-l>
+
+Add '#line' declarations to the output based on the line and file
+locations of the original code.
+
+=item B<-p>
+
+Print extra parentheses. Without this option, B::Deparse includes
+parentheses in its output only when they are needed, based on the
+structure of your program. With B<-p>, it uses parentheses (almost)
+whenever they would be legal. This can be useful if you are used to
+LISP, or if you want to see how perl parses your input. If you say
+
+    if ($var & 0x7f == 65) {print "Gimme an A!"} 
+    print ($which ? $a : $b), "\n";
+    $name = $ENV{USER} or "Bob";
+
+C<B::Deparse,-p> will print
+
+    if (($var & 0)) {
+        print('Gimme an A!')
+    };
+    (print(($which ? $a : $b)), '???');
+    (($name = $ENV{'USER'}) or '???')
+
+which probably isn't what you intended (the C<'???'> is a sign that
+perl optimized away a constant value).
+
+=item B<-q>
+
+Expand double-quoted strings into the corresponding combinations of
+concatenation, uc, ucfirst, lc, lcfirst, quotemeta, and join. For
+instance, print
+
+    print "Hello, $world, @ladies, \u$gentlemen\E, \u\L$me!";
+
+as
+
+    print 'Hello, ' . $world . ', ' . join($", @ladies) . ', '
+          . ucfirst($gentlemen) . ', ' . ucfirst(lc $me . '!');
+
+Note that the expanded form represents the way perl handles such
+constructions internally -- this option actually turns off the reverse
+translation that B::Deparse usually does. On the other hand, note that
+C<$x = "$y"> is not the same as C<$x = $y>: the former makes the value
+of $y into a string before doing the assignment.
+
+=item B<-u>I<PACKAGE>
+
+Normally, B::Deparse deparses the main code of a program, all the subs
+called by the main program (and all the subs called by them,
+recursively), and any other subs in the main:: package. To include
+subs in other packages that aren't called directly, such as AUTOLOAD,
+DESTROY, other subs called automatically by perl, and methods (which
+aren't resolved to subs until runtime), use the B<-u> option. The
+argument to B<-u> is the name of a package, and should follow directly
+after the 'u'. Multiple B<-u> options may be given, separated by
+commas.  Note that unlike some other backends, B::Deparse doesn't
+(yet) try to guess automatically when B<-u> is needed -- you must
+invoke it yourself.
+
+=item B<-s>I<LETTERS>
+
+Tweak the style of B::Deparse's output. The letters should follow
+directly after the 's', with no space or punctuation. The following
+options are available:
+
+=over 4
+
+=item B<C>
+
+Cuddle C<elsif>, C<else>, and C<continue> blocks. For example, print
+
+    if (...) {
+         ...
+    } else {
+         ...
+    }
+
+instead of
+
+    if (...) {
+         ...
+    }
+    else {
+         ...
+    }
+
+The default is not to cuddle.
+
+=item B<i>I<NUMBER>
+
+Indent lines by multiples of I<NUMBER> columns. The default is 4 columns.
+
+=item B<T>
+
+Use tabs for each 8 columns of indent. The default is to use only spaces.
+For instance, if the style options are B<-si4T>, a line that's indented
+3 times will be preceded by one tab and four spaces; if the options were
+B<-si8T>, the same line would be preceded by three tabs.
+
+=item B<v>I<STRING>B<.>
+
+Print I<STRING> for the value of a constant that can't be determined
+because it was optimized away (mnemonic: this happens when a constant
+is used in B<v>oid context). The end of the string is marked by a period.
+The string should be a valid perl expression, generally a constant.
+Note that unless it's a number, it probably needs to be quoted, and on
+a command line quotes need to be protected from the shell. Some
+conventional values include 0, 1, 42, '', 'foo', and
+'Useless use of constant omitted' (which may need to be
+B<-sv"'Useless use of constant omitted'.">
+or something similar depending on your shell). The default is '???'.
+If you're using B::Deparse on a module or other file that's require'd,
+you shouldn't use a value that evaluates to false, since the customary
+true constant at the end of a module will be in void context when the
+file is compiled as a main program.
+
+=back
+
+=item B<-x>I<LEVEL>
+
+Expand conventional syntax constructions into equivalent ones that expose
+their internal operation. I<LEVEL> should be a digit, with higher values
+meaning more expansion. As with B<-q>, this actually involves turning off
+special cases in B::Deparse's normal operations.
+
+If I<LEVEL> is at least 3, for loops will be translated into equivalent
+while loops with continue blocks; for instance
+
+    for ($i = 0; $i < 10; ++$i) {
+        print $i;
+    }
+
+turns into
+
+    $i = 0;
+    while ($i < 10) {
+        print $i;
+    } continue {
+        ++$i
+    }
+
+Note that in a few cases this translation can't be perfectly carried back
+into the source code -- if the loop's initializer declares a my variable,
+for instance, it won't have the correct scope outside of the loop.
+
+If I<LEVEL> is at least 7, if statements will be translated into equivalent
+expressions using C<&&>, C<?:> and C<do {}>; for instance
+
+    print 'hi' if $nice;
+    if ($nice) {
+        print 'hi';
+    }
+    if ($nice) {
+        print 'hi';
+    } else {
+        print 'bye';
+    }
+
+turns into
+
+    $nice and print 'hi';
+    $nice and do { print 'hi' };
+    $nice ? do { print 'hi' } : do { print 'bye' };
+
+Long sequences of elsifs will turn into nested ternary operators, which
+B::Deparse doesn't know how to indent nicely.
+
+=back
+
+=head1 USING B::Deparse AS A MODULE
+
+=head2 Synopsis
+
+    use B::Deparse;
+    $deparse = B::Deparse->new("-p", "-sC");
+    $body = $deparse->coderef2text(\&func);
+    eval "sub func $body"; # the inverse operation
+
+=head2 Description
+
+B::Deparse can also be used on a sub-by-sub basis from other perl
+programs.
+
+=head2 new
+
+    $deparse = B::Deparse->new(OPTIONS)
+
+Create an object to store the state of a deparsing operation and any
+options. The options are the same as those that can be given on the
+command line (see L</OPTIONS>); options that are separated by commas
+after B<-MO=Deparse> should be given as separate strings. Some
+options, like B<-u>, don't make sense for a single subroutine, so
+don't pass them.
+
+=head2 coderef2text
+
+    $body = $deparse->coderef2text(\&func)
+    $body = $deparse->coderef2text(sub ($$) { ... })
+
+Return source code for the body of a subroutine (a block, optionally
+preceded by a prototype in parens), given a reference to the
+sub. Because a subroutine can have no names, or more than one name,
+this method doesn't return a complete subroutine definition -- if you
+want to eval the result, you should prepend "sub subname ", or "sub "
+for an anonymous function constructor. Unless the sub was defined in
+the main:: package, the code will include a package declaration.
+
+=head1 BUGS
+
+See the 'to do' list at the beginning of the module file.
+
+=head1 AUTHOR
+
+Stephen McCamant <smcc@CSUA.Berkeley.EDU>, based on an earlier
+version by Malcolm Beattie <mbeattie@sable.ox.ac.uk>, with
+contributions from Gisle Aas, James Duncan, Albert Dvornik, Hugo van
+der Sanden, Gurusamy Sarathy, and Nick Ing-Simmons.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Disassembler.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Disassembler.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Disassembler.pm	(revision 14265)
@@ -0,0 +1,185 @@
+#      Disassembler.pm
+#
+#      Copyright (c) 1996 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+package B::Disassembler::BytecodeStream;
+use FileHandle;
+use Carp;
+use B qw(cstring cast_I32);
+@ISA = qw(FileHandle);
+sub readn {
+    my ($fh, $len) = @_;
+    my $data;
+    read($fh, $data, $len);
+    croak "reached EOF while reading $len bytes" unless length($data) == $len;
+    return $data;
+}
+
+sub GET_U8 {
+    my $fh = shift;
+    my $c = $fh->getc;
+    croak "reached EOF while reading U8" unless defined($c);
+    return ord($c);
+}
+
+sub GET_U16 {
+    my $fh = shift;
+    my $str = $fh->readn(2);
+    croak "reached EOF while reading U16" unless length($str) == 2;
+    return unpack("n", $str);
+}
+
+sub GET_NV {
+    my $fh = shift;
+    my $str = $fh->readn(8);
+    croak "reached EOF while reading NV" unless length($str) == 8;
+    return unpack("N", $str);
+}
+
+sub GET_U32 {
+    my $fh = shift;
+    my $str = $fh->readn(4);
+    croak "reached EOF while reading U32" unless length($str) == 4;
+    return unpack("N", $str);
+}
+
+sub GET_I32 {
+    my $fh = shift;
+    my $str = $fh->readn(4);
+    croak "reached EOF while reading I32" unless length($str) == 4;
+    return cast_I32(unpack("N", $str));
+}
+
+sub GET_objindex { 
+    my $fh = shift;
+    my $str = $fh->readn(4);
+    croak "reached EOF while reading objindex" unless length($str) == 4;
+    return unpack("N", $str);
+}
+
+sub GET_opindex { 
+    my $fh = shift;
+    my $str = $fh->readn(4);
+    croak "reached EOF while reading opindex" unless length($str) == 4;
+    return unpack("N", $str);
+}
+
+sub GET_svindex { 
+    my $fh = shift;
+    my $str = $fh->readn(4);
+    croak "reached EOF while reading svindex" unless length($str) == 4;
+    return unpack("N", $str);
+}
+
+sub GET_strconst {
+    my $fh = shift;
+    my ($str, $c);
+    while (defined($c = $fh->getc) && $c ne "\0") {
+	$str .= $c;
+    }
+    croak "reached EOF while reading strconst" unless defined($c);
+    return cstring($str);
+}
+
+sub GET_pvcontents {}
+
+sub GET_PV {
+    my $fh = shift;
+    my $str;
+    my $len = $fh->GET_U32;
+    if ($len) {
+	read($fh, $str, $len);
+	croak "reached EOF while reading PV" unless length($str) == $len;
+	return cstring($str);
+    } else {
+	return '""';
+    }
+}
+
+sub GET_comment_t {
+    my $fh = shift;
+    my ($str, $c);
+    while (defined($c = $fh->getc) && $c ne "\n") {
+	$str .= $c;
+    }
+    croak "reached EOF while reading comment" unless defined($c);
+    return cstring($str);
+}
+
+sub GET_double {
+    my $fh = shift;
+    my ($str, $c);
+    while (defined($c = $fh->getc) && $c ne "\0") {
+	$str .= $c;
+    }
+    croak "reached EOF while reading double" unless defined($c);
+    return $str;
+}
+
+sub GET_none {}
+
+sub GET_op_tr_array {
+    my $fh = shift;
+    my @ary = unpack("n256", $fh->readn(256 * 2));
+    return join(",", @ary);
+}
+
+sub GET_IV64 {
+    my $fh = shift;
+    my ($hi, $lo) = unpack("NN", $fh->readn(8));
+    return sprintf("0x%4x%04x", $hi, $lo); # cheat
+}
+
+package B::Disassembler;
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(disassemble_fh);
+use Carp;
+use strict;
+
+use B::Asmdata qw(%insn_data @insn_name);
+
+sub disassemble_fh {
+    my ($fh, $out) = @_;
+    my ($c, $getmeth, $insn, $arg);
+    bless $fh, "B::Disassembler::BytecodeStream";
+    while (defined($c = $fh->getc)) {
+	$c = ord($c);
+	$insn = $insn_name[$c];
+	if (!defined($insn) || $insn eq "unused") {
+	    my $pos = $fh->tell - 1;
+	    die "Illegal instruction code $c at stream offset $pos\n";
+	}
+	$getmeth = $insn_data{$insn}->[2];
+	$arg = $fh->$getmeth();
+	if (defined($arg)) {
+	    &$out($insn, $arg);
+	} else {
+	    &$out($insn);
+	}
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Disassembler - Disassemble Perl bytecode
+
+=head1 SYNOPSIS
+
+	use Disassembler;
+
+=head1 DESCRIPTION
+
+See F<ext/B/B/Disassembler.pm>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Lint.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Lint.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Lint.pm	(revision 14265)
@@ -0,0 +1,362 @@
+package B::Lint;
+
+=head1 NAME
+
+B::Lint - Perl lint
+
+=head1 SYNOPSIS
+
+perl -MO=Lint[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+The B::Lint module is equivalent to an extended version of the B<-w>
+option of B<perl>. It is named after the program B<lint> which carries
+out a similar process for C programs.
+
+=head1 OPTIONS AND LINT CHECKS
+
+Option words are separated by commas (not whitespace) and follow the
+usual conventions of compiler backend options. Following any options
+(indicated by a leading B<->) come lint check arguments. Each such
+argument (apart from the special B<all> and B<none> options) is a
+word representing one possible lint check (turning on that check) or
+is B<no-foo> (turning off that check). Before processing the check
+arguments, a standard list of checks is turned on. Later options
+override earlier ones. Available options are:
+
+=over 8
+
+=item B<context>
+
+Produces a warning whenever an array is used in an implicit scalar
+context. For example, both of the lines
+
+    $foo = length(@bar);
+    $foo = @bar;
+will elicit a warning. Using an explicit B<scalar()> silences the
+warning. For example,
+
+    $foo = scalar(@bar);
+
+=item B<implicit-read> and B<implicit-write>
+
+These options produce a warning whenever an operation implicitly
+reads or (respectively) writes to one of Perl's special variables.
+For example, B<implicit-read> will warn about these:
+
+    /foo/;
+
+and B<implicit-write> will warn about these:
+
+    s/foo/bar/;
+
+Both B<implicit-read> and B<implicit-write> warn about this:
+
+    for (@a) { ... }
+
+=item B<dollar-underscore>
+
+This option warns whenever $_ is used either explicitly anywhere or
+as the implicit argument of a B<print> statement.
+
+=item B<private-names>
+
+This option warns on each use of any variable, subroutine or
+method name that lives in a non-current package but begins with
+an underscore ("_"). Warnings aren't issued for the special case
+of the single character name "_" by itself (e.g. $_ and @_).
+
+=item B<undefined-subs>
+
+This option warns whenever an undefined subroutine is invoked.
+This option will only catch explicitly invoked subroutines such
+as C<foo()> and not indirect invocations such as C<&$subref()>
+or C<$obj-E<gt>meth()>. Note that some programs or modules delay
+definition of subs until runtime by means of the AUTOLOAD
+mechanism.
+
+=item B<regexp-variables>
+
+This option warns whenever one of the regexp variables $', $& or
+$' is used. Any occurrence of any of these variables in your
+program can slow your whole program down. See L<perlre> for
+details.
+
+=item B<all>
+
+Turn all warnings on.
+
+=item B<none>
+
+Turn all warnings off.
+
+=back
+
+=head1 NON LINT-CHECK OPTIONS
+
+=over 8
+
+=item B<-u Package>
+
+Normally, Lint only checks the main code of the program together
+with all subs defined in package main. The B<-u> option lets you
+include other package names whose subs are then checked by Lint.
+
+=back
+
+=head1 BUGS
+
+This is only a very preliminary version.
+
+=head1 AUTHOR
+
+Malcolm Beattie, mbeattie@sable.ox.ac.uk.
+
+=cut
+
+use strict;
+use B qw(walkoptree main_root walksymtable svref_2object parents
+         OPf_WANT_LIST OPf_WANT OPf_STACKED G_ARRAY
+        );
+
+my $file = "unknown";		# shadows current filename
+my $line = 0;			# shadows current line number
+my $curstash = "main";		# shadows current stash
+
+# Lint checks
+my %check;
+my %implies_ok_context;
+BEGIN {
+    map($implies_ok_context{$_}++,
+	qw(scalar av2arylen aelem aslice helem hslice
+	   keys values hslice defined undef delete));
+}
+
+# Lint checks turned on by default
+my @default_checks = qw(context);
+
+my %valid_check;
+# All valid checks
+BEGIN {
+    map($valid_check{$_}++,
+	qw(context implicit_read implicit_write dollar_underscore
+	   private_names undefined_subs regexp_variables));
+}
+
+# Debugging options
+my ($debug_op);
+
+my %done_cv;		# used to mark which subs have already been linted
+my @extra_packages;	# Lint checks mainline code and all subs which are
+			# in main:: or in one of these packages.
+
+sub warning {
+    my $format = (@_ < 2) ? "%s" : shift;
+    warn sprintf("$format at %s line %d\n", @_, $file, $line);
+}
+
+# This gimme can't cope with context that's only determined
+# at runtime via dowantarray().
+sub gimme {
+    my $op = shift;
+    my $flags = $op->flags;
+    if ($flags & OPf_WANT) {
+	return(($flags & OPf_WANT_LIST) ? 1 : 0);
+    }
+    return undef;
+}
+
+sub B::OP::lint {}
+
+sub B::COP::lint {
+    my $op = shift;
+    if ($op->name eq "nextstate") {
+	$file = $op->file;
+	$line = $op->line;
+	$curstash = $op->stash->NAME;
+    }
+}
+
+sub B::UNOP::lint {
+    my $op = shift;
+    my $opname = $op->name;
+    if ($check{context} && ($opname eq "rv2av" || $opname eq "rv2hv")) {
+	my $parent = parents->[0];
+	my $pname = $parent->name;
+	return if gimme($op) || $implies_ok_context{$pname};
+	# Two special cases to deal with: "foreach (@foo)" and "delete $a{$b}"
+	# null out the parent so we have to check for a parent of pp_null and
+	# a grandparent of pp_enteriter or pp_delete
+	if ($pname eq "null") {
+	    my $gpname = parents->[1]->name;
+	    return if $gpname eq "enteriter" || $gpname eq "delete";
+	}
+	warning("Implicit scalar context for %s in %s",
+		$opname eq "rv2av" ? "array" : "hash", $parent->desc);
+    }
+    if ($check{private_names} && $opname eq "method") {
+	my $methop = $op->first;
+	if ($methop->name eq "const") {
+	    my $method = $methop->sv->PV;
+	    if ($method =~ /^_/ && !defined(&{"$curstash\::$method"})) {
+		warning("Illegal reference to private method name $method");
+	    }
+	}
+    }
+}
+
+sub B::PMOP::lint {
+    my $op = shift;
+    if ($check{implicit_read}) {
+	if ($op->name eq "match" && !($op->flags & OPf_STACKED)) {
+	    warning('Implicit match on $_');
+	}
+    }
+    if ($check{implicit_write}) {
+	if ($op->name eq "subst" && !($op->flags & OPf_STACKED)) {
+	    warning('Implicit substitution on $_');
+	}
+    }
+}
+
+sub B::LOOP::lint {
+    my $op = shift;
+    if ($check{implicit_read} || $check{implicit_write}) {
+	if ($op->name eq "enteriter") {
+	    my $last = $op->last;
+	    if ($last->name eq "gv" && $last->gv->NAME eq "_") {
+		warning('Implicit use of $_ in foreach');
+	    }
+	}
+    }
+}
+
+sub B::SVOP::lint {
+    my $op = shift;
+    if ($check{dollar_underscore} && $op->name eq "gvsv"
+	&& $op->gv->NAME eq "_")
+    {
+	warning('Use of $_');
+    }
+    if ($check{private_names}) {
+	my $opname = $op->name;
+	if ($opname eq "gv" || $opname eq "gvsv") {
+	    my $gv = $op->gv;
+	    if ($gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash) {
+		warning('Illegal reference to private name %s', $gv->NAME);
+	    }
+	}
+    }
+    if ($check{undefined_subs}) {
+	if ($op->name eq "gv"
+	    && $op->next->name eq "entersub")
+	{
+	    my $gv = $op->gv;
+	    my $subname = $gv->STASH->NAME . "::" . $gv->NAME;
+	    no strict 'refs';
+	    if (!defined(&$subname)) {
+		$subname =~ s/^main:://;
+		warning('Undefined subroutine %s called', $subname);
+	    }
+	}
+    }
+    if ($check{regexp_variables} && $op->name eq "gvsv") {
+	my $name = $op->gv->NAME;
+	if ($name =~ /^[&'`]$/) {
+	    warning('Use of regexp variable $%s', $name);
+	}
+    }
+}
+
+sub B::GV::lintcv {
+    my $gv = shift;
+    my $cv = $gv->CV;
+    #warn sprintf("lintcv: %s::%s (done=%d)\n",
+    #		 $gv->STASH->NAME, $gv->NAME, $done_cv{$$cv});#debug
+    return if !$$cv || $done_cv{$$cv}++;
+    my $root = $cv->ROOT;
+    #warn "    root = $root (0x$$root)\n";#debug
+    walkoptree($root, "lint") if $$root;
+}
+
+sub do_lint {
+    my %search_pack;
+    walkoptree(main_root, "lint") if ${main_root()};
+    
+    # Now do subs in main
+    no strict qw(vars refs);
+    my $sym;
+    local(*glob);
+    while (($sym, *glob) = each %{"main::"}) {
+	#warn "Trying $sym\n";#debug
+	svref_2object(\*glob)->EGV->lintcv unless $sym =~ /::$/;
+    }
+
+    # Now do subs in non-main packages given by -u options
+    map { $search_pack{$_} = 1 } @extra_packages;
+    walksymtable(\%{"main::"}, "lintcv", sub {
+	my $package = shift;
+	$package =~ s/::$//;
+	#warn "Considering $package\n";#debug
+	return exists $search_pack{$package};
+    });
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+    # Turn on default lint checks
+    for $opt (@default_checks) {
+	$check{$opt} = 1;
+    }
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "D") {
+            $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "O") {
+		    $debug_op = 1;
+		}
+	    }
+	} elsif ($opt eq "u") {
+	    $arg ||= shift @options;
+	    push(@extra_packages, $arg);
+	}
+    }
+    foreach $opt (@default_checks, @options) {
+	$opt =~ tr/-/_/;
+	if ($opt eq "all") {
+	    %check = %valid_check;
+	}
+	elsif ($opt eq "none") {
+	    %check = ();
+	}
+	else {
+	    if ($opt =~ s/^no-//) {
+		$check{$opt} = 0;
+	    }
+	    else {
+		$check{$opt} = 1;
+	    }
+	    warn "No such check: $opt\n" unless defined $valid_check{$opt};
+	}
+    }
+    # Remaining arguments are things to check
+    
+    return \&do_lint;
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Showlex.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Showlex.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Showlex.pm	(revision 14265)
@@ -0,0 +1,97 @@
+package B::Showlex;
+use strict;
+use B qw(svref_2object comppadlist class);
+use B::Terse ();
+
+#
+# Invoke as
+#     perl -MO=Showlex,foo bar.pl
+# to see the names of lexical variables used by &foo
+# or as
+#     perl -MO=Showlex bar.pl
+# to see the names of file scope lexicals used by bar.pl
+#    
+
+sub shownamearray {
+    my ($name, $av) = @_;
+    my @els = $av->ARRAY;
+    my $count = @els;
+    my $i;
+    print "$name has $count entries\n";
+    for ($i = 0; $i < $count; $i++) {
+        print "$i: ";
+	my $sv = $els[$i];
+	if (class($sv) ne "SPECIAL") {
+	    printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->PVX;
+	} else {
+            $sv->terse;
+	}
+    }
+}
+
+sub showvaluearray {
+    my ($name, $av) = @_;
+    my @els = $av->ARRAY;
+    my $count = @els;
+    my $i;
+    print "$name has $count entries\n";
+    for ($i = 0; $i < $count; $i++) {
+	print "$i: ";
+	$els[$i]->terse;
+    }
+}
+
+sub showlex {
+    my ($objname, $namesav, $valsav) = @_;
+    shownamearray("Pad of lexical names for $objname", $namesav);
+    showvaluearray("Pad of lexical values for $objname", $valsav);
+}
+
+sub showlex_obj {
+    my ($objname, $obj) = @_;
+    $objname =~ s/^&main::/&/;
+    showlex($objname, svref_2object($obj)->PADLIST->ARRAY);
+}
+
+sub showlex_main {
+    showlex("comppadlist", comppadlist->ARRAY);
+}
+
+sub compile {
+    my @options = @_;
+    if (@options) {
+	return sub {
+	    my $objname;
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		eval "showlex_obj('&$objname', \\&$objname)";
+	    }
+	}
+    } else {
+	return \&showlex_main;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Showlex - Show lexical variables used in functions or files
+
+=head1 SYNOPSIS
+
+	perl -MO=Showlex[,SUBROUTINE] foo.pl
+
+=head1 DESCRIPTION
+
+When a subroutine name is provided in OPTIONS, prints the lexical
+variables used in that subroutine.  Otherwise, prints the file-scope
+lexicals in the file.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Stackobj.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Stackobj.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Stackobj.pm	(revision 14265)
@@ -0,0 +1,346 @@
+#      Stackobj.pm
+#
+#      Copyright (c) 1996 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B::Stackobj;  
+use Exporter ();
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(set_callback T_UNKNOWN T_DOUBLE T_INT VALID_UNSIGNED
+		VALID_INT VALID_DOUBLE VALID_SV REGISTER TEMPORARY);
+%EXPORT_TAGS = (types => [qw(T_UNKNOWN T_DOUBLE T_INT)],
+		flags => [qw(VALID_INT VALID_DOUBLE VALID_SV
+			     VALID_UNSIGNED REGISTER TEMPORARY)]);
+
+use Carp qw(confess);
+use strict;
+use B qw(class SVf_IOK SVf_NOK SVf_IVisUV);
+
+# Types
+sub T_UNKNOWN () { 0 }
+sub T_DOUBLE ()  { 1 }
+sub T_INT ()     { 2 }
+sub T_SPECIAL () { 3 }
+
+# Flags
+sub VALID_INT ()	{ 0x01 }
+sub VALID_UNSIGNED ()	{ 0x02 }
+sub VALID_DOUBLE ()	{ 0x04 }
+sub VALID_SV ()		{ 0x08 }
+sub REGISTER ()		{ 0x10 } # no implicit write-back when calling subs
+sub TEMPORARY ()	{ 0x20 } # no implicit write-back needed at all
+sub SAVE_INT () 	{ 0x40 } #if int part needs to be saved at all
+sub SAVE_DOUBLE () 	{ 0x80 } #if double part needs to be saved at all
+
+
+#
+# Callback for runtime code generation
+#
+my $runtime_callback = sub { confess "set_callback not yet called" };
+sub set_callback (&) { $runtime_callback = shift }
+sub runtime { &$runtime_callback(@_) }
+
+#
+# Methods
+#
+
+sub write_back { confess "stack object does not implement write_back" }
+
+sub invalidate { shift->{flags} &= ~(VALID_INT |VALID_UNSIGNED | VALID_DOUBLE) }
+
+sub as_sv {
+    my $obj = shift;
+    if (!($obj->{flags} & VALID_SV)) {
+	$obj->write_back;
+	$obj->{flags} |= VALID_SV;
+    }
+    return $obj->{sv};
+}
+
+sub as_int {
+    my $obj = shift;
+    if (!($obj->{flags} & VALID_INT)) {
+	$obj->load_int;
+	$obj->{flags} |= VALID_INT|SAVE_INT;
+    }
+    return $obj->{iv};
+}
+
+sub as_double {
+    my $obj = shift;
+    if (!($obj->{flags} & VALID_DOUBLE)) {
+	$obj->load_double;
+	$obj->{flags} |= VALID_DOUBLE|SAVE_DOUBLE;
+    }
+    return $obj->{nv};
+}
+
+sub as_numeric {
+    my $obj = shift;
+    return $obj->{type} == T_INT ? $obj->as_int : $obj->as_double;
+}
+
+sub as_bool {
+	my $obj=shift;
+	if ($obj->{flags} & VALID_INT ){
+		return $obj->{iv}; 
+	}
+	if ($obj->{flags} & VALID_DOUBLE ){
+		return $obj->{nv}; 
+	}
+	return sprintf("(SvTRUE(%s))", $obj->as_sv) ;
+}
+
+#
+# Debugging methods
+#
+sub peek {
+    my $obj = shift;
+    my $type = $obj->{type};
+    my $flags = $obj->{flags};
+    my @flags;
+    if ($type == T_UNKNOWN) {
+	$type = "T_UNKNOWN";
+    } elsif ($type == T_INT) {
+	$type = "T_INT";
+    } elsif ($type == T_DOUBLE) {
+	$type = "T_DOUBLE";
+    } else {
+	$type = "(illegal type $type)";
+    }
+    push(@flags, "VALID_INT") if $flags & VALID_INT;
+    push(@flags, "VALID_DOUBLE") if $flags & VALID_DOUBLE;
+    push(@flags, "VALID_SV") if $flags & VALID_SV;
+    push(@flags, "REGISTER") if $flags & REGISTER;
+    push(@flags, "TEMPORARY") if $flags & TEMPORARY;
+    @flags = ("none") unless @flags;
+    return sprintf("%s type=$type flags=%s sv=$obj->{sv}",
+		   class($obj), join("|", @flags));
+}
+
+sub minipeek {
+    my $obj = shift;
+    my $type = $obj->{type};
+    my $flags = $obj->{flags};
+    if ($type == T_INT || $flags & VALID_INT) {
+	return $obj->{iv};
+    } elsif ($type == T_DOUBLE || $flags & VALID_DOUBLE) {
+	return $obj->{nv};
+    } else {
+	return $obj->{sv};
+    }
+}
+
+#
+# Caller needs to ensure that set_int, set_double,
+# set_numeric and set_sv are only invoked on legal lvalues.
+#
+sub set_int {
+    my ($obj, $expr,$unsigned) = @_;
+    runtime("$obj->{iv} = $expr;");
+    $obj->{flags} &= ~(VALID_SV | VALID_DOUBLE);
+    $obj->{flags} |= VALID_INT|SAVE_INT;
+    $obj->{flags} |= VALID_UNSIGNED if $unsigned; 
+}
+
+sub set_double {
+    my ($obj, $expr) = @_;
+    runtime("$obj->{nv} = $expr;");
+    $obj->{flags} &= ~(VALID_SV | VALID_INT);
+    $obj->{flags} |= VALID_DOUBLE|SAVE_DOUBLE;
+}
+
+sub set_numeric {
+    my ($obj, $expr) = @_;
+    if ($obj->{type} == T_INT) {
+	$obj->set_int($expr);
+    } else {
+	$obj->set_double($expr);
+    }
+}
+
+sub set_sv {
+    my ($obj, $expr) = @_;
+    runtime("SvSetSV($obj->{sv}, $expr);");
+    $obj->invalidate;
+    $obj->{flags} |= VALID_SV;
+}
+
+#
+# Stackobj::Padsv
+#
+
+@B::Stackobj::Padsv::ISA = 'B::Stackobj';
+sub B::Stackobj::Padsv::new {
+    my ($class, $type, $extra_flags, $ix, $iname, $dname) = @_;
+    $extra_flags |= SAVE_INT if $extra_flags & VALID_INT;
+    $extra_flags |= SAVE_DOUBLE if $extra_flags & VALID_DOUBLE;
+    bless {
+	type => $type,
+	flags => VALID_SV | $extra_flags,
+	sv => "PL_curpad[$ix]",
+	iv => "$iname",
+	nv => "$dname"
+    }, $class;
+}
+
+sub B::Stackobj::Padsv::load_int {
+    my $obj = shift;
+    if ($obj->{flags} & VALID_DOUBLE) {
+	runtime("$obj->{iv} = $obj->{nv};");
+    } else {
+	runtime("$obj->{iv} = SvIV($obj->{sv});");
+    }
+    $obj->{flags} |= VALID_INT|SAVE_INT;
+}
+
+sub B::Stackobj::Padsv::load_double {
+    my $obj = shift;
+    $obj->write_back;
+    runtime("$obj->{nv} = SvNV($obj->{sv});");
+    $obj->{flags} |= VALID_DOUBLE|SAVE_DOUBLE;
+}
+sub B::Stackobj::Padsv::save_int {
+    my $obj = shift;
+    return $obj->{flags} & SAVE_INT;
+}
+
+sub B::Stackobj::Padsv::save_double {
+    my $obj = shift;
+    return $obj->{flags} & SAVE_DOUBLE;
+}
+
+sub B::Stackobj::Padsv::write_back {
+    my $obj = shift;
+    my $flags = $obj->{flags};
+    return if $flags & VALID_SV;
+    if ($flags & VALID_INT) {
+        if ($flags & VALID_UNSIGNED ){
+            runtime("sv_setuv($obj->{sv}, $obj->{iv});");
+        }else{
+            runtime("sv_setiv($obj->{sv}, $obj->{iv});");
+        }     
+    } elsif ($flags & VALID_DOUBLE) {
+	runtime("sv_setnv($obj->{sv}, $obj->{nv});");
+    } else {
+	confess "write_back failed for lexical @{[$obj->peek]}\n";
+    }
+    $obj->{flags} |= VALID_SV;
+}
+
+#
+# Stackobj::Const
+#
+
+@B::Stackobj::Const::ISA = 'B::Stackobj';
+sub B::Stackobj::Const::new {
+    my ($class, $sv) = @_;
+    my $obj = bless {
+	flags => 0,
+	sv => $sv    # holds the SV object until write_back happens
+    }, $class;
+    if ( ref($sv) eq  "B::SPECIAL" ){
+	$obj->{type}= T_SPECIAL;	
+    }else{
+    	my $svflags = $sv->FLAGS;
+    	if ($svflags & SVf_IOK) {
+		$obj->{flags} = VALID_INT|VALID_DOUBLE;
+		$obj->{type} = T_INT;
+                if ($svflags & SVf_IVisUV){
+                    $obj->{flags} |= VALID_UNSIGNED;
+                    $obj->{nv} = $obj->{iv} = $sv->UVX;
+                }else{
+                    $obj->{nv} = $obj->{iv} = $sv->IV;
+                }
+    	} elsif ($svflags & SVf_NOK) {
+		$obj->{flags} = VALID_INT|VALID_DOUBLE;
+		$obj->{type} = T_DOUBLE;
+		$obj->{iv} = $obj->{nv} = $sv->NV;
+    	} else {
+		$obj->{type} = T_UNKNOWN;
+    	}
+    }
+    return $obj;
+}
+
+sub B::Stackobj::Const::write_back {
+    my $obj = shift;
+    return if $obj->{flags} & VALID_SV;
+    # Save the SV object and replace $obj->{sv} by its C source code name
+    $obj->{sv} = $obj->{sv}->save;
+    $obj->{flags} |= VALID_SV|VALID_INT|VALID_DOUBLE;
+}
+
+sub B::Stackobj::Const::load_int {
+    my $obj = shift;
+    if (ref($obj->{sv}) eq "B::RV"){
+       $obj->{iv} = int($obj->{sv}->RV->PV);
+    }else{
+       $obj->{iv} = int($obj->{sv}->PV);
+    }
+    $obj->{flags} |= VALID_INT;
+}
+
+sub B::Stackobj::Const::load_double {
+    my $obj = shift;
+    if (ref($obj->{sv}) eq "B::RV"){
+        $obj->{nv} = $obj->{sv}->RV->PV + 0.0;
+    }else{
+        $obj->{nv} = $obj->{sv}->PV + 0.0;
+    }
+    $obj->{flags} |= VALID_DOUBLE;
+}
+
+sub B::Stackobj::Const::invalidate {}
+
+#
+# Stackobj::Bool
+#
+
+@B::Stackobj::Bool::ISA = 'B::Stackobj';
+sub B::Stackobj::Bool::new {
+    my ($class, $preg) = @_;
+    my $obj = bless {
+	type => T_INT,
+	flags => VALID_INT|VALID_DOUBLE,
+	iv => $$preg,
+	nv => $$preg,
+	preg => $preg		# this holds our ref to the pseudo-reg
+    }, $class;
+    return $obj;
+}
+
+sub B::Stackobj::Bool::write_back {
+    my $obj = shift;
+    return if $obj->{flags} & VALID_SV;
+    $obj->{sv} = "($obj->{iv} ? &PL_sv_yes : &PL_sv_no)";
+    $obj->{flags} |= VALID_SV;
+}
+
+# XXX Might want to handle as_double/set_double/load_double?
+
+sub B::Stackobj::Bool::invalidate {}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Stackobj - Helper module for CC backend
+
+=head1 SYNOPSIS
+
+	use B::Stackobj;
+
+=head1 DESCRIPTION
+
+See F<ext/B/README>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Stash.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Stash.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Stash.pm	(revision 14265)
@@ -0,0 +1,50 @@
+# Stash.pm -- show what stashes are loaded
+# vishalb@hotmail.com 
+package B::Stash;
+
+=pod
+
+=head1 NAME
+
+B::Stash - show what stashes are loaded
+
+=cut
+
+BEGIN { %Seen = %INC }
+
+CHECK {
+	my @arr=scan($main::{"main::"});
+       @arr=map{s/\:\:$//;$_ eq "<none>"?():$_;}  @arr;
+	print "-umain,-u", join (",-u",@arr) ,"\n";
+}
+sub scan{
+	my $start=shift;
+	my $prefix=shift;
+	$prefix = '' unless defined $prefix;
+	my @return;
+	foreach my $key ( keys %{$start}){
+#		print $prefix,$key,"\n";
+		if ($key =~ /::$/){
+			unless ($start  eq ${$start}{$key} or $key eq "B::" ){
+		 		push @return, $key unless omit($prefix.$key);
+				foreach my $subscan ( scan(${$start}{$key},$prefix.$key)){
+		 			push @return, "$key".$subscan; 	
+				}
+			}
+		}
+	}
+	return @return;
+}
+sub omit{
+	my $module = shift;
+	my %omit=("DynaLoader::" => 1 , "XSLoader::" => 1, "CORE::" => 1 ,
+		"CORE::GLOBAL::" => 1, "UNIVERSAL::" => 1 );
+	return 1 if $omit{$module};
+	if ($module eq "IO::" or $module eq "IO::Handle::"){
+		$module =~ s/::/\//g;	
+		return 1 unless  $INC{$module};
+	}
+
+	return 0;
+}
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Terse.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Terse.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Terse.pm	(revision 14265)
@@ -0,0 +1,153 @@
+package B::Terse;
+use strict;
+use B qw(peekop class walkoptree walkoptree_exec walkoptree_slow
+	 main_start main_root cstring svref_2object SVf_IVisUV);
+use B::Asmdata qw(@specialsv_name);
+
+sub terse {
+    my ($order, $cvref) = @_;
+    my $cv = svref_2object($cvref);
+    if ($order eq "exec") {
+	walkoptree_exec($cv->START, "terse");
+    } else {
+	walkoptree_slow($cv->ROOT, "terse");
+    }
+}
+
+sub compile {
+    my $order = @_ ? shift : "";
+    my @options = @_;
+    B::clearsym();
+    if (@options) {
+	return sub {
+	    my $objname;
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		eval "terse(\$order, \\&$objname)";
+		die "terse($order, \\&$objname) failed: $@" if $@;
+	    }
+	}
+    } else {
+	if ($order eq "exec") {
+	    return sub { walkoptree_exec(main_start, "terse") }
+	} else {
+	    return sub { walkoptree_slow(main_root, "terse") }
+	}
+    }
+}
+
+sub indent {
+    my $level = @_ ? shift : 0;
+    return "    " x $level;
+}
+
+sub B::OP::terse {
+    my ($op, $level) = @_;
+    my $targ = $op->targ;
+    $targ = ($targ > 0) ? " [$targ]" : "";
+    print indent($level), peekop($op), $targ, "\n";
+}
+
+sub B::SVOP::terse {
+    my ($op, $level) = @_;
+    print indent($level), peekop($op), "  ";
+    $op->sv->terse(0);
+}
+
+sub B::PADOP::terse {
+    my ($op, $level) = @_;
+    print indent($level), peekop($op), "  ", $op->padix, "\n";
+}
+
+sub B::PMOP::terse {
+    my ($op, $level) = @_;
+    my $precomp = $op->precomp;
+    print indent($level), peekop($op),
+	defined($precomp) ? " /$precomp/\n" : " (regexp not compiled)\n";
+
+}
+
+sub B::PVOP::terse {
+    my ($op, $level) = @_;
+    print indent($level), peekop($op), " ", cstring($op->pv), "\n";
+}
+
+sub B::COP::terse {
+    my ($op, $level) = @_;
+    my $label = $op->label;
+    if ($label) {
+	$label = " label ".cstring($label);
+    }
+    print indent($level), peekop($op), $label || "", "\n";
+}
+
+sub B::PV::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx) %s\n", class($sv), $$sv, cstring($sv->PV);
+}
+
+sub B::AV::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx) FILL %d\n", class($sv), $$sv, $sv->FILL;
+}
+
+sub B::GV::terse {
+    my ($gv, $level) = @_;
+    my $stash = $gv->STASH->NAME;
+    if ($stash eq "main") {
+	$stash = "";
+    } else {
+	$stash = $stash . "::";
+    }
+    print indent($level);
+    printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->SAFENAME;
+}
+
+sub B::IV::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    my $v = $sv->FLAGS & SVf_IVisUV ? "%u" : "%d";
+    printf "%s (0x%lx) $v\n", class($sv), $$sv, $sv->int_value;
+}
+
+sub B::NV::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV;
+}
+
+sub B::NULL::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx)\n", class($sv), $$sv;
+}
+    
+sub B::SPECIAL::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s #%d %s\n", class($sv), $$sv, $specialsv_name[$$sv];
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Terse - Walk Perl syntax tree, printing terse info about ops
+
+=head1 SYNOPSIS
+
+	perl -MO=Terse[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+See F<ext/B/README>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/B/Xref.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/Xref.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/Xref.pm	(revision 14265)
@@ -0,0 +1,420 @@
+package B::Xref;
+
+=head1 NAME
+
+B::Xref - Generates cross reference reports for Perl programs
+
+=head1 SYNOPSIS
+
+perl -MO=Xref[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+The B::Xref module is used to generate a cross reference listing of all
+definitions and uses of variables, subroutines and formats in a Perl program.
+It is implemented as a backend for the Perl compiler.
+
+The report generated is in the following format:
+
+    File filename1
+      Subroutine subname1
+	Package package1
+	  object1        C<line numbers>
+	  object2        C<line numbers>
+	  ...
+	Package package2
+	...
+
+Each B<File> section reports on a single file. Each B<Subroutine> section
+reports on a single subroutine apart from the special cases
+"(definitions)" and "(main)". These report, respectively, on subroutine
+definitions found by the initial symbol table walk and on the main part of
+the program or module external to all subroutines.
+
+The report is then grouped by the B<Package> of each variable,
+subroutine or format with the special case "(lexicals)" meaning
+lexical variables. Each B<object> name (implicitly qualified by its
+containing B<Package>) includes its type character(s) at the beginning
+where possible. Lexical variables are easier to track and even
+included dereferencing information where possible.
+
+The C<line numbers> are a comma separated list of line numbers (some
+preceded by code letters) where that object is used in some way.
+Simple uses aren't preceded by a code letter. Introductions (such as
+where a lexical is first defined with C<my>) are indicated with the
+letter "i". Subroutine and method calls are indicated by the character
+"&".  Subroutine definitions are indicated by "s" and format
+definitions by "f".
+
+=head1 OPTIONS
+
+Option words are separated by commas (not whitespace) and follow the
+usual conventions of compiler backend options.
+
+=over 8
+
+=item C<-oFILENAME>
+
+Directs output to C<FILENAME> instead of standard output.
+
+=item C<-r>
+
+Raw output. Instead of producing a human-readable report, outputs a line
+in machine-readable form for each definition/use of a variable/sub/format.
+
+=item C<-D[tO]>
+
+(Internal) debug options, probably only useful if C<-r> included.
+The C<t> option prints the object on the top of the stack as it's
+being tracked. The C<O> option prints each operator as it's being
+processed in the execution order of the program.
+
+=back
+
+=head1 BUGS
+
+Non-lexical variables are quite difficult to track through a program.
+Sometimes the type of a non-lexical variable's use is impossible to
+determine. Introductions of non-lexical non-scalars don't seem to be
+reported properly.
+
+=head1 AUTHOR
+
+Malcolm Beattie, mbeattie@sable.ox.ac.uk.
+
+=cut
+
+use strict;
+use Config;
+use B qw(peekop class comppadlist main_start svref_2object walksymtable
+         OPpLVAL_INTRO SVf_POK
+        );
+
+sub UNKNOWN { ["?", "?", "?"] }
+
+my @pad;			# lexicals in current pad
+				# as ["(lexical)", type, name]
+my %done;			# keyed by $$op: set when each $op is done
+my $top = UNKNOWN;		# shadows top element of stack as
+				# [pack, type, name] (pack can be "(lexical)")
+my $file;			# shadows current filename
+my $line;			# shadows current line number
+my $subname;			# shadows current sub name
+my %table;			# Multi-level hash to record all uses etc.
+my @todo = ();			# List of CVs that need processing
+
+my %code = (intro => "i", used => "",
+	    subdef => "s", subused => "&",
+	    formdef => "f", meth => "->");
+
+
+# Options
+my ($debug_op, $debug_top, $nodefs, $raw);
+
+sub process {
+    my ($var, $event) = @_;
+    my ($pack, $type, $name) = @$var;
+    if ($type eq "*") {
+	if ($event eq "used") {
+	    return;
+	} elsif ($event eq "subused") {
+	    $type = "&";
+	}
+    }
+    $type =~ s/(.)\*$/$1/g;
+    if ($raw) {
+	printf "%-16s %-12s %5d %-12s %4s %-16s %s\n",
+	    $file, $subname, $line, $pack, $type, $name, $event;
+    } else {
+	# Wheee
+	push(@{$table{$file}->{$subname}->{$pack}->{$type.$name}->{$event}},
+	    $line);
+    }
+}
+
+sub load_pad {
+    my $padlist = shift;
+    my ($namelistav, $vallistav, @namelist, $ix);
+    @pad = ();
+    return if class($padlist) eq "SPECIAL";
+    ($namelistav,$vallistav) = $padlist->ARRAY;
+    @namelist = $namelistav->ARRAY;
+    for ($ix = 1; $ix < @namelist; $ix++) {
+	my $namesv = $namelist[$ix];
+	next if class($namesv) eq "SPECIAL";
+	my ($type, $name) = $namesv->PV =~ /^(.)([^\0]*)(\0.*)?$/;
+	$pad[$ix] = ["(lexical)", $type, $name];
+    }
+    if ($Config{useithreads}) {
+	my (@vallist);
+	@vallist = $vallistav->ARRAY;
+	for ($ix = 1; $ix < @vallist; $ix++) {
+	    my $valsv = $vallist[$ix];
+	    next unless class($valsv) eq "GV";
+	    # these pad GVs don't have corresponding names, so same @pad
+	    # array can be used without collisions
+	    $pad[$ix] = [$valsv->STASH->NAME, "*", $valsv->NAME];
+	}
+    }
+}
+
+sub xref {
+    my $start = shift;
+    my $op;
+    for ($op = $start; $$op; $op = $op->next) {
+	last if $done{$$op}++;
+	warn sprintf("top = [%s, %s, %s]\n", @$top) if $debug_top;
+	warn peekop($op), "\n" if $debug_op;
+	my $opname = $op->name;
+	if ($opname =~ /^(or|and|mapwhile|grepwhile|range|cond_expr)$/) {
+	    xref($op->other);
+	} elsif ($opname eq "match" || $opname eq "subst") {
+	    xref($op->pmreplstart);
+	} elsif ($opname eq "substcont") {
+	    xref($op->other->pmreplstart);
+	    $op = $op->other;
+	    redo;
+	} elsif ($opname eq "enterloop") {
+	    xref($op->redoop);
+	    xref($op->nextop);
+	    xref($op->lastop);
+	} elsif ($opname eq "subst") {
+	    xref($op->pmreplstart);
+	} else {
+	    no strict 'refs';
+	    my $ppname = "pp_$opname";
+	    &$ppname($op) if defined(&$ppname);
+	}
+    }
+}
+
+sub xref_cv {
+    my $cv = shift;
+    my $pack = $cv->GV->STASH->NAME;
+    $subname = ($pack eq "main" ? "" : "$pack\::") . $cv->GV->NAME;
+    load_pad($cv->PADLIST);
+    xref($cv->START);
+    $subname = "(main)";
+}
+
+sub xref_object {
+    my $cvref = shift;
+    xref_cv(svref_2object($cvref));
+}
+
+sub xref_main {
+    $subname = "(main)";
+    load_pad(comppadlist);
+    xref(main_start);
+    while (@todo) {
+	xref_cv(shift @todo);
+    }
+}
+
+sub pp_nextstate {
+    my $op = shift;
+    $file = $op->file;
+    $line = $op->line;
+    $top = UNKNOWN;
+}
+
+sub pp_padsv {
+    my $op = shift;
+    $top = $pad[$op->targ];
+    process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+}
+
+sub pp_padav { pp_padsv(@_) }
+sub pp_padhv { pp_padsv(@_) }
+
+sub deref {
+    my ($var, $as) = @_;
+    $var->[1] = $as . $var->[1];
+    process($var, "used");
+}
+
+sub pp_rv2cv { deref($top, "&"); }
+sub pp_rv2hv { deref($top, "%"); }
+sub pp_rv2sv { deref($top, "\$"); }
+sub pp_rv2av { deref($top, "\@"); }
+sub pp_rv2gv { deref($top, "*"); }
+
+sub pp_gvsv {
+    my $op = shift;
+    my $gv;
+    if ($Config{useithreads}) {
+	$top = $pad[$op->padix];
+	$top = UNKNOWN unless $top;
+	$top->[1] = '$';
+    }
+    else {
+	$gv = $op->gv;
+	$top = [$gv->STASH->NAME, '$', $gv->NAME];
+    }
+    process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+}
+
+sub pp_gv {
+    my $op = shift;
+    my $gv;
+    if ($Config{useithreads}) {
+	$top = $pad[$op->padix];
+	$top = UNKNOWN unless $top;
+	$top->[1] = '*';
+    }
+    else {
+	$gv = $op->gv;
+	$top = [$gv->STASH->NAME, "*", $gv->NAME];
+    }
+    process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+}
+
+sub pp_const {
+    my $op = shift;
+    my $sv = $op->sv;
+    # constant could be in the pad (under useithreads)
+    if ($$sv) {
+	$top = ["?", "",
+		(class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"];
+    }
+    else {
+	$top = $pad[$op->targ];
+    }
+}
+
+sub pp_method {
+    my $op = shift;
+    $top = ["(method)", "->".$top->[1], $top->[2]];
+}
+
+sub pp_entersub {
+    my $op = shift;
+    if ($top->[1] eq "m") {
+	process($top, "meth");
+    } else {
+	process($top, "subused");
+    }
+    $top = UNKNOWN;
+}
+
+#
+# Stuff for cross referencing definitions of variables and subs
+#
+
+sub B::GV::xref {
+    my $gv = shift;
+    my $cv = $gv->CV;
+    if ($$cv) {
+	#return if $done{$$cv}++;
+	$file = $gv->FILE;
+	$line = $gv->LINE;
+	process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
+	push(@todo, $cv);
+    }
+    my $form = $gv->FORM;
+    if ($$form) {
+	return if $done{$$form}++;
+	$file = $gv->FILE;
+	$line = $gv->LINE;
+	process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
+    }
+}
+
+sub xref_definitions {
+    my ($pack, %exclude);
+    return if $nodefs;
+    $subname = "(definitions)";
+    foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS
+		      strict vars FileHandle Exporter Carp)) {
+        $exclude{$pack."::"} = 1;
+    }
+    no strict qw(vars refs);
+    walksymtable(\%{"main::"}, "xref", sub { !defined($exclude{$_[0]}) });
+}
+
+sub output {
+    return if $raw;
+    my ($file, $subname, $pack, $name, $ev, $perfile, $persubname,
+	$perpack, $pername, $perev);
+    foreach $file (sort(keys(%table))) {
+	$perfile = $table{$file};
+	print "File $file\n";
+	foreach $subname (sort(keys(%$perfile))) {
+	    $persubname = $perfile->{$subname};
+	    print "  Subroutine $subname\n";
+	    foreach $pack (sort(keys(%$persubname))) {
+		$perpack = $persubname->{$pack};
+		print "    Package $pack\n";
+		foreach $name (sort(keys(%$perpack))) {
+		    $pername = $perpack->{$name};
+		    my @lines;
+		    foreach $ev (qw(intro formdef subdef meth subused used)) {
+			$perev = $pername->{$ev};
+			if (defined($perev) && @$perev) {
+			    my $code = $code{$ev};
+			    push(@lines, map("$code$_", @$perev));
+			}
+		    }
+		    printf "      %-16s  %s\n", $name, join(", ", @lines);
+		}
+	    }
+	}
+    }
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "o") {
+	    $arg ||= shift @options;
+	    open(STDOUT, ">$arg") or return "$arg: $!\n";
+	} elsif ($opt eq "d") {
+	    $nodefs = 1;
+	} elsif ($opt eq "r") {
+	    $raw = 1;
+	} elsif ($opt eq "D") {
+            $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "O") {
+		    $debug_op = 1;
+		} elsif ($arg eq "t") {
+		    $debug_top = 1;
+		}
+	    }
+	}
+    }
+    if (@options) {
+	return sub {
+	    my $objname;
+	    xref_definitions();
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		eval "xref_object(\\&$objname)";
+		die "xref_object(\\&$objname) failed: $@" if $@;
+	    }
+	    output();
+	}
+    } else {
+	return sub {
+	    xref_definitions();
+	    xref_main();
+	    output();
+	}
+    }
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/B/assemble
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/assemble	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/assemble	(revision 14265)
@@ -0,0 +1,30 @@
+use B::Assembler qw(assemble_fh);
+use FileHandle;
+
+my ($filename, $fh, $out);
+
+if ($ARGV[0] eq "-d") {
+    B::Assembler::debug(1);
+    shift;
+}
+
+$out = \*STDOUT;
+
+if (@ARGV == 0) {
+    $fh = \*STDIN;
+    $filename = "-";
+} elsif (@ARGV == 1) {
+    $filename = $ARGV[0];
+    $fh = new FileHandle "<$filename";
+} elsif (@ARGV == 2) {
+    $filename = $ARGV[0];
+    $fh = new FileHandle "<$filename";
+    $out = new FileHandle ">$ARGV[1]";
+} else {
+    die "Usage: assemble [filename] [outfilename]\n";
+}
+
+binmode $out;
+$SIG{__WARN__} = sub { warn "$filename:@_" };
+$SIG{__DIE__} = sub { die "$filename: @_" };
+assemble_fh($fh, sub { print $out @_ });
Index: /for-distributions/trunk/bin/windows/perl/lib/B/cc_harness
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/cc_harness	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/cc_harness	(revision 14265)
@@ -0,0 +1,12 @@
+use Config;
+
+$libdir = $ENV{PERL_SRC} || "$Config{installarchlib}/CORE";
+
+if (!grep(/^-[cS]$/, @ARGV)) {
+    $linkargs = sprintf("%s $libdir/$Config{libperl} %s",
+			@Config{qw(ldflags libs)});
+}
+
+$cccmd = "$Config{cc} $Config{ccflags} -I$libdir @ARGV $linkargs";
+print "$cccmd\n";
+exec $cccmd;
Index: /for-distributions/trunk/bin/windows/perl/lib/B/disassemble
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/disassemble	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/disassemble	(revision 14265)
@@ -0,0 +1,22 @@
+use B::Disassembler qw(disassemble_fh);
+use FileHandle;
+
+my $fh;
+if (@ARGV == 0) {
+    $fh = \*STDIN;
+} elsif (@ARGV == 1) {
+    $fh = new FileHandle "<$ARGV[0]";
+} else {
+    die "Usage: disassemble [filename]\n";
+}
+
+sub print_insn {
+    my ($insn, $arg) = @_;
+    if (defined($arg)) {
+	printf "%s %s\n", $insn, $arg;
+    } else {
+	print $insn, "\n";
+    }
+}
+
+disassemble_fh($fh, \&print_insn);
Index: /for-distributions/trunk/bin/windows/perl/lib/B/makeliblinks
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/B/makeliblinks	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/B/makeliblinks	(revision 14265)
@@ -0,0 +1,54 @@
+use File::Find;
+use Config;
+
+if (@ARGV != 2) {
+    warn <<"EOT";
+Usage: makeliblinks libautodir targetdir
+where libautodir is the architecture-dependent auto directory
+(e.g. $Config::Config{archlib}/auto).
+EOT
+    exit 2;
+}
+
+my ($libautodir, $targetdir) = @ARGV;
+
+# Calculate relative path prefix from $targetdir to $libautodir
+sub relprefix {
+    my ($to, $from) = @_;
+    my $up;
+    for ($up = 0; substr($to, 0, length($from)) ne $from; $up++) {
+	$from =~ s(
+		   [^/]+	(?# a group of non-slashes) 
+		   /*		(?# maybe with some trailing slashes)
+		   $		(?# at the end of the path)
+                  )()x;
+    }
+    return (("../" x $up) . substr($to, length($from)));
+}
+
+my $relprefix = relprefix($libautodir, $targetdir);
+
+my ($dlext, $lib_ext) = @Config::Config{qw(dlext lib_ext)};
+
+sub link_if_library {
+    if (/\.($dlext|$lib_ext)$/o) {
+	my $ext = $1;
+	my $name = $File::Find::name;
+	if (substr($name, 0, length($libautodir) + 1) ne "$libautodir/") {
+	    die "directory of $name doesn't match $libautodir\n";
+	}
+	substr($name, 0, length($libautodir) + 1) = '';
+	my @parts = split(m(/), $name);
+	if ($parts[-1] ne "$parts[-2].$ext") {
+	    die "module name $_ doesn't match its directory $libautodir\n";
+	}
+	pop @parts;
+	my $libpath = "$targetdir/lib" . join("__", @parts) . ".$ext";
+	print "$libpath -> $relprefix/$name\n";
+	symlink("$relprefix/$name", $libpath)
+	    or warn "above link failed with error: $!\n";
+    }
+}
+
+find(\&link_if_library, $libautodir);
+exit 0;
Index: /for-distributions/trunk/bin/windows/perl/lib/CGI/Apache.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/CGI/Apache.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/CGI/Apache.pm	(revision 14265)
@@ -0,0 +1,23 @@
+use CGI;
+1;
+__END__
+
+=head1 NAME
+
+CGI::Apache - Backward compatibility module for CGI.pm
+
+=head1 SYNOPSIS
+
+Do not use this module.  It is deprecated.
+
+=head1 ABSTRACT
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR INFORMATION
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/CGI/Carp.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/CGI/Carp.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/CGI/Carp.pm	(revision 14265)
@@ -0,0 +1,428 @@
+package CGI::Carp;
+
+=head1 NAME
+
+B<CGI::Carp> - CGI routines for writing to the HTTPD (or other) error log
+
+=head1 SYNOPSIS
+
+    use CGI::Carp;
+
+    croak "We're outta here!";
+    confess "It was my fault: $!";
+    carp "It was your fault!";   
+    warn "I'm confused";
+    die  "I'm dying.\n";
+
+    use CGI::Carp qw(cluck);
+    cluck "I wouldn't do that if I were you";
+
+    use CGI::Carp qw(fatalsToBrowser);
+    die "Fatal error messages are now sent to browser";
+
+=head1 DESCRIPTION
+
+CGI scripts have a nasty habit of leaving warning messages in the error
+logs that are neither time stamped nor fully identified.  Tracking down
+the script that caused the error is a pain.  This fixes that.  Replace
+the usual
+
+    use Carp;
+
+with
+
+    use CGI::Carp
+
+And the standard warn(), die (), croak(), confess() and carp() calls
+will automagically be replaced with functions that write out nicely
+time-stamped messages to the HTTP server error log.
+
+For example:
+
+   [Fri Nov 17 21:40:43 1995] test.pl: I'm confused at test.pl line 3.
+   [Fri Nov 17 21:40:43 1995] test.pl: Got an error message: Permission denied.
+   [Fri Nov 17 21:40:43 1995] test.pl: I'm dying.
+
+=head1 REDIRECTING ERROR MESSAGES
+
+By default, error messages are sent to STDERR.  Most HTTPD servers
+direct STDERR to the server's error log.  Some applications may wish
+to keep private error logs, distinct from the server's error log, or
+they may wish to direct error messages to STDOUT so that the browser
+will receive them.
+
+The C<carpout()> function is provided for this purpose.  Since
+carpout() is not exported by default, you must import it explicitly by
+saying
+
+   use CGI::Carp qw(carpout);
+
+The carpout() function requires one argument, which should be a
+reference to an open filehandle for writing errors.  It should be
+called in a C<BEGIN> block at the top of the CGI application so that
+compiler errors will be caught.  Example:
+
+   BEGIN {
+     use CGI::Carp qw(carpout);
+     open(LOG, ">>/usr/local/cgi-logs/mycgi-log") or
+       die("Unable to open mycgi-log: $!\n");
+     carpout(LOG);
+   }
+
+carpout() does not handle file locking on the log for you at this point.
+
+The real STDERR is not closed -- it is moved to CGI::Carp::SAVEERR.  Some
+servers, when dealing with CGI scripts, close their connection to the
+browser when the script closes STDOUT and STDERR.  CGI::Carp::SAVEERR is there to
+prevent this from happening prematurely.
+
+You can pass filehandles to carpout() in a variety of ways.  The "correct"
+way according to Tom Christiansen is to pass a reference to a filehandle 
+GLOB:
+
+    carpout(\*LOG);
+
+This looks weird to mere mortals however, so the following syntaxes are
+accepted as well:
+
+    carpout(LOG);
+    carpout(main::LOG);
+    carpout(main'LOG);
+    carpout(\LOG);
+    carpout(\'main::LOG');
+
+    ... and so on
+
+FileHandle and other objects work as well.
+
+Use of carpout() is not great for performance, so it is recommended
+for debugging purposes or for moderate-use applications.  A future
+version of this module may delay redirecting STDERR until one of the
+CGI::Carp methods is called to prevent the performance hit.
+
+=head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW
+
+If you want to send fatal (die, confess) errors to the browser, ask to 
+import the special "fatalsToBrowser" subroutine:
+
+    use CGI::Carp qw(fatalsToBrowser);
+    die "Bad error here";
+
+Fatal errors will now be echoed to the browser as well as to the log.  CGI::Carp
+arranges to send a minimal HTTP header to the browser so that even errors that
+occur in the early compile phase will be seen.
+Nonfatal errors will still be directed to the log file only (unless redirected
+with carpout).
+
+=head2 Changing the default message
+
+By default, the software error message is followed by a note to
+contact the Webmaster by e-mail with the time and date of the error.
+If this message is not to your liking, you can change it using the
+set_message() routine.  This is not imported by default; you should
+import it on the use() line:
+
+    use CGI::Carp qw(fatalsToBrowser set_message);
+    set_message("It's not a bug, it's a feature!");
+
+You may also pass in a code reference in order to create a custom
+error message.  At run time, your code will be called with the text
+of the error message that caused the script to die.  Example:
+
+    use CGI::Carp qw(fatalsToBrowser set_message);
+    BEGIN {
+       sub handle_errors {
+          my $msg = shift;
+          print "<h1>Oh gosh</h1>";
+          print "Got an error: $msg";
+      }
+      set_message(\&handle_errors);
+    }
+
+In order to correctly intercept compile-time errors, you should call
+set_message() from within a BEGIN{} block.
+
+=head1 MAKING WARNINGS APPEAR AS HTML COMMENTS
+
+It is now also possible to make non-fatal errors appear as HTML
+comments embedded in the output of your program.  To enable this
+feature, export the new "warningsToBrowser" subroutine.  Since sending
+warnings to the browser before the HTTP headers have been sent would
+cause an error, any warnings are stored in an internal buffer until
+you call the warningsToBrowser() subroutine with a true argument:
+
+    use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
+    use CGI qw(:standard);
+    print header();
+    warningsToBrowser(1);
+
+You may also give a false argument to warningsToBrowser() to prevent
+warnings from being sent to the browser while you are printing some
+content where HTML comments are not allowed:
+
+    warningsToBrowser(0);    # disable warnings
+    print "<SCRIPT type=javascript><!--\n";
+    print_some_javascript_code();
+    print "//--></SCRIPT>\n";
+    warningsToBrowser(1);    # re-enable warnings
+
+Note: In this respect warningsToBrowser() differs fundamentally from
+fatalsToBrowser(), which you should never call yourself!
+
+=head1 CHANGE LOG
+
+1.05 carpout() added and minor corrections by Marc Hedlund
+     <hedlund@best.com> on 11/26/95.
+
+1.06 fatalsToBrowser() no longer aborts for fatal errors within
+     eval() statements.
+
+1.08 set_message() added and carpout() expanded to allow for FileHandle
+     objects.
+
+1.09 set_message() now allows users to pass a code REFERENCE for 
+     really custom error messages.  croak and carp are now
+     exported by default.  Thanks to Gunther Birznieks for the
+     patches.
+
+1.10 Patch from Chris Dean (ctdean@cogit.com) to allow 
+     module to run correctly under mod_perl.
+
+1.11 Changed order of &gt; and &lt; escapes.
+
+1.12 Changed die() on line 217 to CORE::die to avoid B<-w> warning.
+
+1.13 Added cluck() to make the module orthogonal with Carp.
+     More mod_perl related fixes.
+
+1.20 Patch from Ilmari Karonen (perl@itz.pp.sci.fi):  Added
+     warningsToBrowser().  Replaced <CODE> tags with <PRE> in
+     fatalsToBrowser() output.
+
+=head1 AUTHORS
+
+Copyright 1995-1998, Lincoln D. Stein.  All rights reserved.  
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Address bug reports and comments to: lstein@cshl.org
+
+=head1 SEE ALSO
+
+Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form,
+CGI::Response
+
+=cut
+
+require 5.000;
+use Exporter;
+use Carp;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(confess croak carp);
+@EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message cluck);
+
+$main::SIG{__WARN__}=\&CGI::Carp::warn;
+$main::SIG{__DIE__}=\&CGI::Carp::die;
+$CGI::Carp::VERSION = '1.20';
+$CGI::Carp::CUSTOM_MSG = undef;
+
+# fancy import routine detects and handles 'errorWrap' specially.
+sub import {
+    my $pkg = shift;
+    my(%routines);
+    grep($routines{$_}++,@_,@EXPORT);
+    $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'};
+    $WARN++ if $routines{'warningsToBrowser'};
+    my($oldlevel) = $Exporter::ExportLevel;
+    $Exporter::ExportLevel = 1;
+    Exporter::import($pkg,keys %routines);
+    $Exporter::ExportLevel = $oldlevel;
+}
+
+# These are the originals
+sub realwarn { CORE::warn(@_); }
+sub realdie { CORE::die(@_); }
+
+sub id {
+    my $level = shift;
+    my($pack,$file,$line,$sub) = caller($level);
+    my($id) = $file=~m|([^/]+)$|;
+    return ($file,$line,$id);
+}
+
+sub stamp {
+    my $time = scalar(localtime);
+    my $frame = 0;
+    my ($id,$pack,$file);
+    do {
+	$id = $file;
+	($pack,$file) = caller($frame++);
+    } until !$file;
+    ($id) = $id=~m|([^/]+)$|;
+    return "[$time] $id: ";
+}
+
+sub warn {
+    my $message = shift;
+    my($file,$line,$id) = id(1);
+    $message .= " at $file line $line.\n" unless $message=~/\n$/;
+    _warn($message) if $WARN;
+    my $stamp = stamp;
+    $message=~s/^/$stamp/gm;
+    realwarn $message;
+}
+
+sub _warn {
+    my $msg = shift;
+    if ($EMIT_WARNINGS) {
+	# We need to mangle the message a bit to make it a valid HTML
+	# comment.  This is done by substituting similar-looking ISO
+	# 8859-1 characters for <, > and -.  This is a hack.
+	$msg =~ tr/<>-/\253\273\255/;
+	chomp $msg;
+	print STDOUT "<!-- warning: $msg -->\n";
+    } else {
+	push @WARNINGS, $msg;
+    }
+}
+
+sub ineval { _longmess() =~ /eval [\{\']/m }
+
+# The mod_perl package Apache::Registry loads CGI programs by calling
+# eval, as does PerlEx.  These evals don't count when looking at the 
+# stack backtrace.
+sub _longmess {
+    my $message = Carp::longmess();
+    my $mod_perl = exists $ENV{MOD_PERL};
+    my $plex = exists($ENV{'GATEWAY_INTERFACE'})
+               && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/;
+    $message =~ s,eval[^\n]+(Apache/Registry\.pm|\s*PerlEx::Precompiler).*,,s
+	if $mod_perl or $plex;
+    return $message;    
+}
+
+sub die {
+  realdie @_ if ineval;
+  my ($message) = @_;
+  my $time = scalar(localtime);
+  my($file,$line,$id) = id(1);
+  $message .= " at $file line $line." unless $message=~/\n$/;
+  &fatalsToBrowser($message) if $WRAP;
+  my $stamp = stamp;
+  $message=~s/^/$stamp/gm;
+  realdie $message;
+}
+
+sub set_message {
+    $CGI::Carp::CUSTOM_MSG = shift;
+    return $CGI::Carp::CUSTOM_MSG;
+}
+
+# Avoid generating "subroutine redefined" warnings with the following
+# hack:
+{
+    local $^W=0;
+    eval <<EOF;
+sub confess { CGI::Carp::die Carp::longmess \@_; }
+sub croak   { CGI::Carp::die Carp::shortmess \@_; }
+sub carp    { CGI::Carp::warn Carp::shortmess \@_; }
+sub cluck   { CGI::Carp::warn Carp::longmess \@_; }
+EOF
+    ;
+}
+
+# We have to be ready to accept a filehandle as a reference
+# or a string.
+sub carpout {
+    my($in) = @_;
+    my($no) = fileno(to_filehandle($in));
+    realdie("Invalid filehandle $in\n") unless defined $no;
+    
+    open(SAVEERR, ">&STDERR");
+    open(STDERR, ">&$no") or 
+	( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
+}
+
+sub warningsToBrowser {
+    $EMIT_WARNINGS = @_ ? shift : 1;
+    _warn(shift @WARNINGS) while $EMIT_WARNINGS and @WARNINGS;
+}
+
+# headers
+sub fatalsToBrowser {
+    my($msg) = @_;
+    $msg=~s/&/&amp;/g;
+    $msg=~s/>/&gt;/g;
+    $msg=~s/</&lt;/g;
+    $msg=~s/\"/&quot;/g;
+    my($wm) = $ENV{SERVER_ADMIN} ? 
+	qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
+	"this site's webmaster";
+    my ($outer_message) = <<END;
+For help, please send mail to $wm, giving this error message 
+and the time and date of the error.
+END
+    ;
+    my $mod_perl = exists $ENV{MOD_PERL};
+    my $plex = exists($ENV{'GATEWAY_INTERFACE'})
+	&& $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/;
+
+    print STDOUT "Content-type: text/html\n\n" 
+	unless $mod_perl || $plex;
+
+    warningsToBrowser(1);    # emit warnings before dying
+
+    if ($CUSTOM_MSG) {
+	if (ref($CUSTOM_MSG) eq 'CODE') {
+	    &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
+	    return;
+	} else {
+	    $outer_message = $CUSTOM_MSG;
+	}
+    }
+    
+    my $mess = <<END;
+<H1>Software error:</H1>
+<PRE>$msg</PRE>
+<P>
+$outer_message
+END
+    ;
+
+    if ($mod_perl && (my $r = Apache->request)) {
+	# If bytes have already been sent, then
+	# we print the message out directly.
+	# Otherwise we make a custom error
+	# handler to produce the doc for us.
+	if ($r->bytes_sent) {
+	    $r->print($mess);
+	    $r->exit;
+	} else {
+	    $r->status(500);
+	    $r->custom_response(500,$mess);
+	}
+    } else {
+	print STDOUT $mess;
+    }
+}
+
+# Cut and paste from CGI.pm so that we don't have the overhead of
+# always loading the entire CGI module.
+sub to_filehandle {
+    my $thingy = shift;
+    return undef unless $thingy;
+    return $thingy if UNIVERSAL::isa($thingy,'GLOB');
+    return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
+    if (!ref($thingy)) {
+	my $caller = 1;
+	while (my $package = caller($caller++)) {
+	    my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy"; 
+	    return $tmp if defined(fileno($tmp));
+	}
+    }
+    return undef;
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/CGI/Cookie.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/CGI/Cookie.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/CGI/Cookie.pm	(revision 14265)
@@ -0,0 +1,429 @@
+package CGI::Cookie;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+# Copyright 1995-1999, Lincoln D. Stein.  All rights reserved.
+# It may be used and modified freely, but I do request that this copyright
+# notice remain attached to the file.  You may modify this module as you 
+# wish, but if you redistribute a modified version, please attach a note
+# listing the modifications you have made.
+
+$CGI::Cookie::VERSION='1.18';
+
+use CGI::Util qw(rearrange unescape escape);
+use overload '""' => \&as_string,
+    'cmp' => \&compare,
+    'fallback'=>1;
+
+# fetch a list of cookies from the environment and
+# return as a hash.  the cookies are parsed as normal
+# escaped URL data.
+sub fetch {
+    my $class = shift;
+    my $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
+    return () unless $raw_cookie;
+    return $class->parse($raw_cookie);
+}
+
+# fetch a list of cookies from the environment and
+# return as a hash.  the cookie values are not unescaped
+# or altered in any way.
+sub raw_fetch {
+    my $class = shift;
+    my $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
+    return () unless $raw_cookie;
+    my %results;
+    my($key,$value);
+
+    my(@pairs) = split("; ?",$raw_cookie);
+    foreach (@pairs) {
+      s/\s*(.*?)\s*/$1/;
+      if (/^([^=]+)=(.*)/) {
+	$key = $1;
+	$value = $2;
+      }
+      else {
+	$key = $_;
+	$value = '';
+      }
+      $results{$key} = $value;
+    }
+    return \%results unless wantarray;
+    return %results;
+}
+
+
+sub parse {
+  my ($self,$raw_cookie) = @_;
+  my %results;
+
+  my(@pairs) = split("; ?",$raw_cookie);
+  foreach (@pairs) {
+    s/\s*(.*?)\s*/$1/;
+    my($key,$value) = split("=");
+
+    # Some foreign cookies are not in name=value format, so ignore
+    # them.
+    next if !defined($value);
+    my @values = ();
+    if ($value ne '') {
+      @values = map CGI::unescape($_),split(/[&;]/,$value.'&dmy');
+      pop @values;
+    }
+    $key = unescape($key);
+    # A bug in Netscape can cause several cookies with same name to
+    # appear.  The FIRST one in HTTP_COOKIE is the most recent version.
+    $results{$key} ||= $self->new(-name=>$key,-value=>\@values);
+  }
+  return \%results unless wantarray;
+  return %results;
+}
+
+sub new {
+  my $class = shift;
+  $class = ref($class) if ref($class);
+  my($name,$value,$path,$domain,$secure,$expires) =
+    rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_);
+  
+  # Pull out our parameters.
+  my @values;
+  if (ref($value)) {
+    if (ref($value) eq 'ARRAY') {
+      @values = @$value;
+    } elsif (ref($value) eq 'HASH') {
+      @values = %$value;
+    }
+  } else {
+    @values = ($value);
+  }
+  
+  bless my $self = {
+		    'name'=>$name,
+		    'value'=>[@values],
+		   },$class;
+
+  # IE requires the path and domain to be present for some reason.
+  $path   ||= "/";
+  # however, this breaks networks which use host tables without fully qualified
+  # names, so we comment it out.
+  #    $domain = CGI::virtual_host()    unless defined $domain;
+
+  $self->path($path)     if defined $path;
+  $self->domain($domain) if defined $domain;
+  $self->secure($secure) if defined $secure;
+  $self->expires($expires) if defined $expires;
+  return $self;
+}
+
+sub as_string {
+    my $self = shift;
+    return "" unless $self->name;
+
+    my(@constant_values,$domain,$path,$expires,$secure);
+
+    push(@constant_values,"domain=$domain") if $domain = $self->domain;
+    push(@constant_values,"path=$path") if $path = $self->path;
+    push(@constant_values,"expires=$expires") if $expires = $self->expires;
+    push(@constant_values,"secure") if $secure = $self->secure;
+
+    my($key) = escape($self->name);
+    my($cookie) = join("=",$key,join("&",map escape($_),$self->value));
+    return join("; ",$cookie,@constant_values);
+}
+
+sub compare {
+    my $self = shift;
+    my $value = shift;
+    return "$self" cmp $value;
+}
+
+# accessors
+sub name {
+    my $self = shift;
+    my $name = shift;
+    $self->{'name'} = $name if defined $name;
+    return $self->{'name'};
+}
+
+sub value {
+    my $self = shift;
+    my $value = shift;
+    $self->{'value'} = $value if defined $value;
+    return wantarray ? @{$self->{'value'}} : $self->{'value'}->[0]
+}
+
+sub domain {
+    my $self = shift;
+    my $domain = shift;
+    $self->{'domain'} = $domain if defined $domain;
+    return $self->{'domain'};
+}
+
+sub secure {
+    my $self = shift;
+    my $secure = shift;
+    $self->{'secure'} = $secure if defined $secure;
+    return $self->{'secure'};
+}
+
+sub expires {
+    my $self = shift;
+    my $expires = shift;
+    $self->{'expires'} = CGI::Util::expires($expires,'cookie') if defined $expires;
+    return $self->{'expires'};
+}
+
+sub path {
+    my $self = shift;
+    my $path = shift;
+    $self->{'path'} = $path if defined $path;
+    return $self->{'path'};
+}
+
+1;
+
+=head1 NAME
+
+CGI::Cookie - Interface to Netscape Cookies
+
+=head1 SYNOPSIS
+
+    use CGI qw/:standard/;
+    use CGI::Cookie;
+
+    # Create new cookies and send them
+    $cookie1 = new CGI::Cookie(-name=>'ID',-value=>123456);
+    $cookie2 = new CGI::Cookie(-name=>'preferences',
+                               -value=>{ font => Helvetica,
+                                         size => 12 } 
+                               );
+    print header(-cookie=>[$cookie1,$cookie2]);
+
+    # fetch existing cookies
+    %cookies = fetch CGI::Cookie;
+    $id = $cookies{'ID'}->value;
+
+    # create cookies returned from an external source
+    %cookies = parse CGI::Cookie($ENV{COOKIE});
+
+=head1 DESCRIPTION
+
+CGI::Cookie is an interface to Netscape (HTTP/1.1) cookies, an
+innovation that allows Web servers to store persistent information on
+the browser's side of the connection.  Although CGI::Cookie is
+intended to be used in conjunction with CGI.pm (and is in fact used by
+it internally), you can use this module independently.
+
+For full information on cookies see 
+
+	http://www.ics.uci.edu/pub/ietf/http/rfc2109.txt
+
+=head1 USING CGI::Cookie
+
+CGI::Cookie is object oriented.  Each cookie object has a name and a
+value.  The name is any scalar value.  The value is any scalar or
+array value (associative arrays are also allowed).  Cookies also have
+several optional attributes, including:
+
+=over 4
+
+=item B<1. expiration date>
+
+The expiration date tells the browser how long to hang on to the
+cookie.  If the cookie specifies an expiration date in the future, the
+browser will store the cookie information in a disk file and return it
+to the server every time the user reconnects (until the expiration
+date is reached).  If the cookie species an expiration date in the
+past, the browser will remove the cookie from the disk file.  If the
+expiration date is not specified, the cookie will persist only until
+the user quits the browser.
+
+=item B<2. domain>
+
+This is a partial or complete domain name for which the cookie is 
+valid.  The browser will return the cookie to any host that matches
+the partial domain name.  For example, if you specify a domain name
+of ".capricorn.com", then Netscape will return the cookie to
+Web servers running on any of the machines "www.capricorn.com", 
+"ftp.capricorn.com", "feckless.capricorn.com", etc.  Domain names
+must contain at least two periods to prevent attempts to match
+on top level domains like ".edu".  If no domain is specified, then
+the browser will only return the cookie to servers on the host the
+cookie originated from.
+
+=item B<3. path>
+
+If you provide a cookie path attribute, the browser will check it
+against your script's URL before returning the cookie.  For example,
+if you specify the path "/cgi-bin", then the cookie will be returned
+to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl", and
+"/cgi-bin/customer_service/complain.pl", but not to the script
+"/cgi-private/site_admin.pl".  By default, the path is set to "/", so
+that all scripts at your site will receive the cookie.
+
+=item B<4. secure flag>
+
+If the "secure" attribute is set, the cookie will only be sent to your
+script if the CGI request is occurring on a secure channel, such as SSL.
+
+=back
+
+=head2 Creating New Cookies
+
+	$c = new CGI::Cookie(-name    =>  'foo',
+                             -value   =>  'bar',
+                             -expires =>  '+3M',
+                             -domain  =>  '.capricorn.com',
+                             -path    =>  '/cgi-bin/database'
+                             -secure  =>  1
+	                    );
+
+Create cookies from scratch with the B<new> method.  The B<-name> and
+B<-value> parameters are required.  The name must be a scalar value.
+The value can be a scalar, an array reference, or a hash reference.
+(At some point in the future cookies will support one of the Perl
+object serialization protocols for full generality).
+
+B<-expires> accepts any of the relative or absolute date formats
+recognized by CGI.pm, for example "+3M" for three months in the
+future.  See CGI.pm's documentation for details.
+
+B<-domain> points to a domain name or to a fully qualified host name.
+If not specified, the cookie will be returned only to the Web server
+that created it.
+
+B<-path> points to a partial URL on the current server.  The cookie
+will be returned to all URLs beginning with the specified path.  If
+not specified, it defaults to '/', which returns the cookie to all
+pages at your site.
+
+B<-secure> if set to a true value instructs the browser to return the
+cookie only when a cryptographic protocol is in use.
+
+=head2 Sending the Cookie to the Browser
+
+Within a CGI script you can send a cookie to the browser by creating
+one or more Set-Cookie: fields in the HTTP header.  Here is a typical
+sequence:
+
+  my $c = new CGI::Cookie(-name    =>  'foo',
+                          -value   =>  ['bar','baz'],
+                          -expires =>  '+3M');
+
+  print "Set-Cookie: $c\n";
+  print "Content-Type: text/html\n\n";
+
+To send more than one cookie, create several Set-Cookie: fields.
+Alternatively, you may concatenate the cookies together with "; " and
+send them in one field.
+
+If you are using CGI.pm, you send cookies by providing a -cookie
+argument to the header() method:
+
+  print header(-cookie=>$c);
+
+Mod_perl users can set cookies using the request object's header_out()
+method:
+
+  $r->header_out('Set-Cookie',$c);
+
+Internally, Cookie overloads the "" operator to call its as_string()
+method when incorporated into the HTTP header.  as_string() turns the
+Cookie's internal representation into an RFC-compliant text
+representation.  You may call as_string() yourself if you prefer:
+
+  print "Set-Cookie: ",$c->as_string,"\n";
+
+=head2 Recovering Previous Cookies
+
+	%cookies = fetch CGI::Cookie;
+
+B<fetch> returns an associative array consisting of all cookies
+returned by the browser.  The keys of the array are the cookie names.  You
+can iterate through the cookies this way:
+
+	%cookies = fetch CGI::Cookie;
+	foreach (keys %cookies) {
+	   do_something($cookies{$_});
+        }
+
+In a scalar context, fetch() returns a hash reference, which may be more
+efficient if you are manipulating multiple cookies.
+
+CGI.pm uses the URL escaping methods to save and restore reserved characters
+in its cookies.  If you are trying to retrieve a cookie set by a foreign server,
+this escaping method may trip you up.  Use raw_fetch() instead, which has the
+same semantics as fetch(), but performs no unescaping.
+
+You may also retrieve cookies that were stored in some external
+form using the parse() class method:
+
+       $COOKIES = `cat /usr/tmp/Cookie_stash`;
+       %cookies = parse CGI::Cookie($COOKIES);
+
+=head2 Manipulating Cookies
+
+Cookie objects have a series of accessor methods to get and set cookie
+attributes.  Each accessor has a similar syntax.  Called without
+arguments, the accessor returns the current value of the attribute.
+Called with an argument, the accessor changes the attribute and
+returns its new value.
+
+=over 4
+
+=item B<name()>
+
+Get or set the cookie's name.  Example:
+
+	$name = $c->name;
+	$new_name = $c->name('fred');
+
+=item B<value()>
+
+Get or set the cookie's value.  Example:
+
+	$value = $c->value;
+	@new_value = $c->value(['a','b','c','d']);
+
+B<value()> is context sensitive.  In a list context it will return
+the current value of the cookie as an array.  In a scalar context it
+will return the B<first> value of a multivalued cookie.
+
+=item B<domain()>
+
+Get or set the cookie's domain.
+
+=item B<path()>
+
+Get or set the cookie's path.
+
+=item B<expires()>
+
+Get or set the cookie's expiration time.
+
+=back
+
+
+=head1 AUTHOR INFORMATION
+
+Copyright 1997-1998, Lincoln D. Stein.  All rights reserved.  
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Address bug reports and comments to: lstein@cshl.org
+
+=head1 BUGS
+
+This section intentionally left blank.
+
+=head1 SEE ALSO
+
+L<CGI::Carp>, L<CGI>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/CGI/Fast.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/CGI/Fast.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/CGI/Fast.pm	(revision 14265)
@@ -0,0 +1,174 @@
+package CGI::Fast;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+# Copyright 1995,1996, Lincoln D. Stein.  All rights reserved.
+# It may be used and modified freely, but I do request that this copyright
+# notice remain attached to the file.  You may modify this module as you 
+# wish, but if you redistribute a modified version, please attach a note
+# listing the modifications you have made.
+
+# The most recent version and complete docs are available at:
+#   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
+#   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+$CGI::Fast::VERSION='1.02';
+
+use CGI;
+use FCGI;
+@ISA = ('CGI');
+
+# workaround for known bug in libfcgi
+while (($ignore) = each %ENV) { }
+
+# override the initialization behavior so that
+# state is NOT maintained between invocations 
+sub save_request {
+    # no-op
+}
+
+# New is slightly different in that it calls FCGI's
+# accept() method.
+sub new {
+     my ($self, $initializer, @param) = @_;
+     unless (defined $initializer) {
+         return undef unless FCGI::accept() >= 0;
+     }
+     return $CGI::Q = $self->SUPER::new($initializer, @param);
+}
+
+1;
+
+=head1 NAME
+
+CGI::Fast - CGI Interface for Fast CGI
+
+=head1 SYNOPSIS
+
+    use CGI::Fast qw(:standard);
+    $COUNTER = 0;
+    while (new CGI::Fast) {
+	print header;
+	print start_html("Fast CGI Rocks");
+	print
+	    h1("Fast CGI Rocks"),
+	    "Invocation number ",b($COUNTER++),
+            " PID ",b($$),".",
+	    hr;
+        print end_html;
+    }
+
+=head1 DESCRIPTION
+
+CGI::Fast is a subclass of the CGI object created by
+CGI.pm.  It is specialized to work well with the Open Market
+FastCGI standard, which greatly speeds up CGI scripts by
+turning them into persistently running server processes.  Scripts
+that perform time-consuming initialization processes, such as
+loading large modules or opening persistent database connections,
+will see large performance improvements.
+
+=head1 OTHER PIECES OF THE PUZZLE
+
+In order to use CGI::Fast you'll need a FastCGI-enabled Web
+server.  Open Market's server is FastCGI-savvy.  There are also
+freely redistributable FastCGI modules for NCSA httpd 1.5 and Apache.
+FastCGI-enabling modules for Microsoft Internet Information Server and
+Netscape Communications Server have been announced.
+
+In addition, you'll need a version of the Perl interpreter that has
+been linked with the FastCGI I/O library.  Precompiled binaries are
+available for several platforms, including DEC Alpha, HP-UX and 
+SPARC/Solaris, or you can rebuild Perl from source with patches
+provided in the FastCGI developer's kit.  The FastCGI Perl interpreter
+can be used in place of your normal Perl without ill consequences.
+
+You can find FastCGI modules for Apache and NCSA httpd, precompiled
+Perl interpreters, and the FastCGI developer's kit all at URL:
+
+  http://www.fastcgi.com/
+
+=head1 WRITING FASTCGI PERL SCRIPTS
+
+FastCGI scripts are persistent: one or more copies of the script 
+are started up when the server initializes, and stay around until
+the server exits or they die a natural death.  After performing
+whatever one-time initialization it needs, the script enters a 
+loop waiting for incoming connections, processing the request, and
+waiting some more.
+
+A typical FastCGI script will look like this:
+
+    #!/usr/local/bin/perl    # must be a FastCGI version of perl!
+    use CGI::Fast;
+    &do_some_initialization();
+    while ($q = new CGI::Fast) {
+	&process_request($q);
+    }
+
+Each time there's a new request, CGI::Fast returns a
+CGI object to your loop.  The rest of the time your script
+waits in the call to new().  When the server requests that
+your script be terminated, new() will return undef.  You can
+of course exit earlier if you choose.  A new version of the
+script will be respawned to take its place (this may be
+necessary in order to avoid Perl memory leaks in long-running
+scripts).
+
+CGI.pm's default CGI object mode also works.  Just modify the loop
+this way:
+
+    while (new CGI::Fast) {
+	&process_request;
+    }
+
+Calls to header(), start_form(), etc. will all operate on the
+current request.
+
+=head1 INSTALLING FASTCGI SCRIPTS
+
+See the FastCGI developer's kit documentation for full details.  On
+the Apache server, the following line must be added to srm.conf:
+
+    AddType application/x-httpd-fcgi .fcgi
+
+FastCGI scripts must end in the extension .fcgi.  For each script you
+install, you must add something like the following to srm.conf:
+
+   AppClass /usr/etc/httpd/fcgi-bin/file_upload.fcgi -processes 2
+
+This instructs Apache to launch two copies of file_upload.fcgi at 
+startup time.
+
+=head1 USING FASTCGI SCRIPTS AS CGI SCRIPTS
+
+Any script that works correctly as a FastCGI script will also work
+correctly when installed as a vanilla CGI script.  However it will
+not see any performance benefit.
+
+=head1 CAVEATS
+
+I haven't tested this very much.
+
+=head1 AUTHOR INFORMATION
+
+Copyright 1996-1998, Lincoln D. Stein.  All rights reserved.  
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Address bug reports and comments to: lstein@cshl.org
+
+=head1 BUGS
+
+This section intentionally left blank.
+
+=head1 SEE ALSO
+
+L<CGI::Carp>, L<CGI>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/CGI/Pretty.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/CGI/Pretty.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/CGI/Pretty.pm	(revision 14265)
@@ -0,0 +1,235 @@
+package CGI::Pretty;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+use strict;
+use CGI ();
+
+$CGI::Pretty::VERSION = '1.05';
+$CGI::DefaultClass = __PACKAGE__;
+$CGI::Pretty::AutoloadClass = 'CGI';
+@CGI::Pretty::ISA = qw( CGI );
+
+initialize_globals();
+
+sub _prettyPrint {
+    my $input = shift;
+
+    foreach my $i ( @CGI::Pretty::AS_IS ) {
+	if ( $$input =~ /<\/$i>/si ) {
+	    my ( $a, $b, $c, $d, $e ) = $$input =~ /(.*)<$i(\s?)(.*?)>(.*?)<\/$i>(.*)/si;
+	    _prettyPrint( \$a );
+	    _prettyPrint( \$e );
+	    
+	    $$input = "$a<$i$b$c>$d</$i>$e";
+	    return;
+	}
+    }
+    $$input =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g if $CGI::Pretty::LINEBREAK; 
+}
+
+sub comment {
+    my($self,@p) = CGI::self_or_CGI(@_);
+
+    my $s = "@p";
+    $s =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g if $CGI::Pretty::LINEBREAK; 
+    
+    return $self->SUPER::comment( "$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT$s$CGI::Pretty::LINEBREAK" ) . $CGI::Pretty::LINEBREAK;
+}
+
+sub _make_tag_func {
+    my ($self,$tagname) = @_;
+    return $self->SUPER::_make_tag_func($tagname) if $tagname=~/^(start|end)_/;
+
+    # As Lincoln as noted, the last else clause is VERY hairy, and it
+    # took me a while to figure out what I was trying to do.
+    # What it does is look for tags that shouldn't be indented (e.g. PRE)
+    # and makes sure that when we nest tags, those tags don't get
+    # indented.
+    # For an example, try print td( pre( "hello\nworld" ) );
+    # If we didn't care about stuff like that, the code would be
+    # MUCH simpler.  BTW: I won't claim to be a regular expression
+    # guru, so if anybody wants to contribute something that would
+    # be quicker, easier to read, etc, I would be more than
+    # willing to put it in - Brian
+    
+    return qq{
+	sub $tagname { 
+	    # handle various cases in which we're called
+	    # most of this bizarre stuff is to avoid -w errors
+            shift if \$_[0] && 
+                    (ref(\$_[0]) &&
+                     (substr(ref(\$_[0]),0,3) eq 'CGI' ||
+                    UNIVERSAL::isa(\$_[0],'CGI')));
+	    
+	    my(\$attr) = '';
+	    if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
+		my(\@attr) = make_attributes(shift);
+		\$attr = " \@attr" if \@attr;
+	    }
+
+	    my(\$tag,\$untag) = ("\L<$tagname\E\$attr>","\L</$tagname>\E");
+	    return \$tag unless \@_;
+
+	    my \@result;
+	    my \$NON_PRETTIFY_ENDTAGS =  join "", map { "</\$_>" } \@CGI::Pretty::AS_IS;
+
+	    if ( \$NON_PRETTIFY_ENDTAGS =~ /\$untag/ ) {
+		\@result = map { "\$tag\$_\$untag\$CGI::Pretty::LINEBREAK" } 
+		 (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
+	    }
+	    else {
+		\@result = map { 
+		    chomp; 
+		    if ( \$_ !~ /<\\// ) {
+			s/\$CGI::Pretty::LINEBREAK/\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT/g if \$CGI::Pretty::LINEBREAK; 
+		    } 
+		    else {
+			my \$tmp = \$_;
+			CGI::Pretty::_prettyPrint( \\\$tmp );
+			\$_ = \$tmp;
+		    }
+		    "\$tag\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT\$_\$CGI::Pretty::LINEBREAK\$untag\$CGI::Pretty::LINEBREAK" } 
+		(ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
+	    }
+	    local \$" = "";
+	    return "\@result";
+	}
+    };
+}
+
+sub start_html {
+    return CGI::start_html( @_ ) . $CGI::Pretty::LINEBREAK;
+}
+
+sub end_html {
+    return CGI::end_html( @_ ) . $CGI::Pretty::LINEBREAK;
+}
+
+sub new {
+    my $class = shift;
+    my $this = $class->SUPER::new( @_ );
+
+    Apache->request->register_cleanup(\&CGI::Pretty::_reset_globals) if ($CGI::MOD_PERL);
+    $class->_reset_globals if $CGI::PERLEX;
+
+    return bless $this, $class;
+}
+
+sub initialize_globals {
+    # This is the string used for indentation of tags
+    $CGI::Pretty::INDENT = "\t";
+    
+    # This is the string used for seperation between tags
+    $CGI::Pretty::LINEBREAK = "\n";
+
+    # These tags are not prettify'd.
+    @CGI::Pretty::AS_IS = qw( a pre code script textarea );
+
+    1;
+}
+sub _reset_globals { initialize_globals(); }
+
+1;
+
+=head1 NAME
+
+CGI::Pretty - module to produce nicely formatted HTML code
+
+=head1 SYNOPSIS
+
+    use CGI::Pretty qw( :html3 );
+
+    # Print a table with a single data element
+    print table( TR( td( "foo" ) ) );
+
+=head1 DESCRIPTION
+
+CGI::Pretty is a module that derives from CGI.  It's sole function is to
+allow users of CGI to output nicely formatted HTML code.
+
+When using the CGI module, the following code:
+    print table( TR( td( "foo" ) ) );
+
+produces the following output:
+    <TABLE><TR><TD>foo</TD></TR></TABLE>
+
+If a user were to create a table consisting of many rows and many columns,
+the resultant HTML code would be quite difficult to read since it has no
+carriage returns or indentation.
+
+CGI::Pretty fixes this problem.  What it does is add a carriage
+return and indentation to the HTML code so that one can easily read
+it.
+
+    print table( TR( td( "foo" ) ) );
+
+now produces the following output:
+    <TABLE>
+       <TR>
+          <TD>
+             foo
+          </TD>
+       </TR>
+    </TABLE>
+
+
+=head2 Tags that won't be formatted
+
+The <A> and <PRE> tags are not formatted.  If these tags were formatted, the
+user would see the extra indentation on the web browser causing the page to
+look different than what would be expected.  If you wish to add more tags to
+the list of tags that are not to be touched, push them onto the C<@AS_IS> array:
+
+    push @CGI::Pretty::AS_IS,qw(CODE XMP);
+
+=head2 Customizing the Indenting
+
+If you wish to have your own personal style of indenting, you can change the
+C<$INDENT> variable:
+
+    $CGI::Pretty::INDENT = "\t\t";
+
+would cause the indents to be two tabs.
+
+Similarly, if you wish to have more space between lines, you may change the
+C<$LINEBREAK> variable:
+
+    $CGI::Pretty::LINEBREAK = "\n\n";
+
+would create two carriage returns between lines.
+
+If you decide you want to use the regular CGI indenting, you can easily do 
+the following:
+
+    $CGI::Pretty::INDENT = $CGI::Pretty::LINEBREAK = "";
+
+=head1 BUGS
+
+This section intentionally left blank.
+
+=head1 AUTHOR
+
+Brian Paulsen <Brian@ThePaulsens.com>, with minor modifications by
+Lincoln Stein <lstein@cshl.org> for incorporation into the CGI.pm
+distribution.
+
+Copyright 1999, Brian Paulsen.  All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Bug reports and comments to Brian@ThePaulsens.com.  You can also write
+to lstein@cshl.org, but this code looks pretty hairy to me and I'm not
+sure I understand it!
+
+=head1 SEE ALSO
+
+L<CGI>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/CGI/Push.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/CGI/Push.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/CGI/Push.pm	(revision 14265)
@@ -0,0 +1,325 @@
+package CGI::Push;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+# Copyright 1995-2000, Lincoln D. Stein.  All rights reserved.
+# It may be used and modified freely, but I do request that this copyright
+# notice remain attached to the file.  You may modify this module as you 
+# wish, but if you redistribute a modified version, please attach a note
+# listing the modifications you have made.
+
+# The most recent version and complete docs are available at:
+#   http://stein.cshl.org/WWW/software/CGI/
+
+$CGI::Push::VERSION='1.04';
+use CGI;
+use CGI::Util 'rearrange';
+@ISA = ('CGI');
+
+$CGI::DefaultClass = 'CGI::Push';
+$CGI::Push::AutoloadClass = 'CGI';
+
+# add do_push() and push_delay() to exported tags
+push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push','push_delay');
+
+sub do_push {
+    my ($self,@p) = CGI::self_or_default(@_);
+
+    # unbuffer output
+    $| = 1;
+    srand;
+    my ($random) = sprintf("%08.0f",rand()*1E8);
+    my ($boundary) = "----=_NeXtPaRt$random";
+
+    my (@header);
+    my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,$nph,@other) = rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
+    $type = 'text/html' unless $type;
+    $callback = \&simple_counter unless $callback && ref($callback) eq 'CODE';
+    $delay = 1 unless defined($delay);
+    $self->push_delay($delay);
+    $nph = 1 unless defined($nph);
+
+    my(@o);
+    foreach (@other) { push(@o,split("=")); }
+    push(@o,'-Target'=>$target) if defined($target);
+    push(@o,'-Cookie'=>$cookie) if defined($cookie);
+    push(@o,'-Type'=>"multipart/x-mixed-replace;boundary=\"$boundary\"");
+    push(@o,'-Server'=>"CGI.pm Push Module") if $nph;
+    push(@o,'-Status'=>'200 OK');
+    push(@o,'-nph'=>1) if $nph;
+    print $self->header(@o);
+
+    $boundary = "$CGI::CRLF--$boundary";
+
+    print "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.${boundary}$CGI::CRLF";
+
+    my (@contents) = &$callback($self,++$COUNTER);
+
+    # now we enter a little loop
+    while (1) {
+        print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i;
+        print @contents;
+        @contents = &$callback($self,++$COUNTER);
+        if ((@contents) && defined($contents[0])) {
+            print "${boundary}$CGI::CRLF";
+            do_sleep($self->push_delay()) if $self->push_delay();
+        } else {
+            if ($last_page && ref($last_page) eq 'CODE') {
+                print "${boundary}$CGI::CRLF";
+                do_sleep($self->push_delay()) if $self->push_delay();
+                print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i;
+                print  &$last_page($self,$COUNTER);
+            }
+            print "${boundary}--$CGI::CRLF";
+            last;
+        }
+    }
+    print "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.$CGI::CRLF";
+}
+
+sub simple_counter {
+    my ($self,$count) = @_;
+    return $self->start_html("CGI::Push Default Counter"),
+           $self->h1("CGI::Push Default Counter"),
+           "This page has been updated ",$self->strong($count)," times.",
+           $self->hr(),
+           $self->a({'-href'=>'http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},'CGI.pm home page'),
+           $self->end_html;
+}
+
+sub do_sleep {
+    my $delay = shift;
+    if ( ($delay >= 1) && ($delay!~/\./) ){
+        sleep($delay);
+    } else {
+        select(undef,undef,undef,$delay);
+    }
+}
+
+sub push_delay {
+    my ($self,$delay) = CGI::self_or_default(@_);
+    return defined($delay) ? $self->{'.delay'} = 
+        $delay : $self->{'.delay'};
+}
+
+1;
+
+=head1 NAME
+
+CGI::Push - Simple Interface to Server Push
+
+=head1 SYNOPSIS
+
+    use CGI::Push qw(:standard);
+
+    do_push(-next_page=>\&next_page,
+            -last_page=>\&last_page,
+            -delay=>0.5);
+
+    sub next_page {
+        my($q,$counter) = @_;
+        return undef if $counter >= 10;
+        return start_html('Test'),
+               h1('Visible'),"\n",
+               "This page has been called ", strong($counter)," times",
+               end_html();
+    }
+
+    sub last_page {
+        my($q,$counter) = @_;
+        return start_html('Done'),
+               h1('Finished'),
+               strong($counter - 1),' iterations.',
+               end_html;
+    }
+
+=head1 DESCRIPTION
+
+CGI::Push is a subclass of the CGI object created by CGI.pm.  It is
+specialized for server push operations, which allow you to create
+animated pages whose content changes at regular intervals.
+
+You provide CGI::Push with a pointer to a subroutine that will draw
+one page.  Every time your subroutine is called, it generates a new
+page.  The contents of the page will be transmitted to the browser
+in such a way that it will replace what was there beforehand.  The
+technique will work with HTML pages as well as with graphics files, 
+allowing you to create animated GIFs.
+
+Only Netscape Navigator supports server push.  Internet Explorer
+browsers do not.
+
+=head1 USING CGI::Push
+
+CGI::Push adds one new method to the standard CGI suite, do_push().
+When you call this method, you pass it a reference to a subroutine
+that is responsible for drawing each new page, an interval delay, and
+an optional subroutine for drawing the last page.  Other optional
+parameters include most of those recognized by the CGI header()
+method.
+
+You may call do_push() in the object oriented manner or not, as you
+prefer:
+
+    use CGI::Push;
+    $q = new CGI::Push;
+    $q->do_push(-next_page=>\&draw_a_page);
+
+        -or-
+
+    use CGI::Push qw(:standard);
+    do_push(-next_page=>\&draw_a_page);
+
+Parameters are as follows:
+
+=over 4
+
+=item -next_page
+
+    do_push(-next_page=>\&my_draw_routine);
+
+This required parameter points to a reference to a subroutine responsible for
+drawing each new page.  The subroutine should expect two parameters
+consisting of the CGI object and a counter indicating the number
+of times the subroutine has been called.  It should return the
+contents of the page as an B<array> of one or more items to print.  
+It can return a false value (or an empty array) in order to abort the
+redrawing loop and print out the final page (if any)
+
+    sub my_draw_routine {
+        my($q,$counter) = @_;
+        return undef if $counter > 100;
+        return start_html('testing'),
+               h1('testing'),
+               "This page called $counter times";
+    }
+
+You are of course free to refer to create and use global variables
+within your draw routine in order to achieve special effects.
+
+=item -last_page
+
+This optional parameter points to a reference to the subroutine
+responsible for drawing the last page of the series.  It is called
+after the -next_page routine returns a false value.  The subroutine
+itself should have exactly the same calling conventions as the
+-next_page routine.
+
+=item -type
+
+This optional parameter indicates the content type of each page.  It
+defaults to "text/html".  Normally the module assumes that each page
+is of a homogenous MIME type.  However if you provide either of the
+magic values "heterogeneous" or "dynamic" (the latter provided for the
+convenience of those who hate long parameter names), you can specify
+the MIME type -- and other header fields -- on a per-page basis.  See 
+"heterogeneous pages" for more details.
+
+=item -delay
+
+This indicates the delay, in seconds, between frames.  Smaller delays
+refresh the page faster.  Fractional values are allowed.
+
+B<If not specified, -delay will default to 1 second>
+
+=item -cookie, -target, -expires, -nph
+
+These have the same meaning as the like-named parameters in
+CGI::header().
+
+If not specified, -nph will default to 1 (as needed for many servers, see below).
+
+=back
+
+=head2 Heterogeneous Pages
+
+Ordinarily all pages displayed by CGI::Push share a common MIME type.
+However by providing a value of "heterogeneous" or "dynamic" in the
+do_push() -type parameter, you can specify the MIME type of each page
+on a case-by-case basis.  
+
+If you use this option, you will be responsible for producing the
+HTTP header for each page.  Simply modify your draw routine to
+look like this:
+
+    sub my_draw_routine {
+        my($q,$counter) = @_;
+        return header('text/html'),   # note we're producing the header here
+               start_html('testing'),
+               h1('testing'),
+               "This page called $counter times";
+    }
+
+You can add any header fields that you like, but some (cookies and
+status fields included) may not be interpreted by the browser.  One
+interesting effect is to display a series of pages, then, after the
+last page, to redirect the browser to a new URL.  Because redirect() 
+does b<not> work, the easiest way is with a -refresh header field,
+as shown below:
+
+    sub my_draw_routine {
+        my($q,$counter) = @_;
+        return undef if $counter > 10;
+        return header('text/html'),   # note we're producing the header here
+               start_html('testing'),
+               h1('testing'),
+               "This page called $counter times";
+    }
+
+    sub my_last_page {
+        return header(-refresh=>'5; URL=http://somewhere.else/finished.html',
+                      -type=>'text/html'),
+               start_html('Moved'),
+               h1('This is the last page'),
+               'Goodbye!'
+               hr,
+               end_html; 
+    }
+
+=head2 Changing the Page Delay on the Fly
+
+If you would like to control the delay between pages on a page-by-page
+basis, call push_delay() from within your draw routine.  push_delay()
+takes a single numeric argument representing the number of seconds you
+wish to delay after the current page is displayed and before
+displaying the next one.  The delay may be fractional.  Without
+parameters, push_delay() just returns the current delay.
+
+=head1 INSTALLING CGI::Push SCRIPTS
+
+Server push scripts must be installed as no-parsed-header (NPH)
+scripts in order to work correctly on many servers.  On Unix systems,
+this is most often accomplished by prefixing the script's name with "nph-".  
+Recognition of NPH scripts happens automatically with WebSTAR and 
+Microsoft IIS.  Users of other servers should see their documentation
+for help.
+
+Apache web server from version 1.3b2 on does not need server
+push scripts installed as NPH scripts: the -nph parameter to do_push()
+may be set to a false value to disable the extra headers needed by an
+NPH script.
+
+=head1 AUTHOR INFORMATION
+
+Copyright 1995-1998, Lincoln D. Stein.  All rights reserved.  
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Address bug reports and comments to: lstein@cshl.org
+
+=head1 BUGS
+
+This section intentionally left blank.
+
+=head1 SEE ALSO
+
+L<CGI::Carp>, L<CGI>
+
+=cut
+
Index: /for-distributions/trunk/bin/windows/perl/lib/CGI/Switch.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/CGI/Switch.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/CGI/Switch.pm	(revision 14265)
@@ -0,0 +1,24 @@
+use CGI;
+1;
+
+__END__
+
+=head1 NAME
+
+CGI::Switch - Backward compatibility module for defunct CGI::Switch
+
+=head1 SYNOPSIS
+
+Do not use this module.  It is deprecated.
+
+=head1 ABSTRACT
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR INFORMATION
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/CGI/Util.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/CGI/Util.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/CGI/Util.pm	(revision 14265)
@@ -0,0 +1,258 @@
+package CGI::Util;
+
+use strict;
+use vars '$VERSION','@EXPORT_OK','@ISA','$EBCDIC','@A2E','@E2A';
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(rearrange make_attributes unescape escape expires);
+
+$VERSION = '1.1';
+
+$EBCDIC = "\t" ne "\011";
+if ($EBCDIC) {
+# (ord('^') == 95) for codepage 1047 as on os390, vmesa
+@A2E = (
+  0,  1,  2,  3, 55, 45, 46, 47, 22,  5, 21, 11, 12, 13, 14, 15,
+ 16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31,
+ 64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
+240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111,
+124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214,
+215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109,
+121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150,
+151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161,  7,
+ 32, 33, 34, 35, 36, 37,  6, 23, 40, 41, 42, 43, 44,  9, 10, 27,
+ 48, 49, 26, 51, 52, 53, 54,  8, 56, 57, 58, 59,  4, 20, 62,255,
+ 65,170, 74,177,159,178,106,181,187,180,154,138,176,202,175,188,
+144,143,234,250,190,160,182,179,157,218,155,139,183,184,185,171,
+100,101, 98,102, 99,103,158,104,116,113,114,115,120,117,118,119,
+172,105,237,238,235,239,236,191,128,253,254,251,252,186,174, 89,
+ 68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87,
+140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223
+      );
+@E2A = (
+  0,  1,  2,  3,156,  9,134,127,151,141,142, 11, 12, 13, 14, 15,
+ 16, 17, 18, 19,157, 10,  8,135, 24, 25,146,143, 28, 29, 30, 31,
+128,129,130,131,132,133, 23, 27,136,137,138,139,140,  5,  6,  7,
+144,145, 22,147,148,149,150,  4,152,153,154,155, 20, 21,158, 26,
+ 32,160,226,228,224,225,227,229,231,241,162, 46, 60, 40, 43,124,
+ 38,233,234,235,232,237,238,239,236,223, 33, 36, 42, 41, 59, 94,
+ 45, 47,194,196,192,193,195,197,199,209,166, 44, 37, 95, 62, 63,
+248,201,202,203,200,205,206,207,204, 96, 58, 35, 64, 39, 61, 34,
+216, 97, 98, 99,100,101,102,103,104,105,171,187,240,253,254,177,
+176,106,107,108,109,110,111,112,113,114,170,186,230,184,198,164,
+181,126,115,116,117,118,119,120,121,122,161,191,208, 91,222,174,
+172,163,165,183,169,167,182,188,189,190,221,168,175, 93,180,215,
+123, 65, 66, 67, 68, 69, 70, 71, 72, 73,173,244,246,242,243,245,
+125, 74, 75, 76, 77, 78, 79, 80, 81, 82,185,251,252,249,250,255,
+ 92,247, 83, 84, 85, 86, 87, 88, 89, 90,178,212,214,210,211,213,
+ 48, 49, 50, 51, 52, 53, 54, 55, 56, 57,179,219,220,217,218,159
+      );
+if (ord('^') == 106) { # as in the BS2000 posix-bc coded character set
+    $A2E[91] = 187;   $A2E[92] = 188;  $A2E[94] = 106;  $A2E[96] = 74;
+    $A2E[123] = 251;  $A2E[125] = 253; $A2E[126] = 255; $A2E[159] = 95;
+    $A2E[162] = 176;  $A2E[166] = 208; $A2E[168] = 121; $A2E[172] = 186;
+    $A2E[175] = 161;  $A2E[217] = 224; $A2E[219] = 221; $A2E[221] = 173;
+    $A2E[249] = 192;
+
+    $E2A[74] = 96;   $E2A[95] = 159;  $E2A[106] = 94;  $E2A[121] = 168;
+    $E2A[161] = 175; $E2A[173] = 221; $E2A[176] = 162; $E2A[186] = 172;
+    $E2A[187] = 91;  $E2A[188] = 92;  $E2A[192] = 249; $E2A[208] = 166;
+    $E2A[221] = 219; $E2A[224] = 217; $E2A[251] = 123; $E2A[253] = 125;
+    $E2A[255] = 126;
+}
+elsif (ord('^') == 176) { # as in codepage 037 on os400
+    $A2E[10] = 37;  $A2E[91] = 186;  $A2E[93] = 187; $A2E[94] = 176;
+    $A2E[133] = 21; $A2E[168] = 189; $A2E[172] = 95; $A2E[221] = 173;
+
+    $E2A[21] = 133; $E2A[37] = 10;  $E2A[95] = 172; $E2A[173] = 221;
+    $E2A[176] = 94; $E2A[186] = 91; $E2A[187] = 93; $E2A[189] = 168;
+}
+}
+
+# Smart rearrangement of parameters to allow named parameter
+# calling.  We do the rearangement if:
+# the first parameter begins with a -
+sub rearrange {
+    my($order,@param) = @_;
+    return () unless @param;
+
+    if (ref($param[0]) eq 'HASH') {
+	@param = %{$param[0]};
+    } else {
+	return @param 
+	    unless (defined($param[0]) && substr($param[0],0,1) eq '-');
+    }
+
+    # map parameters into positional indices
+    my ($i,%pos);
+    $i = 0;
+    foreach (@$order) {
+	foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{lc($_)} = $i; }
+	$i++;
+    }
+
+    my (@result,%leftover);
+    $#result = $#$order;  # preextend
+    while (@param) {
+	my $key = lc(shift(@param));
+	$key =~ s/^\-//;
+	if (exists $pos{$key}) {
+	    $result[$pos{$key}] = shift(@param);
+	} else {
+	    $leftover{$key} = shift(@param);
+	}
+    }
+
+    push (@result,make_attributes(\%leftover,1)) if %leftover;
+    @result;
+}
+
+sub make_attributes {
+    my $attr = shift;
+    return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
+    my $escape = shift || 0;
+    my(@att);
+    foreach (keys %{$attr}) {
+	my($key) = $_;
+	$key=~s/^\-//;     # get rid of initial - if present
+	$key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes
+	my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_};
+	push(@att,defined($attr->{$_}) ? qq/$key="$value"/ : qq/$key/);
+    }
+    return @att;
+}
+
+sub simple_escape {
+  return unless defined(my $toencode = shift);
+  $toencode =~ s{&}{&amp;}gso;
+  $toencode =~ s{<}{&lt;}gso;
+  $toencode =~ s{>}{&gt;}gso;
+  $toencode =~ s{\"}{&quot;}gso;
+# Doesn't work.  Can't work.  forget it.
+#  $toencode =~ s{\x8b}{&#139;}gso;
+#  $toencode =~ s{\x9b}{&#155;}gso;
+  $toencode;
+}
+
+# unescape URL-encoded data
+sub unescape {
+  shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass);
+  my $todecode = shift;
+  return undef unless defined($todecode);
+  $todecode =~ tr/+/ /;       # pluses become spaces
+    $EBCDIC = "\t" ne "\011";
+    if ($EBCDIC) {
+      $todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
+    } else {
+      $todecode =~ s/%([0-9a-fA-F]{2})/chr hex($1)/ge;
+    }
+  return $todecode;
+}
+
+# URL-encode data
+sub escape {
+  shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass);
+  my $toencode = shift;
+  return undef unless defined($toencode);
+    if ($EBCDIC) {
+      $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
+    } else {
+      $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
+    }
+  return $toencode;
+}
+
+# This internal routine creates date strings suitable for use in
+# cookies and HTTP headers.  (They differ, unfortunately.)
+# Thanks to Mark Fisher for this.
+sub expires {
+    my($time,$format) = @_;
+    $format ||= 'http';
+
+    my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
+    my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;
+
+    # pass through preformatted dates for the sake of expire_calc()
+    $time = expire_calc($time);
+    return $time unless $time =~ /^\d+$/;
+
+    # make HTTP/cookie date string from GMT'ed time
+    # (cookies use '-' as date separator, HTTP uses ' ')
+    my($sc) = ' ';
+    $sc = '-' if $format eq "cookie";
+    my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
+    $year += 1900;
+    return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT",
+                   $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);
+}
+
+# This internal routine creates an expires time exactly some number of
+# hours from the current time.  It incorporates modifications from 
+# Mark Fisher.
+sub expire_calc {
+    my($time) = @_;
+    my(%mult) = ('s'=>1,
+                 'm'=>60,
+                 'h'=>60*60,
+                 'd'=>60*60*24,
+                 'M'=>60*60*24*30,
+                 'y'=>60*60*24*365);
+    # format for time can be in any of the forms...
+    # "now" -- expire immediately
+    # "+180s" -- in 180 seconds
+    # "+2m" -- in 2 minutes
+    # "+12h" -- in 12 hours
+    # "+1d"  -- in 1 day
+    # "+3M"  -- in 3 months
+    # "+2y"  -- in 2 years
+    # "-3m"  -- 3 minutes ago(!)
+    # If you don't supply one of these forms, we assume you are
+    # specifying the date yourself
+    my($offset);
+    if (!$time || (lc($time) eq 'now')) {
+        $offset = 0;
+    } elsif ($time=~/^\d+/) {
+        return $time;
+    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
+        $offset = ($mult{$2} || 1)*$1;
+    } else {
+        return $time;
+    }
+    return (time+$offset);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+CGI::Util - Internal utilities used by CGI module
+
+=head1 SYNOPSIS
+
+none
+
+=head1 DESCRIPTION
+
+no public subroutines
+
+=head1 AUTHOR INFORMATION
+
+Copyright 1995-1998, Lincoln D. Stein.  All rights reserved.  
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Address bug reports and comments to: lstein@cshl.org.  When sending
+bug reports, please provide the version of CGI.pm, the version of
+Perl, the name and version of your Web server, and the name and
+version of the operating system you are using.  If the problem is even
+remotely browser dependent, please provide information about the
+affected browers as well.
+
+=head1 SEE ALSO
+
+L<CGI>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/Carp.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Carp.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Carp.pm	(revision 14265)
@@ -0,0 +1,124 @@
+package Carp;
+
+=head1 NAME
+
+carp    - warn of errors (from perspective of caller)
+
+cluck   - warn of errors with stack backtrace
+          (not exported by default)
+
+croak   - die of errors (from perspective of caller)
+
+confess - die of errors with stack backtrace
+
+=head1 SYNOPSIS
+
+    use Carp;
+    croak "We're outta here!";
+
+    use Carp qw(cluck);
+    cluck "This is how we got here!";
+
+=head1 DESCRIPTION
+
+The Carp routines are useful in your own modules because
+they act like die() or warn(), but report where the error
+was in the code they were called from.  Thus if you have a 
+routine Foo() that has a carp() in it, then the carp() 
+will report the error as occurring where Foo() was called, 
+not where carp() was called.
+
+=head2 Forcing a Stack Trace
+
+As a debugging aid, you can force Carp to treat a croak as a confess
+and a carp as a cluck across I<all> modules. In other words, force a
+detailed stack trace to be given.  This can be very helpful when trying
+to understand why, or from where, a warning or error is being generated.
+
+This feature is enabled by 'importing' the non-existent symbol
+'verbose'. You would typically enable it by saying
+
+    perl -MCarp=verbose script.pl
+
+or by including the string C<MCarp=verbose> in the L<PERL5OPT>
+environment variable.
+
+=head1 BUGS
+
+The Carp routines don't handle exception objects currently.
+If called with a first argument that is a reference, they simply
+call die() or warn(), as appropriate.
+
+=cut
+
+# This package is heavily used. Be small. Be fast. Be good.
+
+# Comments added by Andy Wardley <abw@kfs.org> 09-Apr-98, based on an
+# _almost_ complete understanding of the package.  Corrections and
+# comments are welcome.
+
+# The $CarpLevel variable can be set to "strip off" extra caller levels for
+# those times when Carp calls are buried inside other functions.  The
+# $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
+# text and function arguments should be formatted when printed.
+
+$CarpLevel = 0;		# How many extra package levels to skip on carp.
+$MaxEvalLen = 0;	# How much eval '...text...' to show. 0 = all.
+$MaxArgLen = 64;        # How much of each argument to print. 0 = all.
+$MaxArgNums = 8;        # How many arguments to print. 0 = all.
+$Verbose = 0;		# If true then make shortmess call longmess instead
+
+require Exporter;
+@ISA = ('Exporter');
+@EXPORT = qw(confess croak carp);
+@EXPORT_OK = qw(cluck verbose);
+@EXPORT_FAIL = qw(verbose);	# hook to enable verbose mode
+
+
+# if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
+# then the following method will be called by the Exporter which knows
+# to do this thanks to @EXPORT_FAIL, above.  $_[1] will contain the word
+# 'verbose'.
+
+sub export_fail {
+    shift;
+    $Verbose = shift if $_[0] eq 'verbose';
+    return @_;
+}
+
+
+# longmess() crawls all the way up the stack reporting on all the function
+# calls made.  The error string, $error, is originally constructed from the
+# arguments passed into longmess() via confess(), cluck() or shortmess().
+# This gets appended with the stack trace messages which are generated for
+# each function call on the stack.
+
+sub longmess {
+    { local $@; require Carp::Heavy; }	# XXX fix require to not clear $@?
+    goto &longmess_heavy;
+}
+
+
+# shortmess() is called by carp() and croak() to skip all the way up to
+# the top-level caller's package and report the error from there.  confess()
+# and cluck() generate a full stack trace so they call longmess() to
+# generate that.  In verbose mode shortmess() calls longmess() so
+# you always get a stack trace
+
+sub shortmess {	# Short-circuit &longmess if called via multiple packages
+    { local $@; require Carp::Heavy; }	# XXX fix require to not clear $@?
+    goto &shortmess_heavy;
+}
+
+
+# the following four functions call longmess() or shortmess() depending on
+# whether they should generate a full stack trace (confess() and cluck())
+# or simply report the caller's package (croak() and carp()), respectively.
+# confess() and croak() die, carp() and cluck() warn.
+
+sub croak   { die  shortmess @_ }
+sub confess { die  longmess  @_ }
+sub carp    { warn shortmess @_ }
+sub cluck   { warn longmess  @_ }
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Carp/Heavy.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Carp/Heavy.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Carp/Heavy.pm	(revision 14265)
@@ -0,0 +1,247 @@
+package Carp;
+
+=head1 NAME
+
+Carp::Heavy - Carp guts
+
+=head1 SYNOPIS
+
+(internal use only)
+
+=head1 DESCRIPTION
+
+No user-serviceable parts inside.
+
+=cut
+
+# This package is heavily used. Be small. Be fast. Be good.
+
+# Comments added by Andy Wardley <abw@kfs.org> 09-Apr-98, based on an
+# _almost_ complete understanding of the package.  Corrections and
+# comments are welcome.
+
+# longmess() crawls all the way up the stack reporting on all the function
+# calls made.  The error string, $error, is originally constructed from the
+# arguments passed into longmess() via confess(), cluck() or shortmess().
+# This gets appended with the stack trace messages which are generated for
+# each function call on the stack.
+
+sub longmess_heavy {
+    return @_ if ref $_[0];
+    my $error = join '', @_;
+    my $mess = "";
+    my $i = 1 + $CarpLevel;
+    my ($pack,$file,$line,$sub,$hargs,$eval,$require);
+    my (@a);
+    #
+    # crawl up the stack....
+    #
+    while (do { { package DB; @a = caller($i++) } } ) {
+	# get copies of the variables returned from caller()
+	($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
+	#
+	# if the $error error string is newline terminated then it
+	# is copied into $mess.  Otherwise, $mess gets set (at the end of
+	# the 'else' section below) to one of two things.  The first time
+	# through, it is set to the "$error at $file line $line" message.
+	# $error is then set to 'called' which triggers subsequent loop
+	# iterations to append $sub to $mess before appending the "$error
+	# at $file line $line" which now actually reads "called at $file line
+	# $line".  Thus, the stack trace message is constructed:
+	#
+	#        first time: $mess  = $error at $file line $line
+	#  subsequent times: $mess .= $sub $error at $file line $line
+	#                                  ^^^^^^
+	#                                 "called"
+	if ($error =~ m/\n$/) {
+	    $mess .= $error;
+	} else {
+	    # Build a string, $sub, which names the sub-routine called.
+	    # This may also be "require ...", "eval '...' or "eval {...}"
+	    if (defined $eval) {
+		if ($require) {
+		    $sub = "require $eval";
+		} else {
+		    $eval =~ s/([\\\'])/\\$1/g;
+		    if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
+			substr($eval,$MaxEvalLen) = '...';
+		    }
+		    $sub = "eval '$eval'";
+		}
+	    } elsif ($sub eq '(eval)') {
+		$sub = 'eval {...}';
+	    }
+	    # if there are any arguments in the sub-routine call, format
+	    # them according to the format variables defined earlier in
+	    # this file and join them onto the $sub sub-routine string
+	    if ($hargs) {
+		# we may trash some of the args so we take a copy
+		@a = @DB::args;	# must get local copy of args
+		# don't print any more than $MaxArgNums
+		if ($MaxArgNums and @a > $MaxArgNums) {
+		    # cap the length of $#a and set the last element to '...'
+		    $#a = $MaxArgNums;
+		    $a[$#a] = "...";
+		}
+		for (@a) {
+		    # set args to the string "undef" if undefined
+		    $_ = "undef", next unless defined $_;
+		    if (ref $_) {
+			# force reference to string representation
+			$_ .= '';
+			s/'/\\'/g;
+		    }
+		    else {
+			s/'/\\'/g;
+			# terminate the string early with '...' if too long
+			substr($_,$MaxArgLen) = '...'
+			    if $MaxArgLen and $MaxArgLen < length;
+		    }
+		    # 'quote' arg unless it looks like a number
+		    $_ = "'$_'" unless /^-?[\d.]+$/;
+		    # print high-end chars as 'M-<char>'
+		    s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+		    # print remaining control chars as ^<char>
+		    s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+		}
+		# append ('all', 'the', 'arguments') to the $sub string
+		$sub .= '(' . join(', ', @a) . ')';
+	    }
+	    # here's where the error message, $mess, gets constructed
+	    $mess .= "\t$sub " if $error eq "called";
+	    $mess .= "$error at $file line $line";
+	    if (defined &Thread::tid) {
+		my $tid = Thread->self->tid;
+		$mess .= " thread $tid" if $tid;
+	    }
+	    $mess .= "\n";
+	}
+	# we don't need to print the actual error message again so we can
+	# change this to "called" so that the string "$error at $file line
+	# $line" makes sense as "called at $file line $line".
+	$error = "called";
+    }
+    $mess || $error;
+}
+
+
+# ancestors() returns the complete set of ancestors of a module
+
+sub ancestors($$);
+
+sub ancestors($$){
+    my( $pack, $href ) = @_;
+    if( @{"${pack}::ISA"} ){
+	my $risa = \@{"${pack}::ISA"};
+	my %tree  = ();
+	@tree{@$risa} = ();
+	foreach my $mod ( @$risa ){
+	    # visit ancestors - if not already in the gallery
+	    if( ! defined( $$href{$mod} ) ){
+		my @ancs = ancestors( $mod, $href );
+		@tree{@ancs} = ();
+	    }
+	}
+	return ( keys( %tree ) );
+    } else {
+	return ();
+    }
+}
+
+
+# shortmess() is called by carp() and croak() to skip all the way up to
+# the top-level caller's package and report the error from there.  confess()
+# and cluck() generate a full stack trace so they call longmess() to
+# generate that.  In verbose mode shortmess() calls longmess() so
+# you always get a stack trace
+
+sub shortmess_heavy {	# Short-circuit &longmess if called via multiple packages
+    goto &longmess_heavy if $Verbose;
+    return @_ if ref $_[0];
+    my $error = join '', @_;
+    my ($prevpack) = caller(1);
+    my $extra = $CarpLevel;
+
+    my @Clans = ( $prevpack );
+    my $i = 2;
+    my ($pack,$file,$line);
+    # when reporting an error, we want to report it from the context of the
+    # calling package.  So what is the calling package?  Within a module,
+    # there may be many calls between methods and perhaps between sub-classes
+    # and super-classes, but the user isn't interested in what happens
+    # inside the package.  We start by building a hash array which keeps
+    # track of all the packages to which the calling package belongs.  We
+    # do this by examining its @ISA variable.  Any call from a base class
+    # method (one of our caller's @ISA packages) can be ignored
+    my %isa;
+
+    # merge all the caller's @ISA packages and ancestors into %isa.
+    my @pars = ancestors( $prevpack, \%isa );
+    @isa{@pars} = () if @pars;
+    $isa{$prevpack} = 1;
+
+    # now we crawl up the calling stack and look at all the packages in
+    # there.  For each package, we look to see if it has an @ISA and then
+    # we see if our caller features in that list.  That would imply that
+    # our caller is a derived class of that package and its calls can also
+    # be ignored
+CALLER:
+    while (($pack,$file,$line) = caller($i++)) {
+
+        # Chances are, the caller's caller (or its caller...) is already
+        # in the gallery - if so, ignore this caller.
+        next if exists( $isa{$pack} );
+
+        # no: collect this module's ancestors.
+        my @i = ancestors( $pack, \%isa );
+        my %i;
+        if( @i ){
+ 	    @i{@i} = ();
+            # check whether our representative of one of the clans is
+            # in this family tree.
+	    foreach my $cl (@Clans){
+                if( exists( $i{$cl} ) ){
+    	            # yes: merge all of the family tree into %isa
+	            @isa{@i,$pack} = ();
+		    # and here's where we do some more ignoring...
+		    # if the package in question is one of our caller's
+		    # base or derived packages then we can ignore it (skip it)
+		    # and go onto the next.
+		    next CALLER if exists( $isa{$pack} );
+		    last;
+		}
+            }
+	}
+
+	# Hey!  We've found a package that isn't one of our caller's
+	# clan....but wait, $extra refers to the number of 'extra' levels
+	# we should skip up.  If $extra > 0 then this is a false alarm.
+	# We must merge the package into the %isa hash (so we can ignore it
+	# if it pops up again), decrement $extra, and continue.
+	if ($extra-- > 0) {
+	    push( @Clans, $pack );
+	    @isa{@i,$pack} = ();
+	}
+	else {
+	    # OK!  We've got a candidate package.  Time to construct the
+	    # relevant error message and return it.
+	    my $msg;
+	    $msg = "$error at $file line $line";
+	    if (defined &Thread::tid) {
+		my $tid = Thread->self->tid;
+		$msg .= " thread $tid" if $tid;
+	    }
+	    $msg .= "\n";
+	    return $msg;
+	}
+    }
+
+    # uh-oh!  It looks like we crawled all the way up the stack and
+    # never found a candidate package.  Oh well, let's call longmess
+    # to generate a full stack trace.  We use the magical form of 'goto'
+    # so that this shortmess() function doesn't appear on the stack
+    # to further confuse longmess() about it's calling package.
+    goto &longmess_heavy;
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Class/Struct.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Class/Struct.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Class/Struct.pm	(revision 14265)
@@ -0,0 +1,602 @@
+package Class::Struct;
+
+## See POD after __END__
+
+use 5.005_64;
+
+use strict;
+use warnings::register;
+our(@ISA, @EXPORT, $VERSION);
+
+use Carp;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(struct);
+
+$VERSION = '0.59';
+
+## Tested on 5.002 and 5.003 without class membership tests:
+my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95);
+
+my $print = 0;
+sub printem {
+    if (@_) { $print = shift }
+    else    { $print++ }
+}
+
+{
+    package Class::Struct::Tie_ISA;
+
+    sub TIEARRAY {
+        my $class = shift;
+        return bless [], $class;
+    }
+
+    sub STORE {
+        my ($self, $index, $value) = @_;
+        Class::Struct::_subclass_error();
+    }
+
+    sub FETCH {
+        my ($self, $index) = @_;
+        $self->[$index];
+    }
+
+    sub FETCHSIZE {
+        my $self = shift;
+        return scalar(@$self);
+    }
+
+    sub DESTROY { }
+}
+
+sub import {
+    my $self = shift;
+
+    if ( @_ == 0 ) {
+      $self->export_to_level( 1, $self, @EXPORT );
+    } elsif ( @_ == 1 ) {
+	# This is admittedly a little bit silly:
+	# do we ever export anything else than 'struct'...?
+      $self->export_to_level( 1, $self, @_ );
+    } else {
+      &struct;
+    }
+}
+
+sub struct {
+
+    # Determine parameter list structure, one of:
+    #   struct( class => [ element-list ])
+    #   struct( class => { element-list })
+    #   struct( element-list )
+    # Latter form assumes current package name as struct name.
+
+    my ($class, @decls);
+    my $base_type = ref $_[1];
+    if ( $base_type eq 'HASH' ) {
+        $class = shift;
+        @decls = %{shift()};
+        _usage_error() if @_;
+    }
+    elsif ( $base_type eq 'ARRAY' ) {
+        $class = shift;
+        @decls = @{shift()};
+        _usage_error() if @_;
+    }
+    else {
+        $base_type = 'ARRAY';
+        $class = (caller())[0];
+        @decls = @_;
+    }
+
+    _usage_error() if @decls % 2 == 1;
+
+    # Ensure we are not, and will not be, a subclass.
+
+    my $isa = do {
+        no strict 'refs';
+        \@{$class . '::ISA'};
+    };
+    _subclass_error() if @$isa;
+    tie @$isa, 'Class::Struct::Tie_ISA';
+
+    # Create constructor.
+
+    croak "function 'new' already defined in package $class"
+        if do { no strict 'refs'; defined &{$class . "::new"} };
+
+    my @methods = ();
+    my %refs = ();
+    my %arrays = ();
+    my %hashes = ();
+    my %classes = ();
+    my $got_class = 0;
+    my $out = '';
+
+    $out = "{\n  package $class;\n  use Carp;\n  sub new {\n";
+    $out .= "    my (\$class, \%init) = \@_;\n";
+    $out .= "    \$class = __PACKAGE__ unless \@_;\n";
+
+    my $cnt = 0;
+    my $idx = 0;
+    my( $cmt, $name, $type, $elem );
+
+    if( $base_type eq 'HASH' ){
+        $out .= "    my(\$r) = {};\n";
+        $cmt = '';
+    }
+    elsif( $base_type eq 'ARRAY' ){
+        $out .= "    my(\$r) = [];\n";
+    }
+    while( $idx < @decls ){
+        $name = $decls[$idx];
+        $type = $decls[$idx+1];
+        push( @methods, $name );
+        if( $base_type eq 'HASH' ){
+            $elem = "{'${class}::$name'}";
+        }
+        elsif( $base_type eq 'ARRAY' ){
+            $elem = "[$cnt]";
+            ++$cnt;
+            $cmt = " # $name";
+        }
+        if( $type =~ /^\*(.)/ ){
+            $refs{$name}++;
+            $type = $1;
+        }
+        my $init = "defined(\$init{'$name'}) ? \$init{'$name'} :";
+        if( $type eq '@' ){
+            $out .= "    croak 'Initializer for $name must be array reference'\n"; 
+            $out .= "        if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'ARRAY';\n";
+            $out .= "    \$r->$elem = $init [];$cmt\n"; 
+            $arrays{$name}++;
+        }
+        elsif( $type eq '%' ){
+            $out .= "    croak 'Initializer for $name must be hash reference'\n";
+            $out .= "        if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'HASH';\n";
+            $out .= "    \$r->$elem = $init {};$cmt\n";
+            $hashes{$name}++;
+        }
+        elsif ( $type eq '$') {
+            $out .= "    \$r->$elem = $init undef;$cmt\n";
+        }
+        elsif( $type =~ /^\w+(?:::\w+)*$/ ){
+            $init = "defined(\$init{'$name'}) ? \%{\$init{'$name'}} : ()";
+            $out .= "    croak 'Initializer for $name must be hash reference'\n";
+            $out .= "        if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'HASH';\n";
+            $out .= "    \$r->$elem = '${type}'->new($init);$cmt\n";
+            $classes{$name} = $type;
+            $got_class = 1;
+        }
+        else{
+            croak "'$type' is not a valid struct element type";
+        }
+        $idx += 2;
+    }
+    $out .= "    bless \$r, \$class;\n  }\n";
+
+    # Create accessor methods.
+
+    my( $pre, $pst, $sel );
+    $cnt = 0;
+    foreach $name (@methods){
+        if ( do { no strict 'refs'; defined &{$class . "::$name"} } ) {
+            warnings::warnif("function '$name' already defined, overrides struct accessor method");
+        }
+        else {
+            $pre = $pst = $cmt = $sel = '';
+            if( defined $refs{$name} ){
+                $pre = "\\(";
+                $pst = ")";
+                $cmt = " # returns ref";
+            }
+            $out .= "  sub $name {$cmt\n    my \$r = shift;\n";
+            if( $base_type eq 'ARRAY' ){
+                $elem = "[$cnt]";
+                ++$cnt;
+            }
+            elsif( $base_type eq 'HASH' ){
+                $elem = "{'${class}::$name'}";
+            }
+            if( defined $arrays{$name} ){
+                $out .= "    my \$i;\n";
+                $out .= "    \@_ ? (\$i = shift) : return \$r->$elem;\n"; 
+                $sel = "->[\$i]";
+            }
+            elsif( defined $hashes{$name} ){
+                $out .= "    my \$i;\n";
+                $out .= "    \@_ ? (\$i = shift) : return \$r->$elem;\n"; 
+                $sel = "->{\$i}";
+            }
+            elsif( defined $classes{$name} ){
+                if ( $CHECK_CLASS_MEMBERSHIP ) {
+                    $out .= "    croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$classes{$name}');\n";
+                }
+            }
+            $out .= "    croak 'Too many args to $name' if \@_ > 1;\n";
+            $out .= "    \@_ ? ($pre\$r->$elem$sel = shift$pst) : $pre\$r->$elem$sel$pst;\n";
+            $out .= "  }\n";
+        }
+    }
+    $out .= "}\n1;\n";
+
+    print $out if $print;
+    my $result = eval $out;
+    carp $@ if $@;
+}
+
+sub _usage_error {
+    confess "struct usage error";
+}
+
+sub _subclass_error {
+    croak 'struct class cannot be a subclass (@ISA not allowed)';
+}
+
+1; # for require
+
+
+__END__
+
+=head1 NAME
+
+Class::Struct - declare struct-like datatypes as Perl classes
+
+=head1 SYNOPSIS
+
+    use Class::Struct;
+            # declare struct, based on array:
+    struct( CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]);
+            # declare struct, based on hash:
+    struct( CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... });
+
+    package CLASS_NAME;
+    use Class::Struct;
+            # declare struct, based on array, implicit class name:
+    struct( ELEMENT_NAME => ELEMENT_TYPE, ... );
+
+    # Declare struct at compile time
+    use Class::Struct CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ];
+    use Class::Struct CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... };
+
+    package Myobj;
+    use Class::Struct;
+            # declare struct with four types of elements:
+    struct( s => '$', a => '@', h => '%', c => 'My_Other_Class' );
+
+    $obj = new Myobj;               # constructor
+
+                                    # scalar type accessor:
+    $element_value = $obj->s;           # element value
+    $obj->s('new value');               # assign to element
+
+                                    # array type accessor:
+    $ary_ref = $obj->a;                 # reference to whole array
+    $ary_element_value = $obj->a(2);    # array element value
+    $obj->a(2, 'new value');            # assign to array element
+
+                                    # hash type accessor:
+    $hash_ref = $obj->h;                # reference to whole hash
+    $hash_element_value = $obj->h('x'); # hash element value
+    $obj->h('x', 'new value');          # assign to hash element
+
+                                    # class type accessor:
+    $element_value = $obj->c;           # object reference
+    $obj->c->method(...);               # call method of object
+    $obj->c(new My_Other_Class);        # assign a new object
+
+=head1 DESCRIPTION
+
+C<Class::Struct> exports a single function, C<struct>.
+Given a list of element names and types, and optionally
+a class name, C<struct> creates a Perl 5 class that implements
+a "struct-like" data structure.
+
+The new class is given a constructor method, C<new>, for creating
+struct objects.
+
+Each element in the struct data has an accessor method, which is
+used to assign to the element and to fetch its value.  The
+default accessor can be overridden by declaring a C<sub> of the
+same name in the package.  (See Example 2.)
+
+Each element's type can be scalar, array, hash, or class.
+
+=head2 The C<struct()> function
+
+The C<struct> function has three forms of parameter-list.
+
+    struct( CLASS_NAME => [ ELEMENT_LIST ]);
+    struct( CLASS_NAME => { ELEMENT_LIST });
+    struct( ELEMENT_LIST );
+
+The first and second forms explicitly identify the name of the
+class being created.  The third form assumes the current package
+name as the class name.
+
+An object of a class created by the first and third forms is
+based on an array, whereas an object of a class created by the
+second form is based on a hash. The array-based forms will be
+somewhat faster and smaller; the hash-based forms are more
+flexible.
+
+The class created by C<struct> must not be a subclass of another
+class other than C<UNIVERSAL>.
+
+It can, however, be used as a superclass for other classes. To facilitate
+this, the generated constructor method uses a two-argument blessing.
+Furthermore, if the class is hash-based, the key of each element is
+prefixed with the class name (see I<Perl Cookbook>, Recipe 13.12).
+
+A function named C<new> must not be explicitly defined in a class
+created by C<struct>.
+
+The I<ELEMENT_LIST> has the form
+
+    NAME => TYPE, ...
+
+Each name-type pair declares one element of the struct. Each
+element name will be defined as an accessor method unless a
+method by that name is explicitly defined; in the latter case, a
+warning is issued if the warning flag (B<-w>) is set.
+
+=head2 Class Creation at Compile Time
+
+C<Class::Struct> can create your class at compile time.  The main reason
+for doing this is obvious, so your class acts like every other class in
+Perl.  Creating your class at compile time will make the order of events
+similar to using any other class ( or Perl module ).
+
+There is no significant speed gain between compile time and run time
+class creation, there is just a new, more standard order of events.
+
+=head2 Element Types and Accessor Methods
+
+The four element types -- scalar, array, hash, and class -- are
+represented by strings -- C<'$'>, C<'@'>, C<'%'>, and a class name --
+optionally preceded by a C<'*'>.
+
+The accessor method provided by C<struct> for an element depends
+on the declared type of the element.
+
+=over
+
+=item Scalar (C<'$'> or C<'*$'>)
+
+The element is a scalar, and by default is initialized to C<undef>
+(but see L<Initializing with new>).
+
+The accessor's argument, if any, is assigned to the element.
+
+If the element type is C<'$'>, the value of the element (after
+assignment) is returned. If the element type is C<'*$'>, a reference
+to the element is returned.
+
+=item Array (C<'@'> or C<'*@'>)
+
+The element is an array, initialized by default to C<()>.
+
+With no argument, the accessor returns a reference to the
+element's whole array (whether or not the element was
+specified as C<'@'> or C<'*@'>).
+
+With one or two arguments, the first argument is an index
+specifying one element of the array; the second argument, if
+present, is assigned to the array element.  If the element type
+is C<'@'>, the accessor returns the array element value.  If the
+element type is C<'*@'>, a reference to the array element is
+returned.
+
+=item Hash (C<'%'> or C<'*%'>)
+
+The element is a hash, initialized by default to C<()>.
+
+With no argument, the accessor returns a reference to the
+element's whole hash (whether or not the element was
+specified as C<'%'> or C<'*%'>).
+
+With one or two arguments, the first argument is a key specifying
+one element of the hash; the second argument, if present, is
+assigned to the hash element.  If the element type is C<'%'>, the
+accessor returns the hash element value.  If the element type is
+C<'*%'>, a reference to the hash element is returned.
+
+=item Class (C<'Class_Name'> or C<'*Class_Name'>)
+
+The element's value must be a reference blessed to the named
+class or to one of its subclasses. The element is initialized to
+the result of calling the C<new> constructor of the named class.
+
+The accessor's argument, if any, is assigned to the element. The
+accessor will C<croak> if this is not an appropriate object
+reference.
+
+If the element type does not start with a C<'*'>, the accessor
+returns the element value (after assignment). If the element type
+starts with a C<'*'>, a reference to the element itself is returned.
+
+=back
+
+=head2 Initializing with C<new>
+
+C<struct> always creates a constructor called C<new>. That constructor
+may take a list of initializers for the various elements of the new
+struct. 
+
+Each initializer is a pair of values: I<element name>C< =E<gt> >I<value>.
+The initializer value for a scalar element is just a scalar value. The 
+initializer for an array element is an array reference. The initializer
+for a hash is a hash reference.
+
+The initializer for a class element is also a hash reference, and the
+contents of that hash are passed to the element's own constructor.
+
+See Example 3 below for an example of initialization.
+
+=head1 EXAMPLES
+
+=over
+
+=item Example 1
+
+Giving a struct element a class type that is also a struct is how
+structs are nested.  Here, C<timeval> represents a time (seconds and
+microseconds), and C<rusage> has two elements, each of which is of
+type C<timeval>.
+
+    use Class::Struct;
+
+    struct( rusage => {
+        ru_utime => timeval,  # seconds
+        ru_stime => timeval,  # microseconds
+    });
+
+    struct( timeval => [
+        tv_secs  => '$',
+        tv_usecs => '$',
+    ]);
+
+        # create an object:
+    my $t = new rusage;
+
+        # $t->ru_utime and $t->ru_stime are objects of type timeval.
+        # set $t->ru_utime to 100.0 sec and $t->ru_stime to 5.0 sec.
+    $t->ru_utime->tv_secs(100);
+    $t->ru_utime->tv_usecs(0);
+    $t->ru_stime->tv_secs(5);
+    $t->ru_stime->tv_usecs(0);
+
+=item Example 2
+
+An accessor function can be redefined in order to provide
+additional checking of values, etc.  Here, we want the C<count>
+element always to be nonnegative, so we redefine the C<count>
+accessor accordingly.
+
+    package MyObj;
+    use Class::Struct;
+
+    # declare the struct
+    struct ( 'MyObj', { count => '$', stuff => '%' } );
+
+    # override the default accessor method for 'count'
+    sub count {
+        my $self = shift;
+        if ( @_ ) {
+            die 'count must be nonnegative' if $_[0] < 0;
+            $self->{'count'} = shift;
+            warn "Too many args to count" if @_;
+        }
+        return $self->{'count'};
+    }
+
+    package main;
+    $x = new MyObj;
+    print "\$x->count(5) = ", $x->count(5), "\n";
+                            # prints '$x->count(5) = 5'
+
+    print "\$x->count = ", $x->count, "\n";
+                            # prints '$x->count = 5'
+
+    print "\$x->count(-5) = ", $x->count(-5), "\n";
+                            # dies due to negative argument!
+
+=item Example 3
+
+The constructor of a generated class can be passed a list
+of I<element>=>I<value> pairs, with which to initialize the struct.
+If no initializer is specified for a particular element, its default
+initialization is performed instead. Initializers for non-existent
+elements are silently ignored.
+
+Note that the initializer for a nested struct is specified
+as an anonymous hash of initializers, which is passed on to the nested
+struct's constructor.
+
+    use Class::Struct;
+
+    struct Breed =>
+    {
+        name  => '$',
+        cross => '$',
+    };
+
+    struct Cat =>
+    [
+        name     => '$',
+        kittens  => '@',
+        markings => '%',
+        breed    => 'Breed',
+    ];
+
+
+    my $cat = Cat->new( name     => 'Socks',
+                        kittens  => ['Monica', 'Kenneth'],
+                        markings => { socks=>1, blaze=>"white" },
+                        breed    => { name=>'short-hair', cross=>1 },
+                      );
+
+    print "Once a cat called ", $cat->name, "\n";
+    print "(which was a ", $cat->breed->name, ")\n";
+    print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n";
+
+=back
+
+=head1 Author and Modification History
+
+Modified by Casey Tweten, 2000-11-08, v0.59.
+
+    Added the ability for compile time class creation.
+
+Modified by Damian Conway, 1999-03-05, v0.58.
+
+    Added handling of hash-like arg list to class ctor.
+
+    Changed to two-argument blessing in ctor to support
+    derivation from created classes.
+
+    Added classname prefixes to keys in hash-based classes
+    (refer to "Perl Cookbook", Recipe 13.12 for rationale).
+
+    Corrected behaviour of accessors for '*@' and '*%' struct
+    elements.  Package now implements documented behaviour when
+    returning a reference to an entire hash or array element.
+    Previously these were returned as a reference to a reference
+    to the element.
+
+Renamed to C<Class::Struct> and modified by Jim Miner, 1997-04-02.
+
+    members() function removed.
+    Documentation corrected and extended.
+    Use of struct() in a subclass prohibited.
+    User definition of accessor allowed.
+    Treatment of '*' in element types corrected.
+    Treatment of classes as element types corrected.
+    Class name to struct() made optional.
+    Diagnostic checks added.
+
+Originally C<Class::Template> by Dean Roehrich.
+
+    # Template.pm   --- struct/member template builder
+    #   12mar95
+    #   Dean Roehrich
+    #
+    # changes/bugs fixed since 28nov94 version:
+    #  - podified
+    # changes/bugs fixed since 21nov94 version:
+    #  - Fixed examples.
+    # changes/bugs fixed since 02sep94 version:
+    #  - Moved to Class::Template.
+    # changes/bugs fixed since 20feb94 version:
+    #  - Updated to be a more proper module.
+    #  - Added "use strict".
+    #  - Bug in build_methods, was using @var when @$var needed.
+    #  - Now using my() rather than local().
+    #
+    # Uses perl5 classes to create nested data types.
+    # This is offered as one implementation of Tom Christiansen's "structs.pl"
+    # idea.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/Config.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Config.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Config.pm	(revision 14265)
@@ -0,0 +1,1026 @@
+package Config;
+use Exporter ();
+@EXPORT = qw(%Config);
+@EXPORT_OK = qw(myconfig config_sh config_vars);
+
+# Define our own import method to avoid pulling in the full Exporter:
+sub import {
+  my $pkg = shift;
+  @_ = @EXPORT unless @_;
+  my @func = grep {$_ ne '%Config'} @_;
+  local $Exporter::ExportLevel = 1;
+  Exporter::import('Config', @func) if @func;
+  return if @func == @_;
+  my $callpkg = caller(0);
+  *{"$callpkg\::Config"} = \%Config;
+}
+
+die "Perl lib version (v5.6.1) doesn't match executable version ($])"
+    unless $^V;
+
+$^V eq v5.6.1
+  or die "Perl lib version (v5.6.1) doesn't match executable version (" .
+    (sprintf "v%vd",$^V) . ")";
+
+# This file was created by configpm when Perl was built. Any changes
+# made to this file will be lost the next time perl is built.
+
+## Configured by: sjboddie@toetoe.scms.waikato.ac.nz
+### Target system: WIN32 
+
+my $config_sh = <<'!END!';
+archlibexp='c:\sjboddie\gsdl\bin\windows\perl\lib'
+archname='MSWin32-x86-multi-thread'
+cc='cl'
+ccflags='-nologo -O1 -MD -DNDEBUG -DWIN32 -D_CONSOLE -DNO_STRICT   -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DPERL_MSVCRT_READFIX'
+cppflags='-DWIN32'
+dlsrc='dl_win32.xs'
+dynamic_ext='Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re  Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob  Sys/Hostname'
+extensions='DynaLoader Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re  Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob  Sys/Hostname Errno'
+installarchlib='c:\sjboddie\gsdl\bin\windows\perl\lib'
+installprivlib='c:\sjboddie\gsdl\bin\windows\perl\lib'
+libpth='C:\PROGRA~1\MICROS~2\VC98\lib'
+libs='  oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib  comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib  netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib  version.lib odbc32.lib odbccp32.lib msvcrt.lib'
+osname='MSWin32'
+osvers='4.0'
+prefix='c:\sjboddie\gsdl\bin\windows\perl'
+privlibexp='c:\sjboddie\gsdl\bin\windows\perl\lib'
+sharpbang='#!'
+shsharp='true'
+sig_name='ZERO NUM01 INT QUIT ILL NUM05 NUM06 NUM07 FPE KILL NUM10 SEGV NUM12 PIPE ALRM TERM NUM16 NUM17 NUM18 NUM19 CHLD BREAK ABRT STOP NUM24 CONT CLD'
+sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 20 0'
+so='dll'
+startsh='#!/bin/sh'
+static_ext='DynaLoader'
+Author=''
+CONFIGDOTSH='true'
+Date='$Date'
+Header=''
+Id='$Id'
+Locker=''
+Log='$Log'
+PERL_API_REVISION='5'
+PERL_API_SUBVERSION='0'
+PERL_API_VERSION='5'
+PERL_REVISION='5'
+PERL_SUBVERSION='1'
+PERL_VERSION='6'
+RCSfile='$RCSfile'
+Revision='$Revision'
+Source=''
+State=''
+_a='.lib'
+_exe='.exe'
+_o='.obj'
+afs='false'
+alignbytes='8'
+ansi2knr=''
+aphostname=''
+api_revision='5'
+api_subversion='0'
+api_version='5'
+api_versionstring='5.5.0'
+ar='lib'
+archlib='c:\sjboddie\gsdl\bin\windows\perl\lib'
+archname64=''
+archobjs=''
+awk='awk'
+baserev='5'
+bash=''
+bin='c:\sjboddie\gsdl\bin\windows\perl\bin'
+bincompat5005='undef'
+binexp='c:\sjboddie\gsdl\bin\windows\perl\bin'
+bison=''
+byacc='byacc'
+byteorder='1234'
+c=''
+castflags='0'
+cat='type'
+cccdlflags=' '
+ccdlflags=' '
+ccflags_uselargefiles=''
+ccname=''
+ccsymbols=''
+ccversion=''
+cf_by='sjboddie'
+cf_email='sjboddie@toetoe.scms.waikato.ac.nz'
+cf_time='Fri Jan 18 15:25:19 2002'
+charsize='1'
+chgrp=''
+chmod=''
+chown=''
+clocktype='clock_t'
+comm=''
+compress=''
+contains='grep'
+cp='copy'
+cpio=''
+cpp='cl -nologo -E'
+cpp_stuff='42'
+cppccsymbols=''
+cpplast=''
+cppminus=''
+cpprun='cl -nologo -E'
+cppstdin='cl -nologo -E'
+cppsymbols=''
+crosscompile='undef'
+cryptlib=''
+csh='undef'
+d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+d_PRIEUldbl='undef'
+d_PRIFUldbl='undef'
+d_PRIGUldbl='undef'
+d_PRIXU64='undef'
+d_PRId64='undef'
+d_PRIeldbl='undef'
+d_PRIfldbl='undef'
+d_PRIgldbl='undef'
+d_PRIi64='undef'
+d_PRIo64='undef'
+d_PRIu64='undef'
+d_PRIx64='undef'
+d_SCNfldbl='undef'
+d__fwalk='undef'
+d_access='define'
+d_accessx='undef'
+d_alarm='undef'
+d_archlib='define'
+d_atolf='undef'
+d_atoll='undef'
+d_attribut='undef'
+d_bcmp='undef'
+d_bcopy='undef'
+d_bincompat5005='undef'
+d_bsd='define'
+d_bsdgetpgrp='undef'
+d_bsdsetpgrp='undef'
+d_bzero='undef'
+d_casti32='undef'
+d_castneg='define'
+d_charvspr='undef'
+d_chown='undef'
+d_chroot='undef'
+d_chsize='define'
+d_closedir='define'
+d_const='define'
+d_crypt='undef'
+d_csh='undef'
+d_cuserid='undef'
+d_dbl_dig='define'
+d_difftime='define'
+d_dirnamlen='define'
+d_dlerror='define'
+d_dlopen='define'
+d_dlsymun='undef'
+d_dosuid='undef'
+d_drand48proto='undef'
+d_dup2='define'
+d_eaccess='undef'
+d_endgrent='undef'
+d_endhent='undef'
+d_endnent='undef'
+d_endpent='undef'
+d_endpwent='undef'
+d_endsent='undef'
+d_eofnblk='define'
+d_eunice='undef'
+d_fchmod='undef'
+d_fchown='undef'
+d_fcntl='undef'
+d_fcntl_can_lock='undef'
+d_fd_macros='define'
+d_fd_set='define'
+d_fds_bits='define'
+d_fgetpos='define'
+d_flexfnam='define'
+d_flock='define'
+d_fork='undef'
+d_fpathconf='undef'
+d_fpos64_t='undef'
+d_frexpl='undef'
+d_fs_data_s='undef'
+d_fseeko='undef'
+d_fsetpos='define'
+d_fstatfs='undef'
+d_fstatvfs='undef'
+d_fsync='undef'
+d_ftello='undef'
+d_ftime='define'
+d_getcwd='undef'
+d_getespwnam='undef'
+d_getfsstat='undef'
+d_getgrent='undef'
+d_getgrps='undef'
+d_gethbyaddr='define'
+d_gethbyname='define'
+d_gethent='undef'
+d_gethname='define'
+d_gethostprotos='define'
+d_getlogin='define'
+d_getmnt='undef'
+d_getmntent='undef'
+d_getnbyaddr='undef'
+d_getnbyname='undef'
+d_getnent='undef'
+d_getnetprotos='undef'
+d_getpagsz='undef'
+d_getpbyname='define'
+d_getpbynumber='define'
+d_getpent='undef'
+d_getpgid='undef'
+d_getpgrp2='undef'
+d_getpgrp='undef'
+d_getppid='undef'
+d_getprior='undef'
+d_getprotoprotos='define'
+d_getprpwnam='undef'
+d_getpwent='undef'
+d_getsbyname='define'
+d_getsbyport='define'
+d_getsent='undef'
+d_getservprotos='define'
+d_getspnam='undef'
+d_gettimeod='undef'
+d_gnulibc='undef'
+d_grpasswd='undef'
+d_hasmntopt='undef'
+d_htonl='define'
+d_iconv='undef'
+d_index='undef'
+d_inetaton='undef'
+d_int64_t='undef'
+d_isascii='define'
+d_isnan='define'
+d_isnanl='undef'
+d_killpg='undef'
+d_lchown='undef'
+d_ldbl_dig='define'
+d_link='define'
+d_locconv='define'
+d_lockf='undef'
+d_longdbl='define'
+d_longlong='undef'
+d_lseekproto='define'
+d_lstat='undef'
+d_madvise='undef'
+d_mblen='define'
+d_mbstowcs='define'
+d_mbtowc='define'
+d_memchr='define'
+d_memcmp='define'
+d_memcpy='define'
+d_memmove='define'
+d_memset='define'
+d_mkdir='define'
+d_mkdtemp='undef'
+d_mkfifo='undef'
+d_mkstemp='undef'
+d_mkstemps='undef'
+d_mktime='define'
+d_mmap='undef'
+d_modfl='undef'
+d_mprotect='undef'
+d_msg='undef'
+d_msg_ctrunc='undef'
+d_msg_dontroute='undef'
+d_msg_oob='undef'
+d_msg_peek='undef'
+d_msg_proxy='undef'
+d_msgctl='undef'
+d_msgget='undef'
+d_msgrcv='undef'
+d_msgsnd='undef'
+d_msync='undef'
+d_munmap='undef'
+d_mymalloc='undef'
+d_nice='undef'
+d_nv_preserves_uv='define'
+d_nv_preserves_uv_bits='32'
+d_off64_t='undef'
+d_old_pthread_create_joinable='undef'
+d_oldpthreads='undef'
+d_oldsock='undef'
+d_open3='undef'
+d_pathconf='undef'
+d_pause='define'
+d_perl_otherlibdirs='undef'
+d_phostname='undef'
+d_pipe='define'
+d_poll='undef'
+d_portable='define'
+d_pthread_yield='undef'
+d_pwage='undef'
+d_pwchange='undef'
+d_pwclass='undef'
+d_pwcomment='undef'
+d_pwexpire='undef'
+d_pwgecos='undef'
+d_pwpasswd='undef'
+d_pwquota='undef'
+d_qgcvt='undef'
+d_quad='undef'
+d_readdir='define'
+d_readlink='undef'
+d_rename='define'
+d_rewinddir='define'
+d_rmdir='define'
+d_safebcpy='undef'
+d_safemcpy='undef'
+d_sanemcmp='define'
+d_sbrkproto='undef'
+d_sched_yield='undef'
+d_scm_rights='undef'
+d_seekdir='define'
+d_select='define'
+d_sem='undef'
+d_semctl='undef'
+d_semctl_semid_ds='undef'
+d_semctl_semun='undef'
+d_semget='undef'
+d_semop='undef'
+d_setegid='undef'
+d_seteuid='undef'
+d_setgrent='undef'
+d_setgrps='undef'
+d_sethent='undef'
+d_setlinebuf='undef'
+d_setlocale='define'
+d_setnent='undef'
+d_setpent='undef'
+d_setpgid='undef'
+d_setpgrp2='undef'
+d_setpgrp='undef'
+d_setprior='undef'
+d_setproctitle='undef'
+d_setpwent='undef'
+d_setregid='undef'
+d_setresgid='undef'
+d_setresuid='undef'
+d_setreuid='undef'
+d_setrgid='undef'
+d_setruid='undef'
+d_setsent='undef'
+d_setsid='undef'
+d_setvbuf='define'
+d_sfio='undef'
+d_shm='undef'
+d_shmat='undef'
+d_shmatprototype='undef'
+d_shmctl='undef'
+d_shmdt='undef'
+d_shmget='undef'
+d_sigaction='undef'
+d_sigsetjmp='undef'
+d_socket='define'
+d_socklen_t='undef'
+d_sockpair='undef'
+d_socks5_init='undef'
+d_sqrtl='undef'
+d_statblks='undef'
+d_statfs_f_flags='undef'
+d_statfs_s='undef'
+d_statvfs='undef'
+d_stdio_cnt_lval='define'
+d_stdio_ptr_lval='define'
+d_stdio_ptr_lval_nochange_cnt='undef'
+d_stdio_ptr_lval_sets_cnt='undef'
+d_stdio_stream_array='undef'
+d_stdiobase='define'
+d_stdstdio='define'
+d_strchr='define'
+d_strcoll='define'
+d_strctcpy='define'
+d_strerrm='strerror(e)'
+d_strerror='define'
+d_strtod='define'
+d_strtol='define'
+d_strtold='undef'
+d_strtoll='undef'
+d_strtoul='define'
+d_strtoull='undef'
+d_strtouq='undef'
+d_strxfrm='define'
+d_suidsafe='undef'
+d_symlink='undef'
+d_syscall='undef'
+d_sysconf='undef'
+d_sysernlst=''
+d_syserrlst='define'
+d_system='define'
+d_tcgetpgrp='undef'
+d_tcsetpgrp='undef'
+d_telldir='define'
+d_telldirproto='define'
+d_time='define'
+d_times='define'
+d_truncate='undef'
+d_tzname='define'
+d_umask='define'
+d_uname='define'
+d_union_semun='define'
+d_ustat='undef'
+d_vendorarch='undef'
+d_vendorbin='undef'
+d_vendorlib='undef'
+d_vfork='undef'
+d_void_closedir='undef'
+d_voidsig='define'
+d_voidtty=''
+d_volatile='define'
+d_vprintf='define'
+d_wait4='undef'
+d_waitpid='define'
+d_wcstombs='define'
+d_wctomb='define'
+d_xenix='undef'
+date='date'
+db_hashtype='int'
+db_prefixtype='int'
+defvoidused='15'
+direntrytype='struct direct'
+dlext='dll'
+doublesize='8'
+drand01='(rand()/(double)((unsigned)1<<RANDBITS))'
+eagain='EAGAIN'
+ebcdic='undef'
+echo='echo'
+egrep='egrep'
+emacs=''
+eunicefix=':'
+exe_ext='.exe'
+expr='expr'
+fflushNULL='define'
+fflushall='undef'
+find='find'
+firstmakefile='makefile'
+flex=''
+fpossize='4'
+fpostype='fpos_t'
+freetype='void'
+full_ar=''
+full_csh=''
+full_sed=''
+gccosandvers=''
+gccversion=''
+gidformat='"ld"'
+gidsign='-1'
+gidsize='4'
+gidtype='gid_t'
+glibpth='/usr/shlib  /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib '
+grep='grep'
+groupcat=''
+groupstype='gid_t'
+gzip='gzip'
+h_fcntl='false'
+h_sysfile='true'
+hint='recommended'
+hostcat='ypcat hosts'
+i16size='2'
+i16type='short'
+i32size='4'
+i32type='long'
+i64size='8'
+i64type='__int64'
+i8size='1'
+i8type='char'
+i_arpainet='define'
+i_bsdioctl=''
+i_db='undef'
+i_dbm='undef'
+i_dirent='define'
+i_dld='undef'
+i_dlfcn='define'
+i_fcntl='define'
+i_float='define'
+i_gdbm='undef'
+i_grp='undef'
+i_iconv='undef'
+i_ieeefp='undef'
+i_inttypes='undef'
+i_libutil='undef'
+i_limits='define'
+i_locale='define'
+i_machcthr='undef'
+i_malloc='define'
+i_math='define'
+i_memory='undef'
+i_mntent='undef'
+i_ndbm='undef'
+i_netdb='undef'
+i_neterrno='undef'
+i_netinettcp='undef'
+i_niin='undef'
+i_poll='undef'
+i_prot='undef'
+i_pthread='undef'
+i_pwd='undef'
+i_rpcsvcdbm='define'
+i_sfio='undef'
+i_sgtty='undef'
+i_shadow='undef'
+i_socks='undef'
+i_stdarg='define'
+i_stddef='define'
+i_stdlib='define'
+i_string='define'
+i_sunmath='undef'
+i_sysaccess='undef'
+i_sysdir='undef'
+i_sysfile='undef'
+i_sysfilio='define'
+i_sysin='undef'
+i_sysioctl='undef'
+i_syslog='undef'
+i_sysmman='undef'
+i_sysmode='undef'
+i_sysmount='undef'
+i_sysndir='undef'
+i_sysparam='undef'
+i_sysresrc='undef'
+i_syssecrt='undef'
+i_sysselct='undef'
+i_syssockio=''
+i_sysstat='define'
+i_sysstatfs='undef'
+i_sysstatvfs='undef'
+i_systime='undef'
+i_systimek='undef'
+i_systimes='undef'
+i_systypes='define'
+i_sysuio='undef'
+i_sysun='undef'
+i_sysutsname='undef'
+i_sysvfs='undef'
+i_syswait='undef'
+i_termio='undef'
+i_termios='undef'
+i_time='define'
+i_unistd='undef'
+i_ustat='undef'
+i_utime='define'
+i_values='undef'
+i_varargs='undef'
+i_varhdr='varargs.h'
+i_vfork='undef'
+ignore_versioned_solibs=''
+inc_version_list=''
+inc_version_list_init='0'
+incpath='C:\PROGRA~1\MICROS~2\VC98\include'
+inews=''
+installbin='c:\sjboddie\gsdl\bin\windows\perl\bin'
+installhtmldir='c:\sjboddie\gsdl\bin\windows\perl\html'
+installhtmlhelpdir='c:\sjboddie\gsdl\bin\windows\perl\htmlhelp'
+installman1dir='c:\sjboddie\gsdl\bin\windows\perl\man\man1'
+installman3dir='c:\sjboddie\gsdl\bin\windows\perl\man\man3'
+installprefix='c:\sjboddie\gsdl\bin\windows\perl'
+installprefixexp='c:\sjboddie\gsdl\bin\windows\perl'
+installscript='c:\sjboddie\gsdl\bin\windows\perl\bin'
+installsitearch='c:\sjboddie\gsdl\bin\windows\perl\site\lib'
+installsitebin='c:\sjboddie\gsdl\bin\windows\perl\bin'
+installsitelib='c:\sjboddie\gsdl\bin\windows\perl\site\lib'
+installstyle='lib'
+installusrbinperl='undef'
+installvendorarch=''
+installvendorbin=''
+installvendorlib=''
+intsize='4'
+issymlink=''
+ivdformat='"ld"'
+ivsize='4'
+ivtype='long'
+known_extensions='DynaLoader Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re  Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob  Sys/Hostname Errno'
+ksh=''
+ld=''
+lddlflags='-dll -nologo -nodefaultlib -release  -libpath:"c:\sjboddie\gsdl\bin\windows\perl\lib\CORE"  -machine:x86'
+ldflags='-nologo -nodefaultlib -release  -libpath:"c:\sjboddie\gsdl\bin\windows\perl\lib\CORE"  -machine:x86'
+ldflags_uselargefiles=''
+ldlibpthname=''
+less='less'
+lib_ext='.lib'
+libc='msvcrt.lib'
+libperl='perl56.lib'
+libsdirs=''
+libsfiles=''
+libsfound=''
+libspath=''
+libswanted='net socket inet nsl nm ndbm gdbm dbm db malloc dl dld ld sun m c cposix posix ndir dir crypt ucb bsd BSD PW x'
+libswanted_uselargefiles=''
+line='line'
+lint=''
+lkflags=''
+ln=''
+lns='copy'
+locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include'
+loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib'
+longdblsize='10'
+longlongsize='8'
+longsize='4'
+lp=''
+lpr=''
+ls='dir'
+lseeksize='4'
+lseektype='off_t'
+mail=''
+mailx=''
+make='nmake'
+make_set_make='#'
+mallocobj='malloc.o'
+mallocsrc='malloc.c'
+malloctype='void *'
+man1dir='c:\sjboddie\gsdl\bin\windows\perl\man\man1'
+man1direxp='c:\sjboddie\gsdl\bin\windows\perl\man\man1'
+man1ext='1'
+man3dir='c:\sjboddie\gsdl\bin\windows\perl\man\man3'
+man3direxp='c:\sjboddie\gsdl\bin\windows\perl\man\man3'
+man3ext='3'
+mips_type=''
+mkdir='mkdir'
+mmaptype='void *'
+modetype='mode_t'
+more='more /e'
+multiarch='undef'
+mv=''
+myarchname='MSWin32'
+mydomain=''
+myhostname=''
+myuname=''
+n='-n'
+netdb_hlen_type='int'
+netdb_host_type='char *'
+netdb_name_type='char *'
+netdb_net_type='long'
+nm=''
+nm_opt=''
+nm_so_opt=''
+nonxs_ext='Errno'
+nroff=''
+nvEUformat='"E"'
+nvFUformat='"F"'
+nvGUformat='"G"'
+nveformat='"e"'
+nvfformat='"f"'
+nvgformat='"g"'
+nvsize='8'
+nvtype='double'
+o_nonblock='O_NONBLOCK'
+obj_ext='.obj'
+old_pthread_create_joinable=''
+optimize='-O1 -MD -DNDEBUG'
+orderlib='false'
+otherlibdirs=''
+package='perl5'
+pager='more /e'
+passcat=''
+patchlevel='6'
+path_sep=';'
+perl5=''
+perl='perl'
+perladmin=''
+perllibs='  oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib  comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib  netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib  version.lib odbc32.lib odbccp32.lib msvcrt.lib'
+perlpath='c:\sjboddie\gsdl\bin\windows\perl\bin\perl.exe'
+pg=''
+phostname='hostname'
+pidtype='int'
+plibpth=''
+pm_apiversion='5.005'
+pmake=''
+pr=''
+prefixexp='c:'
+privlib='c:\sjboddie\gsdl\bin\windows\perl\lib'
+prototype='define'
+ptrsize='4'
+quadkind='5'
+quadtype='__int64'
+randbits='15'
+randfunc='rand'
+randseedtype='unsigned'
+ranlib='rem'
+rd_nodata='-1'
+revision='5'
+rm='del'
+rmail=''
+runnm='true'
+sPRIEUldbl='"E"'
+sPRIFUldbl='"F"'
+sPRIGUldbl='"G"'
+sPRIXU64='"lX"'
+sPRId64='"ld"'
+sPRIeldbl='"e"'
+sPRIfldbl='"f"'
+sPRIgldbl='"g"'
+sPRIi64='"li"'
+sPRIo64='"lo"'
+sPRIu64='"lu"'
+sPRIx64='"lx"'
+sSCNfldbl='"f"'
+sched_yield=''
+scriptdir='c:\sjboddie\gsdl\bin\windows\perl\bin'
+scriptdirexp='c:\sjboddie\gsdl\bin\windows\perl\bin'
+sed='sed'
+seedfunc='srand'
+selectminbits='32'
+selecttype='Perl_fd_set *'
+sendmail='blat'
+sh='cmd /x /c'
+shar=''
+shmattype='void *'
+shortsize='2'
+shrpenv=''
+sig_count='26'
+sig_name_init='"ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0'
+sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 20, 0'
+signal_t='void'
+sitearch='c:\sjboddie\gsdl\bin\windows\perl\site\lib'
+sitearchexp='c:\sjboddie\gsdl\bin\windows\perl\site\lib'
+sitebin='c:\sjboddie\gsdl\bin\windows\perl\site\bin'
+sitebinexp='c:\sjboddie\gsdl\bin\windows\perl\site\bin'
+sitelib='c:\sjboddie\gsdl\bin\windows\perl\site\lib'
+sitelib_stem=''
+sitelibexp='c:\sjboddie\gsdl\bin\windows\perl\site\lib'
+siteprefix='c:\sjboddie\gsdl\bin\windows\perl\site'
+siteprefixexp='c:\sjboddie\gsdl\bin\windows\perl\site'
+sizesize='4'
+sizetype='size_t'
+sleep=''
+smail=''
+sockethdr=''
+socketlib=''
+socksizetype='int'
+sort='sort'
+spackage='Perl5'
+spitshell=''
+src=''
+ssizetype='int'
+startperl='#!perl'
+stdchar='char'
+stdio_base='((fp)->_base)'
+stdio_bufsiz='((fp)->_cnt + (fp)->_ptr - (fp)->_base)'
+stdio_cnt='((fp)->_cnt)'
+stdio_filbuf=''
+stdio_ptr='((fp)->_ptr)'
+stdio_stream_array=''
+strings='/usr/include/string.h'
+submit=''
+subversion='1'
+sysman='/usr/man/man1'
+tail=''
+tar=''
+tbl=''
+tee=''
+test=''
+timeincl='/usr/include/sys/time.h '
+timetype='time_t'
+touch='touch'
+tr=''
+trnl='\012'
+troff=''
+u16size='2'
+u16type='unsigned short'
+u32size='4'
+u32type='unsigned long'
+u64size='8'
+u64type='unsigned __int64'
+u8size='1'
+u8type='unsigned char'
+uidformat='"ld"'
+uidsign='-1'
+uidsize='4'
+uidtype='uid_t'
+uname='uname'
+uniq='uniq'
+uquadtype='unsigned __int64'
+use5005threads='undef'
+use64bitall='undef'
+use64bitint='undef'
+usedl='define'
+useithreads='define'
+uselargefiles='undef'
+uselongdouble='undef'
+usemorebits='undef'
+usemultiplicity='define'
+usemymalloc='n'
+usenm='false'
+useopcode='true'
+useperlio='undef'
+useposix='true'
+usesfio='false'
+useshrplib='yes'
+usesocks='undef'
+usethreads='undef'
+usevendorprefix='undef'
+usevfork='false'
+usrinc='/usr/include'
+uuname=''
+uvXUformat='"lX"'
+uvoformat='"lo"'
+uvsize='4'
+uvtype='unsigned long'
+uvuformat='"lu"'
+uvxformat='"lx"'
+vendorarch=''
+vendorarchexp=''
+vendorbin=''
+vendorbinexp=''
+vendorlib=''
+vendorlib_stem=''
+vendorlibexp=''
+vendorprefix=''
+vendorprefixexp=''
+version='5.6.1'
+versiononly='undef'
+vi=''
+voidflags='15'
+xlibpth='/usr/lib/386 /lib/386'
+xs_apiversion='5.6.0'
+zcat=''
+zip='zip'
+!END!
+
+my $summary = <<'!END!';
+Summary of my $package (revision $baserev version $PERL_VERSION subversion $PERL_SUBVERSION) configuration:
+  Platform:
+    osname=$osname, osvers=$osvers, archname=$archname
+    uname='$myuname'
+    config_args='$config_args'
+    hint=$hint, useposix=$useposix, d_sigaction=$d_sigaction
+    usethreads=$usethreads use5005threads=$use5005threads useithreads=$useithreads usemultiplicity=$usemultiplicity
+    useperlio=$useperlio d_sfio=$d_sfio uselargefiles=$uselargefiles usesocks=$usesocks
+    use64bitint=$use64bitint use64bitall=$use64bitall uselongdouble=$uselongdouble
+  Compiler:
+    cc='$cc', ccflags ='$ccflags',
+    optimize='$optimize',
+    cppflags='$cppflags'
+    ccversion='$ccversion', gccversion='$gccversion', gccosandvers='$gccosandvers'
+    intsize=$intsize, longsize=$longsize, ptrsize=$ptrsize, doublesize=$doublesize, byteorder=$byteorder
+    d_longlong=$d_longlong, longlongsize=$longlongsize, d_longdbl=$d_longdbl, longdblsize=$longdblsize
+    ivtype='$ivtype', ivsize=$ivsize, nvtype='$nvtype', nvsize=$nvsize, Off_t='$lseektype', lseeksize=$lseeksize
+    alignbytes=$alignbytes, usemymalloc=$usemymalloc, prototype=$prototype
+  Linker and Libraries:
+    ld='$ld', ldflags ='$ldflags'
+    libpth=$libpth
+    libs=$libs
+    perllibs=$perllibs
+    libc=$libc, so=$so, useshrplib=$useshrplib, libperl=$libperl
+  Dynamic Linking:
+    dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags'
+    cccdlflags='$cccdlflags', lddlflags='$lddlflags'
+
+!END!
+my $summary_expanded = 0;
+
+sub myconfig {
+	return $summary if $summary_expanded;
+	$summary =~ s{\$(\w+)}
+		     { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
+	$summary_expanded = 1;
+	$summary;
+}
+
+sub FETCH { 
+    # check for cached value (which may be undef so we use exists not defined)
+    return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
+
+    # Search for it in the big string 
+    my($value, $start, $marker, $quote_type);
+
+    $quote_type = "'";
+    # Virtual entries.
+    if ($_[1] eq 'byteorder') {
+	# byteorder does exist on its own but we overlay a virtual
+	# dynamically recomputed value. 
+        my $t = $Config{ivtype};
+        my $s = $Config{ivsize};
+        my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
+        if ($s == 4 || $s == 8) {
+	    my $i = 0;
+    	    foreach my $c (reverse(2..$s)) { $i |= ord($c); $i <<= 8 }
+	    $i |= ord(1);
+            $value = join('', unpack('a'x$s, pack($f, $i)));
+        } else {
+            $value = '?'x$s;
+        }
+    } elsif ($_[1] =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
+	# These are purely virtual, they do not exist, but need to
+	# be computed on demand for largefile-incapable extensions.
+	my $key = "${1}_uselargefiles";
+	$value = $Config{$1};
+	my $withlargefiles = $Config{$key};
+	if ($key =~ /^(?:cc|ld)flags_/) {
+	    $value =~ s/\Q$withlargefiles\E\b//;
+	} elsif ($key =~ /^libs/) {
+	    my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
+	    if (@lflibswanted) {
+		my %lflibswanted;
+		@lflibswanted{@lflibswanted} = ();
+		if ($key =~ /^libs_/) {
+		    my @libs = grep { /^-l(.+)/ &&
+                                      not exists $lflibswanted{$1} }
+		                    split(' ', $Config{libs});
+		    $Config{libs} = join(' ', @libs);
+		} elsif ($key =~ /^libswanted_/) {
+		    my @libswanted = grep { not exists $lflibswanted{$_} }
+		                          split(' ', $Config{libswanted});
+		    $Config{libswanted} = join(' ', @libswanted);
+		}
+	    }
+	}
+    } else {
+	$marker = "$_[1]=";
+	# return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
+	# Check for the common case, ' delimeted
+	$start = index($config_sh, "\n$marker$quote_type");
+	# If that failed, check for " delimited
+	if ($start == -1) {
+	    $quote_type = '"';
+	    $start = index($config_sh, "\n$marker$quote_type");
+	}
+	return undef if ( ($start == -1) &&  # in case it's first 
+			  (substr($config_sh, 0, length($marker)) ne $marker) );
+	if ($start == -1) { 
+	    # It's the very first thing we found. Skip $start forward
+	    # and figure out the quote mark after the =.
+	    $start = length($marker) + 1;
+	    $quote_type = substr($config_sh, $start - 1, 1);
+	} 
+	else { 
+	    $start += length($marker) + 2;
+	}
+	$value = substr($config_sh, $start, 
+			index($config_sh, "$quote_type\n", $start) - $start);
+    }
+    # If we had a double-quote, we'd better eval it so escape
+    # sequences and such can be interpolated. Since the incoming
+    # value is supposed to follow shell rules and not perl rules,
+    # we escape any perl variable markers
+    if ($quote_type eq '"') {
+	$value =~ s/\$/\\\$/g;
+	$value =~ s/\@/\\\@/g;
+	eval "\$value = \"$value\"";
+    }
+    #$value = sprintf($value) if $quote_type eq '"';
+    # So we can say "if $Config{'foo'}".
+    $value = undef if $value eq 'undef';
+    $_[0]->{$_[1]} = $value; # cache it
+    return $value;
+}
+ 
+my $prevpos = 0;
+
+sub FIRSTKEY {
+    $prevpos = 0;
+    # my($key) = $config_sh =~ m/^(.*?)=/;
+    substr($config_sh, 0, index($config_sh, '=') );
+    # $key;
+}
+
+sub NEXTKEY {
+    # Find out how the current key's quoted so we can skip to its end.
+    my $quote = substr($config_sh, index($config_sh, "=", $prevpos)+1, 1);
+    my $pos = index($config_sh, qq($quote\n), $prevpos) + 2;
+    my $len = index($config_sh, "=", $pos) - $pos;
+    $prevpos = $pos;
+    $len > 0 ? substr($config_sh, $pos, $len) : undef;
+}
+
+sub EXISTS { 
+    # exists($_[0]->{$_[1]})  or  $config_sh =~ m/^$_[1]=/m;
+    exists($_[0]->{$_[1]}) or
+    index($config_sh, "\n$_[1]='") != -1 or
+    substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or
+    index($config_sh, "\n$_[1]=\"") != -1 or
+    substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"" or
+    $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/;
+}
+
+sub STORE  { die "\%Config::Config is read-only\n" }
+sub DELETE { &STORE }
+sub CLEAR  { &STORE }
+
+
+sub config_sh {
+    $config_sh
+}
+
+sub config_re {
+    my $re = shift;
+    my @matches = ($config_sh =~ /^$re=.*\n/mg);
+    @matches ? (print @matches) : print "$re: not found\n";
+}
+
+sub config_vars {
+    foreach(@_){
+	config_re($_), next if /\W/;
+	my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
+	$v='undef' unless defined $v;
+	print "$_='$v';\n";
+    }
+}
+
+sub TIEHASH { bless {} }
+
+# avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
+sub DESTROY { }
+
+tie %Config, 'Config';
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Cwd.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Cwd.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Cwd.pm	(revision 14265)
@@ -0,0 +1,456 @@
+package Cwd;
+require 5.000;
+
+=head1 NAME
+
+Cwd - get pathname of current working directory
+
+=head1 SYNOPSIS
+
+    use Cwd;
+    $dir = cwd;
+
+    use Cwd;
+    $dir = getcwd;
+
+    use Cwd;
+    $dir = fastcwd;
+
+    use Cwd;
+    $dir = fastgetcwd;
+
+    use Cwd 'chdir';
+    chdir "/tmp";
+    print $ENV{'PWD'};
+
+    use Cwd 'abs_path';	    # aka realpath()
+    print abs_path($ENV{'PWD'});
+
+    use Cwd 'fast_abs_path';
+    print fast_abs_path($ENV{'PWD'});
+
+=head1 DESCRIPTION
+
+This module provides functions for determining the pathname of the
+current working directory.  By default, it exports the functions
+cwd(), getcwd(), fastcwd(), and fastgetcwd() into the caller's
+namespace.  Each of these functions are called without arguments and
+return the absolute path of the current working directory.  It is
+recommended that cwd (or another *cwd() function) be used in I<all>
+code to ensure portability.
+
+The cwd() is the most natural and safe form for the current
+architecture. For most systems it is identical to `pwd` (but without
+the trailing line terminator).
+
+The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
+in Perl.
+
+The fastcwd() function looks the same as getcwd(), but runs faster.
+It's also more dangerous because it might conceivably chdir() you out
+of a directory that it can't chdir() you back into.  If fastcwd
+encounters a problem it will return undef but will probably leave you
+in a different directory.  For a measure of extra security, if
+everything appears to have worked, the fastcwd() function will check
+that it leaves you in the same directory that it started in. If it has
+changed it will C<die> with the message "Unstable directory path,
+current directory changed unexpectedly". That should never happen.
+
+The fastgetcwd() function is provided as a synonym for cwd().
+
+The abs_path() function takes a single argument and returns the
+absolute pathname for that argument.  It uses the same algorithm as
+getcwd().  (Actually, getcwd() is abs_path("."))  Symbolic links and
+relative-path components ("." and "..") are resolved to return the
+canonical pathname, just like realpath(3).  This function is also
+callable as realpath().
+
+The fast_abs_path() function looks the same as abs_path() but runs
+faster and, like fastcwd(), is more dangerous.
+
+If you ask to override your chdir() built-in function, then your PWD
+environment variable will be kept up to date.  (See
+L<perlsub/Overriding Builtin Functions>.) Note that it will only be
+kept up to date if all packages which use chdir import it from Cwd.
+
+=cut
+
+use strict;
+
+use Carp;
+
+our $VERSION = '2.04';
+
+use base qw/ Exporter /;
+our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
+our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
+
+
+# The 'natural and safe form' for UNIX (pwd may be setuid root)
+
+sub _backtick_pwd {
+    my $cwd = `pwd`;
+    # `pwd` may fail e.g. if the disk is full
+    chomp($cwd) if defined $cwd;
+    $cwd;
+}
+
+# Since some ports may predefine cwd internally (e.g., NT)
+# we take care not to override an existing definition for cwd().
+
+unless(defined &cwd) {
+    # The pwd command is not available in some chroot(2)'ed environments
+    if($^O eq 'MacOS' || grep { -x "$_/pwd" } split(':', $ENV{PATH})) {
+	*cwd = \&_backtick_pwd;
+    }
+    else {
+	*cwd = \&getcwd;
+    }
+}
+
+# set a reasonable (and very safe) default for fastgetcwd, in case it
+# isn't redefined later (20001212 rspier)
+*fastgetcwd = \&cwd;
+
+# By Brandon S. Allbery
+#
+# Usage: $cwd = getcwd();
+
+sub getcwd
+{
+    abs_path('.');
+}
+
+# By John Bazik
+#
+# Usage: $cwd = &fastcwd;
+#
+# This is a faster version of getcwd.  It's also more dangerous because
+# you might chdir out of a directory that you can't chdir back into.
+    
+sub fastcwd {
+    my($odev, $oino, $cdev, $cino, $tdev, $tino);
+    my(@path, $path);
+    local(*DIR);
+
+    my($orig_cdev, $orig_cino) = stat('.');
+    ($cdev, $cino) = ($orig_cdev, $orig_cino);
+    for (;;) {
+	my $direntry;
+	($odev, $oino) = ($cdev, $cino);
+	CORE::chdir('..') || return undef;
+	($cdev, $cino) = stat('.');
+	last if $odev == $cdev && $oino == $cino;
+	opendir(DIR, '.') || return undef;
+	for (;;) {
+	    $direntry = readdir(DIR);
+	    last unless defined $direntry;
+	    next if $direntry eq '.';
+	    next if $direntry eq '..';
+
+	    ($tdev, $tino) = lstat($direntry);
+	    last unless $tdev != $odev || $tino != $oino;
+	}
+	closedir(DIR);
+	return undef unless defined $direntry; # should never happen
+	unshift(@path, $direntry);
+    }
+    $path = '/' . join('/', @path);
+    if ($^O eq 'apollo') { $path = "/".$path; }
+    # At this point $path may be tainted (if tainting) and chdir would fail.
+    # To be more useful we untaint it then check that we landed where we started.
+    $path = $1 if $path =~ /^(.*)\z/s;	# untaint
+    CORE::chdir($path) || return undef;
+    ($cdev, $cino) = stat('.');
+    die "Unstable directory path, current directory changed unexpectedly"
+	if $cdev != $orig_cdev || $cino != $orig_cino;
+    $path;
+}
+
+
+# Keeps track of current working directory in PWD environment var
+# Usage:
+#	use Cwd 'chdir';
+#	chdir $newdir;
+
+my $chdir_init = 0;
+
+sub chdir_init {
+    if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
+	my($dd,$di) = stat('.');
+	my($pd,$pi) = stat($ENV{'PWD'});
+	if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
+	    $ENV{'PWD'} = cwd();
+	}
+    }
+    else {
+	my $wd = cwd();
+	$wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
+	$ENV{'PWD'} = $wd;
+    }
+    # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
+    if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
+	my($pd,$pi) = stat($2);
+	my($dd,$di) = stat($1);
+	if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
+	    $ENV{'PWD'}="$2$3";
+	}
+    }
+    $chdir_init = 1;
+}
+
+sub chdir {
+    my $newdir = @_ ? shift : '';	# allow for no arg (chdir to HOME dir)
+    $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
+    chdir_init() unless $chdir_init;
+    my $newpwd;
+    if ($^O eq 'MSWin32') {
+	# get the full path name *before* the chdir()
+	$newpwd = Win32::GetFullPathName($newdir);
+    }
+
+    return 0 unless CORE::chdir $newdir;
+
+    if ($^O eq 'VMS') {
+	return $ENV{'PWD'} = $ENV{'DEFAULT'}
+    }
+    elsif ($^O eq 'MacOS') {
+	return $ENV{'PWD'} = cwd();
+    }
+    elsif ($^O eq 'MSWin32') {
+	$ENV{'PWD'} = $newpwd;
+	return 1;
+    }
+
+    if ($newdir =~ m#^/#s) {
+	$ENV{'PWD'} = $newdir;
+    } else {
+	my @curdir = split(m#/#,$ENV{'PWD'});
+	@curdir = ('') unless @curdir;
+	my $component;
+	foreach $component (split(m#/#, $newdir)) {
+	    next if $component eq '.';
+	    pop(@curdir),next if $component eq '..';
+	    push(@curdir,$component);
+	}
+	$ENV{'PWD'} = join('/',@curdir) || '/';
+    }
+    1;
+}
+
+# Taken from Cwd.pm It is really getcwd with an optional
+# parameter instead of '.'
+#
+
+sub abs_path
+{
+    my $start = @_ ? shift : '.';
+    my($dotdots, $cwd, @pst, @cst, $dir, @tst);
+
+    unless (@cst = stat( $start ))
+    {
+	carp "stat($start): $!";
+	return '';
+    }
+    $cwd = '';
+    $dotdots = $start;
+    do
+    {
+	$dotdots .= '/..';
+	@pst = @cst;
+	unless (opendir(PARENT, $dotdots))
+	{
+	    carp "opendir($dotdots): $!";
+	    return '';
+	}
+	unless (@cst = stat($dotdots))
+	{
+	    carp "stat($dotdots): $!";
+	    closedir(PARENT);
+	    return '';
+	}
+	if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
+	{
+	    $dir = undef;
+	}
+	else
+	{
+	    do
+	    {
+		unless (defined ($dir = readdir(PARENT)))
+	        {
+		    carp "readdir($dotdots): $!";
+		    closedir(PARENT);
+		    return '';
+		}
+		$tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
+	    }
+	    while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
+		   $tst[1] != $pst[1]);
+	}
+	$cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
+	closedir(PARENT);
+    } while (defined $dir);
+    chop($cwd) unless $cwd eq '/'; # drop the trailing /
+    $cwd;
+}
+
+# added function alias for those of us more
+# used to the libc function.  --tchrist 27-Jan-00
+*realpath = \&abs_path;
+
+sub fast_abs_path {
+    my $cwd = getcwd();
+    my $path = @_ ? shift : '.';
+    CORE::chdir($path) || croak "Cannot chdir to $path:$!";
+    my $realpath = getcwd();
+    CORE::chdir($cwd)  || croak "Cannot chdir back to $cwd:$!";
+    $realpath;
+}
+
+# added function alias to follow principle of least surprise
+# based on previous aliasing.  --tchrist 27-Jan-00
+*fast_realpath = \&fast_abs_path;
+
+
+# --- PORTING SECTION ---
+
+# VMS: $ENV{'DEFAULT'} points to default directory at all times
+# 06-Mar-1996  Charles Bailey  bailey@newman.upenn.edu
+# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
+#   in the process logical name table as the default device and directory
+#   seen by Perl. This may not be the same as the default device
+#   and directory seen by DCL after Perl exits, since the effects
+#   the CRTL chdir() function persist only until Perl exits.
+
+sub _vms_cwd {
+    return $ENV{'DEFAULT'};
+}
+
+sub _vms_abs_path {
+    return $ENV{'DEFAULT'} unless @_;
+    my $path = VMS::Filespec::pathify($_[0]);
+    croak("Invalid path name $_[0]") unless defined $path;
+    return VMS::Filespec::rmsexpand($path);
+}
+
+sub _os2_cwd {
+    $ENV{'PWD'} = `cmd /c cd`;
+    chop $ENV{'PWD'};
+    $ENV{'PWD'} =~ s:\\:/:g ;
+    return $ENV{'PWD'};
+}
+
+sub _win32_cwd {
+    $ENV{'PWD'} = Win32::GetCwd();
+    $ENV{'PWD'} =~ s:\\:/:g ;
+    return $ENV{'PWD'};
+}
+
+*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd && 
+                            defined &Win32::GetCwd);
+
+*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
+
+sub _dos_cwd {
+    if (!defined &Dos::GetCwd) {
+        $ENV{'PWD'} = `command /c cd`;
+        chop $ENV{'PWD'};
+        $ENV{'PWD'} =~ s:\\:/:g ;
+    } else {
+        $ENV{'PWD'} = Dos::GetCwd();
+    }
+    return $ENV{'PWD'};
+}
+
+sub _qnx_cwd {
+    $ENV{'PWD'} = `/usr/bin/fullpath -t`;
+    chop $ENV{'PWD'};
+    return $ENV{'PWD'};
+}
+
+sub _qnx_abs_path {
+    my $path = @_ ? shift : '.';
+    my $realpath=`/usr/bin/fullpath -t $path`;
+    chop $realpath;
+    return $realpath;
+}
+
+sub _epoc_cwd {
+    $ENV{'PWD'} = EPOC::getcwd();
+    return $ENV{'PWD'};
+}
+
+{
+    no warnings;	# assignments trigger 'subroutine redefined' warning
+
+    if ($^O eq 'VMS') {
+        *cwd		= \&_vms_cwd;
+        *getcwd		= \&_vms_cwd;
+        *fastcwd	= \&_vms_cwd;
+        *fastgetcwd	= \&_vms_cwd;
+        *abs_path	= \&_vms_abs_path;
+        *fast_abs_path	= \&_vms_abs_path;
+    }
+    elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
+        # We assume that &_NT_cwd is defined as an XSUB or in the core.
+        *cwd		= \&_NT_cwd;
+        *getcwd		= \&_NT_cwd;
+        *fastcwd	= \&_NT_cwd;
+        *fastgetcwd	= \&_NT_cwd;
+        *abs_path	= \&fast_abs_path;
+    }
+    elsif ($^O eq 'os2') {
+        # sys_cwd may keep the builtin command
+        *cwd		= defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
+        *getcwd		= \&cwd;
+        *fastgetcwd	= \&cwd;
+        *fastcwd	= \&cwd;
+        *abs_path	= \&fast_abs_path;
+    }
+    elsif ($^O eq 'dos') {
+        *cwd		= \&_dos_cwd;
+        *getcwd		= \&_dos_cwd;
+        *fastgetcwd	= \&_dos_cwd;
+        *fastcwd	= \&_dos_cwd;
+        *abs_path	= \&fast_abs_path;
+    }
+    elsif ($^O eq 'qnx') {
+        *cwd		= \&_qnx_cwd;
+        *getcwd		= \&_qnx_cwd;
+        *fastgetcwd	= \&_qnx_cwd;
+        *fastcwd	= \&_qnx_cwd;
+        *abs_path	= \&_qnx_abs_path;
+        *fast_abs_path	= \&_qnx_abs_path;
+    }
+    elsif ($^O eq 'cygwin') {
+        *getcwd	= \&cwd;
+        *fastgetcwd	= \&cwd;
+        *fastcwd	= \&cwd;
+        *abs_path	= \&fast_abs_path;
+    }
+    elsif ($^O eq 'epoc') {
+        *cwd            = \&_epoc_cwd;
+        *getcwd	        = \&_epoc_cwd;
+        *fastgetcwd	= \&_epoc_cwd;
+        *fastcwd	= \&_epoc_cwd;
+        *abs_path	= \&fast_abs_path;
+    }
+    elsif ($^O eq 'MacOS') {
+    	*getcwd     = \&cwd;
+    	*fastgetcwd = \&cwd;
+    	*fastcwd    = \&cwd;
+    	*abs_path   = \&fast_abs_path;
+    }
+}
+
+# package main; eval join('',<DATA>) || die $@;	# quick test
+
+1;
+
+__END__
+BEGIN { import Cwd qw(:DEFAULT chdir); }
+print join("\n", cwd, getcwd, fastcwd, "");
+chdir('..');
+print join("\n", cwd, getcwd, fastcwd, "");
+print "$ENV{PWD}\n";
Index: /for-distributions/trunk/bin/windows/perl/lib/DB.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/DB.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/DB.pm	(revision 14265)
@@ -0,0 +1,802 @@
+#
+# Documentation is at the __END__
+#
+
+package DB;
+
+# "private" globals
+
+my ($running, $ready, $deep, $usrctxt, $evalarg, 
+    @stack, @saved, @skippkg, @clients);
+my $preeval = {};
+my $posteval = {};
+my $ineval = {};
+
+####
+#
+# Globals - must be defined at startup so that clients can refer to 
+# them right after a C<require DB;>
+#
+####
+
+BEGIN {
+
+  # these are hardcoded in perl source (some are magical)
+
+  $DB::sub = '';        # name of current subroutine
+  %DB::sub = ();        # "filename:fromline-toline" for every known sub
+  $DB::single = 0;      # single-step flag (set it to 1 to enable stops in BEGIN/use)
+  $DB::signal = 0;      # signal flag (will cause a stop at the next line)
+  $DB::trace = 0;       # are we tracing through subroutine calls?
+  @DB::args = ();       # arguments of current subroutine or @ARGV array
+  @DB::dbline = ();     # list of lines in currently loaded file
+  %DB::dbline = ();     # actions in current file (keyed by line number)
+  @DB::ret = ();        # return value of last sub executed in list context
+  $DB::ret = '';        # return value of last sub executed in scalar context
+
+  # other "public" globals  
+
+  $DB::package = '';    # current package space
+  $DB::filename = '';   # current filename
+  $DB::subname = '';    # currently executing sub (fullly qualified name)
+  $DB::lineno = '';     # current line number
+
+  $DB::VERSION = $DB::VERSION = '1.0';
+
+  # initialize private globals to avoid warnings
+
+  $running = 1;         # are we running, or are we stopped?
+  @stack = (0);
+  @clients = ();
+  $deep = 100;
+  $ready = 0;
+  @saved = ();
+  @skippkg = ();
+  $usrctxt = '';
+  $evalarg = '';
+}
+
+####
+# entry point for all subroutine calls
+#
+sub sub {
+  push(@stack, $DB::single);
+  $DB::single &= 1;
+  $DB::single |= 4 if $#stack == $deep;
+#  print $DB::sub, "\n";
+  if ($DB::sub =~ /(?:^|::)DESTROY$/ or not defined wantarray) {
+    &$DB::sub;
+    $DB::single |= pop(@stack);
+    $DB::ret = undef;
+  }
+  elsif (wantarray) {
+    @DB::ret = &$DB::sub;
+    $DB::single |= pop(@stack);
+    @DB::ret;
+  }
+  else {
+    $DB::ret = &$DB::sub;
+    $DB::single |= pop(@stack);
+    $DB::ret;
+  }
+}
+
+####
+# this is called by perl for every statement
+#
+sub DB {
+  return unless $ready;
+  &save;
+  ($DB::package, $DB::filename, $DB::lineno) = caller;
+
+  return if @skippkg and grep { $_ eq $DB::package } @skippkg;
+
+  $usrctxt = "package $DB::package;";		# this won't let them modify, alas
+  local(*DB::dbline) = "::_<$DB::filename";
+  my ($stop, $action);
+  if (($stop,$action) = split(/\0/,$DB::dbline{$DB::lineno})) {
+    if ($stop eq '1') {
+      $DB::signal |= 1;
+    }
+    else {
+      $stop = 0 unless $stop;			# avoid un_init warning
+      $evalarg = "\$DB::signal |= do { $stop; }"; &eval;
+      $DB::dbline{$DB::lineno} =~ s/;9($|\0)/$1/;    # clear any temp breakpt
+    }
+  }
+  if ($DB::single || $DB::trace || $DB::signal) {
+    $DB::subname = ($DB::sub =~ /\'|::/) ? $DB::sub : "${DB::package}::$DB::sub"; #';
+    DB->loadfile($DB::filename, $DB::lineno);
+  }
+  $evalarg = $action, &eval if $action;
+  if ($DB::single || $DB::signal) {
+    _outputall($#stack . " levels deep in subroutine calls.\n") if $DB::single & 4;
+    $DB::single = 0;
+    $DB::signal = 0;
+    $running = 0;
+    
+    &eval if ($evalarg = DB->prestop);
+    my $c;
+    for $c (@clients) {
+      # perform any client-specific prestop actions
+      &eval if ($evalarg = $c->cprestop);
+      
+      # Now sit in an event loop until something sets $running
+      do {
+	$c->idle;                     # call client event loop; must not block
+	if ($running == 2) {          # client wants something eval-ed
+	  &eval if ($evalarg = $c->evalcode);
+	  $running = 0;
+	}
+      } until $running;
+      
+      # perform any client-specific poststop actions
+      &eval if ($evalarg = $c->cpoststop);
+    }
+    &eval if ($evalarg = DB->poststop);
+  }
+  ($@, $!, $,, $/, $\, $^W) = @saved;
+  ();
+}
+  
+####
+# this takes its argument via $evalarg to preserve current @_
+#    
+sub eval {
+  ($@, $!, $,, $/, $\, $^W) = @saved;
+  eval "$usrctxt $evalarg; &DB::save";
+  _outputall($@) if $@;
+}
+
+###############################################################################
+#         no compile-time subroutine call allowed before this point           #
+###############################################################################
+
+use strict;                # this can run only after DB() and sub() are defined
+
+sub save {
+  @saved = ($@, $!, $,, $/, $\, $^W);
+  $, = ""; $/ = "\n"; $\ = ""; $^W = 0;
+}
+
+sub catch {
+  for (@clients) { $_->awaken; }
+  $DB::signal = 1;
+  $ready = 1;
+}
+
+####
+#
+# Client callable (read inheritable) methods defined after this point
+#
+####
+
+sub register {
+  my $s = shift;
+  $s = _clientname($s) if ref($s);
+  push @clients, $s;
+}
+
+sub done {
+  my $s = shift;
+  $s = _clientname($s) if ref($s);
+  @clients = grep {$_ ne $s} @clients;
+  $s->cleanup;
+#  $running = 3 unless @clients;
+  exit(0) unless @clients;
+}
+
+sub _clientname {
+  my $name = shift;
+  "$name" =~ /^(.+)=[A-Z]+\(.+\)$/;
+  return $1;
+}
+
+sub next {
+  my $s = shift;
+  $DB::single = 2;
+  $running = 1;
+}
+
+sub step {
+  my $s = shift;
+  $DB::single = 1;
+  $running = 1;
+}
+
+sub cont {
+  my $s = shift;
+  my $i = shift;
+  $s->set_tbreak($i) if $i;
+  for ($i = 0; $i <= $#stack;) {
+	$stack[$i++] &= ~1;
+  }
+  $DB::single = 0;
+  $running = 1;
+}
+
+####
+# XXX caller must experimentally determine $i (since it depends
+# on how many client call frames are between this call and the DB call).
+# Such is life.
+#
+sub ret {
+  my $s = shift;
+  my $i = shift;      # how many levels to get to DB sub
+  $i = 0 unless defined $i;
+  $stack[$#stack-$i] |= 1;
+  $DB::single = 0;
+  $running = 1;
+}
+
+####
+# XXX caller must experimentally determine $start (since it depends
+# on how many client call frames are between this call and the DB call).
+# Such is life.
+#
+sub backtrace {
+  my $self = shift;
+  my $start = shift;
+  my($p,$f,$l,$s,$h,$w,$e,$r,$a, @a, @ret,$i);
+  $start = 1 unless $start;
+  for ($i = $start; ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); $i++) {
+    @a = @DB::args;
+    for (@a) {
+      s/'/\\'/g;
+      s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
+      s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+      s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+    }
+    $w = $w ? '@ = ' : '$ = ';
+    $a = $h ? '(' . join(', ', @a) . ')' : '';
+    $e =~ s/\n\s*\;\s*\Z// if $e;
+    $e =~ s/[\\\']/\\$1/g if $e;
+    if ($r) {
+      $s = "require '$e'";
+    } elsif (defined $r) {
+      $s = "eval '$e'";
+    } elsif ($s eq '(eval)') {
+      $s = "eval {...}";
+    }
+    $f = "file `$f'" unless $f eq '-e';
+    push @ret, "$w&$s$a from $f line $l";
+    last if $DB::signal;
+  }
+  return @ret;
+}
+
+sub _outputall {
+  my $c;
+  for $c (@clients) {
+    $c->output(@_);
+  }
+}
+
+sub trace_toggle {
+  my $s = shift;
+  $DB::trace = !$DB::trace;
+}
+
+
+####
+# without args: returns all defined subroutine names
+# with subname args: returns a listref [file, start, end]
+#
+sub subs {
+  my $s = shift;
+  if (@_) {
+    my(@ret) = ();
+    while (@_) {
+      my $name = shift;
+      push @ret, [$DB::sub{$name} =~ /^(.*)\:(\d+)-(\d+)$/] 
+	if exists $DB::sub{$name};
+    }
+    return @ret;
+  }
+  return keys %DB::sub;
+}
+
+####
+# first argument is a filename whose subs will be returned
+# if a filename is not supplied, all subs in the current
+# filename are returned.
+#
+sub filesubs {
+  my $s = shift;
+  my $fname = shift;
+  $fname = $DB::filename unless $fname;
+  return grep { $DB::sub{$_} =~ /^$fname/ } keys %DB::sub;
+}
+
+####
+# returns a list of all filenames that DB knows about
+#
+sub files {
+  my $s = shift;
+  my(@f) = grep(m|^_<|, keys %main::);
+  return map { substr($_,2) } @f;
+}
+
+####
+# returns reference to an array holding the lines in currently
+# loaded file
+#
+sub lines {
+  my $s = shift;
+  return \@DB::dbline;
+}
+
+####
+# loadfile($file, $line)
+#
+sub loadfile {
+  my $s = shift;
+  my($file, $line) = @_;
+  if (!defined $main::{'_<' . $file}) {
+    my $try;
+    if (($try) = grep(m|^_<.*$file|, keys %main::)) {  
+      $file = substr($try,2);
+    }
+  }
+  if (defined($main::{'_<' . $file})) {
+    my $c;
+#    _outputall("Loading file $file..");
+    *DB::dbline = "::_<$file";
+    $DB::filename = $file;
+    for $c (@clients) {
+#      print "2 ", $file, '|', $line, "\n";
+      $c->showfile($file, $line);
+    }
+    return $file;
+  }
+  return undef;
+}
+
+sub lineevents {
+  my $s = shift;
+  my $fname = shift;
+  my(%ret) = ();
+  my $i;
+  $fname = $DB::filename unless $fname;
+  local(*DB::dbline) = "::_<$fname";
+  for ($i = 1; $i <= $#DB::dbline; $i++) {
+    $ret{$i} = [$DB::dbline[$i], split(/\0/, $DB::dbline{$i})] 
+      if defined $DB::dbline{$i};
+  }
+  return %ret;
+}
+
+sub set_break {
+  my $s = shift;
+  my $i = shift;
+  my $cond = shift;
+  $i ||= $DB::lineno;
+  $cond ||= '1';
+  $i = _find_subline($i) if ($i =~ /\D/);
+  $s->output("Subroutine not found.\n") unless $i;
+  if ($i) {
+    if ($DB::dbline[$i] == 0) {
+      $s->output("Line $i not breakable.\n");
+    }
+    else {
+      $DB::dbline{$i} =~ s/^[^\0]*/$cond/;
+    }
+  }
+}
+
+sub set_tbreak {
+  my $s = shift;
+  my $i = shift;
+  $i = _find_subline($i) if ($i =~ /\D/);
+  $s->output("Subroutine not found.\n") unless $i;
+  if ($i) {
+    if ($DB::dbline[$i] == 0) {
+      $s->output("Line $i not breakable.\n");
+    }
+    else {
+      $DB::dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
+    }
+  }
+}
+
+sub _find_subline {
+  my $name = shift;
+  $name =~ s/\'/::/;
+  $name = "${DB::package}\:\:" . $name if $name !~ /::/;
+  $name = "main" . $name if substr($name,0,2) eq "::";
+  my($fname, $from, $to) = ($DB::sub{$name} =~ /^(.*):(\d+)-(\d+)$/);
+  if ($from) {
+    # XXX this needs local()-ization of some sort
+    *DB::dbline = "::_<$fname";
+    ++$from while $DB::dbline[$from] == 0 && $from < $to;
+    return $from;
+  }
+  return undef;
+}
+
+sub clr_breaks {
+  my $s = shift;
+  my $i;
+  if (@_) {
+    while (@_) {
+      $i = shift;
+      $i = _find_subline($i) if ($i =~ /\D/);
+      $s->output("Subroutine not found.\n") unless $i;
+      if (defined $DB::dbline{$i}) {
+        $DB::dbline{$i} =~ s/^[^\0]+//;
+        if ($DB::dbline{$i} =~ s/^\0?$//) {
+          delete $DB::dbline{$i};
+        }
+      }
+    }
+  }
+  else {
+    for ($i = 1; $i <= $#DB::dbline ; $i++) {
+      if (defined $DB::dbline{$i}) {
+        $DB::dbline{$i} =~ s/^[^\0]+//;
+        if ($DB::dbline{$i} =~ s/^\0?$//) {
+          delete $DB::dbline{$i};
+        }
+      }
+    }
+  }
+}
+
+sub set_action {
+  my $s = shift;
+  my $i = shift;
+  my $act = shift;
+  $i = _find_subline($i) if ($i =~ /\D/);
+  $s->output("Subroutine not found.\n") unless $i;
+  if ($i) {
+    if ($DB::dbline[$i] == 0) {
+      $s->output("Line $i not actionable.\n");
+    }
+    else {
+      $DB::dbline{$i} =~ s/\0[^\0]*//;
+      $DB::dbline{$i} .= "\0" . $act;
+    }
+  }
+}
+
+sub clr_actions {
+  my $s = shift;
+  my $i;
+  if (@_) {
+    while (@_) {
+      my $i = shift;
+      $i = _find_subline($i) if ($i =~ /\D/);
+      $s->output("Subroutine not found.\n") unless $i;
+      if ($i && $DB::dbline[$i] != 0) {
+	$DB::dbline{$i} =~ s/\0[^\0]*//;
+	delete $DB::dbline{$i} if $DB::dbline{$i} =~ s/^\0?$//;
+      }
+    }
+  }
+  else {
+    for ($i = 1; $i <= $#DB::dbline ; $i++) {
+      if (defined $DB::dbline{$i}) {
+	$DB::dbline{$i} =~ s/\0[^\0]*//;
+	delete $DB::dbline{$i} if $DB::dbline{$i} =~ s/^\0?$//;
+      }
+    }
+  }
+}
+
+sub prestop {
+  my ($client, $val) = @_;
+  return defined($val) ? $preeval->{$client} = $val : $preeval->{$client};
+}
+
+sub poststop {
+  my ($client, $val) = @_;
+  return defined($val) ? $posteval->{$client} = $val : $posteval->{$client};
+}
+
+#
+# "pure virtual" methods
+#
+
+# client-specific pre/post-stop actions.
+sub cprestop {}
+sub cpoststop {}
+
+# client complete startup
+sub awaken {}
+
+sub skippkg {
+  my $s = shift;
+  push @skippkg, @_ if @_;
+}
+
+sub evalcode {
+  my ($client, $val) = @_;
+  if (defined $val) {
+    $running = 2;    # hand over to DB() to evaluate in its context
+    $ineval->{$client} = $val;
+  }
+  return $ineval->{$client};
+}
+
+sub ready {
+  my $s = shift;
+  return $ready = 1;
+}
+
+# stubs
+    
+sub init {}
+sub stop {}
+sub idle {}
+sub cleanup {}
+sub output {}
+
+#
+# client init
+#
+for (@clients) { $_->init }
+
+$SIG{'INT'} = \&DB::catch;
+
+# disable this if stepping through END blocks is desired
+# (looks scary and deconstructivist with Swat)
+END { $ready = 0 }
+
+1;
+__END__
+
+=head1 NAME
+
+DB - programmatic interface to the Perl debugging API (draft, subject to
+change)
+
+=head1 SYNOPSIS
+
+    package CLIENT;
+    use DB;
+    @ISA = qw(DB);
+
+    # these (inherited) methods can be called by the client
+
+    CLIENT->register()      # register a client package name
+    CLIENT->done()          # de-register from the debugging API
+    CLIENT->skippkg('hide::hide')  # ask DB not to stop in this package
+    CLIENT->cont([WHERE])       # run some more (until BREAK or another breakpt)
+    CLIENT->step()              # single step
+    CLIENT->next()              # step over
+    CLIENT->ret()               # return from current subroutine
+    CLIENT->backtrace()         # return the call stack description
+    CLIENT->ready()             # call when client setup is done
+    CLIENT->trace_toggle()      # toggle subroutine call trace mode
+    CLIENT->subs([SUBS])        # return subroutine information
+    CLIENT->files()             # return list of all files known to DB
+    CLIENT->lines()             # return lines in currently loaded file
+    CLIENT->loadfile(FILE,LINE) # load a file and let other clients know
+    CLIENT->lineevents()        # return info on lines with actions
+    CLIENT->set_break([WHERE],[COND])
+    CLIENT->set_tbreak([WHERE])
+    CLIENT->clr_breaks([LIST])
+    CLIENT->set_action(WHERE,ACTION)
+    CLIENT->clr_actions([LIST])
+    CLIENT->evalcode(STRING)  # eval STRING in executing code's context
+    CLIENT->prestop([STRING]) # execute in code context before stopping
+    CLIENT->poststop([STRING])# execute in code context before resuming
+
+    # These methods will be called at the appropriate times.
+    # Stub versions provided do nothing.
+    # None of these can block.
+
+    CLIENT->init()          # called when debug API inits itself
+    CLIENT->stop(FILE,LINE) # when execution stops
+    CLIENT->idle()          # while stopped (can be a client event loop)
+    CLIENT->cleanup()       # just before exit
+    CLIENT->output(LIST)    # called to print any output that API must show
+
+=head1 DESCRIPTION
+
+Perl debug information is frequently required not just by debuggers,
+but also by modules that need some "special" information to do their
+job properly, like profilers.
+
+This module abstracts and provides all of the hooks into Perl internal
+debugging functionality, so that various implementations of Perl debuggers
+(or packages that want to simply get at the "privileged" debugging data)
+can all benefit from the development of this common code.  Currently used
+by Swat, the perl/Tk GUI debugger.
+
+Note that multiple "front-ends" can latch into this debugging API
+simultaneously.  This is intended to facilitate things like
+debugging with a command line and GUI at the same time, debugging 
+debuggers etc.  [Sounds nice, but this needs some serious support -- GSAR]
+
+In particular, this API does B<not> provide the following functions:
+
+=over 4
+
+=item *
+
+data display
+
+=item *
+
+command processing
+
+=item *
+
+command alias management
+
+=item *
+
+user interface (tty or graphical)
+
+=back
+
+These are intended to be services performed by the clients of this API.
+
+This module attempts to be squeaky clean w.r.t C<use strict;> and when
+warnings are enabled.
+
+
+=head2 Global Variables
+
+The following "public" global names can be read by clients of this API.
+Beware that these should be considered "readonly".
+
+=over 8
+
+=item  $DB::sub
+
+Name of current executing subroutine.
+
+=item  %DB::sub
+
+The keys of this hash are the names of all the known subroutines.  Each value
+is an encoded string that has the sprintf(3) format 
+C<("%s:%d-%d", filename, fromline, toline)>.
+
+=item  $DB::single
+
+Single-step flag.  Will be true if the API will stop at the next statement.
+
+=item  $DB::signal
+
+Signal flag. Will be set to a true value if a signal was caught.  Clients may
+check for this flag to abort time-consuming operations.
+
+=item  $DB::trace
+
+This flag is set to true if the API is tracing through subroutine calls.
+
+=item  @DB::args
+
+Contains the arguments of current subroutine, or the C<@ARGV> array if in the 
+toplevel context.
+
+=item  @DB::dbline
+
+List of lines in currently loaded file.
+
+=item  %DB::dbline
+
+Actions in current file (keys are line numbers).  The values are strings that
+have the sprintf(3) format C<("%s\000%s", breakcondition, actioncode)>. 
+
+=item  $DB::package
+
+Package namespace of currently executing code.
+
+=item  $DB::filename
+
+Currently loaded filename.
+
+=item  $DB::subname
+
+Fully qualified name of currently executing subroutine.
+
+=item  $DB::lineno
+
+Line number that will be executed next.
+
+=back
+
+=head2 API Methods
+
+The following are methods in the DB base class.  A client must
+access these methods by inheritance (*not* by calling them directly),
+since the API keeps track of clients through the inheritance
+mechanism.
+
+=over 8
+
+=item CLIENT->register()
+
+register a client object/package
+
+=item CLIENT->evalcode(STRING)
+
+eval STRING in executing code context
+
+=item CLIENT->skippkg('D::hide')
+
+ask DB not to stop in these packages
+
+=item CLIENT->run()
+
+run some more (until a breakpt is reached)
+
+=item CLIENT->step()
+
+single step
+
+=item CLIENT->next()
+
+step over
+
+=item CLIENT->done()
+
+de-register from the debugging API
+
+=back
+
+=head2 Client Callback Methods
+
+The following "virtual" methods can be defined by the client.  They will
+be called by the API at appropriate points.  Note that unless specified
+otherwise, the debug API only defines empty, non-functional default versions
+of these methods.
+
+=over 8
+
+=item CLIENT->init()
+
+Called after debug API inits itself.
+
+=item CLIENT->prestop([STRING])
+
+Usually inherited from DB package.  If no arguments are passed,
+returns the prestop action string.
+
+=item CLIENT->stop()
+
+Called when execution stops (w/ args file, line).
+
+=item CLIENT->idle()
+
+Called while stopped (can be a client event loop).
+
+=item CLIENT->poststop([STRING])
+
+Usually inherited from DB package.  If no arguments are passed,
+returns the poststop action string.
+
+=item CLIENT->evalcode(STRING)
+
+Usually inherited from DB package.  Ask for a STRING to be C<eval>-ed
+in executing code context.
+
+=item CLIENT->cleanup()
+
+Called just before exit.
+
+=item CLIENT->output(LIST)
+
+Called when API must show a message (warnings, errors etc.).
+
+
+=back
+
+
+=head1 BUGS
+
+The interface defined by this module is missing some of the later additions
+to perl's debugging functionality.  As such, this interface should be considered
+highly experimental and subject to change.
+
+=head1 AUTHOR
+
+Gurusamy Sarathy	gsar@activestate.com
+
+This code heavily adapted from an early version of perl5db.pl attributable
+to Larry Wall and the Perl Porters.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/DirHandle.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/DirHandle.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/DirHandle.pm	(revision 14265)
@@ -0,0 +1,72 @@
+package DirHandle;
+
+=head1 NAME 
+
+DirHandle - supply object methods for directory handles
+
+=head1 SYNOPSIS
+
+    use DirHandle;
+    $d = new DirHandle ".";
+    if (defined $d) {
+        while (defined($_ = $d->read)) { something($_); }
+        $d->rewind;
+        while (defined($_ = $d->read)) { something_else($_); }
+        undef $d;
+    }
+
+=head1 DESCRIPTION
+
+The C<DirHandle> method provide an alternative interface to the
+opendir(), closedir(), readdir(), and rewinddir() functions.
+
+The only objective benefit to using C<DirHandle> is that it avoids
+namespace pollution by creating globs to hold directory handles.
+
+=cut
+
+require 5.000;
+use Carp;
+use Symbol;
+
+sub new {
+    @_ >= 1 && @_ <= 2 or croak 'usage: new DirHandle [DIRNAME]';
+    my $class = shift;
+    my $dh = gensym;
+    if (@_) {
+	DirHandle::open($dh, $_[0])
+	    or return undef;
+    }
+    bless $dh, $class;
+}
+
+sub DESTROY {
+    my ($dh) = @_;
+    closedir($dh);
+}
+
+sub open {
+    @_ == 2 or croak 'usage: $dh->open(DIRNAME)';
+    my ($dh, $dirname) = @_;
+    opendir($dh, $dirname);
+}
+
+sub close {
+    @_ == 1 or croak 'usage: $dh->close()';
+    my ($dh) = @_;
+    closedir($dh);
+}
+
+sub read {
+    @_ == 1 or croak 'usage: $dh->read()';
+    my ($dh) = @_;
+    readdir($dh);
+}
+
+sub rewind {
+    @_ == 1 or croak 'usage: $dh->rewind()';
+    my ($dh) = @_;
+    rewinddir($dh);
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Dumpvalue.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Dumpvalue.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Dumpvalue.pm	(revision 14265)
@@ -0,0 +1,626 @@
+use 5.005_64;			# for (defined ref) and $#$v and our
+package Dumpvalue;
+use strict;
+our(%address, $stab, @stab, %stab, %subs);
+
+# translate control chars to ^X - Randal Schwartz
+# Modifications to print types by Peter Gordon v1.0
+
+# Ilya Zakharevich -- patches after 5.001 (and some before ;-)
+
+# Won't dump symbol tables and contents of debugged files by default
+
+# (IZ) changes for objectification:
+#   c) quote() renamed to method set_quote();
+#   d) unctrlSet() renamed to method set_unctrl();
+#   f) Compiles with `use strict', but in two places no strict refs is needed:
+#      maybe more problems are waiting...
+
+my %defaults = (
+		globPrint	      => 0,
+		printUndef	      => 1,
+		tick		      => "auto",
+		unctrl		      => 'quote',
+		subdump		      => 1,
+		dumpReused	      => 0,
+		bareStringify	      => 1,
+		hashDepth	      => '',
+		arrayDepth	      => '',
+		dumpDBFiles	      => '',
+		dumpPackages	      => '',
+		quoteHighBit	      => '',
+		usageOnly	      => '',
+		compactDump	      => '',
+		veryCompact	      => '',
+		stopDbSignal	      => '',
+	       );
+
+sub new {
+  my $class = shift;
+  my %opt = (%defaults, @_);
+  bless \%opt, $class;
+}
+
+sub set {
+  my $self = shift;
+  my %opt = @_;
+  @$self{keys %opt} = values %opt;
+}
+
+sub get {
+  my $self = shift;
+  wantarray ? @$self{@_} : $$self{pop @_};
+}
+
+sub dumpValue {
+  my $self = shift;
+  die "usage: \$dumper->dumpValue(value)" unless @_ == 1;
+  local %address;
+  local $^W=0;
+  (print "undef\n"), return unless defined $_[0];
+  (print $self->stringify($_[0]), "\n"), return unless ref $_[0];
+  $self->unwrap($_[0],0);
+}
+
+sub dumpValues {
+  my $self = shift;
+  local %address;
+  local $^W=0;
+  (print "undef\n"), return unless defined $_[0];
+  $self->unwrap(\@_,0);
+}
+
+# This one is good for variable names:
+
+sub unctrl {
+  local($_) = @_;
+
+  return \$_ if ref \$_ eq "GLOB";
+  s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg;
+  $_;
+}
+
+sub stringify {
+  my $self = shift;
+  local $_ = shift;
+  my $noticks = shift;
+  my $tick = $self->{tick};
+
+  return 'undef' unless defined $_ or not $self->{printUndef};
+  return $_ . "" if ref \$_ eq 'GLOB';
+  { no strict 'refs';
+    $_ = &{'overload::StrVal'}($_)
+      if $self->{bareStringify} and ref $_
+	and %overload:: and defined &{'overload::StrVal'};
+  }
+
+  if ($tick eq 'auto') {
+    if (/[\000-\011\013-\037\177]/) {
+      $tick = '"';
+    } else {
+      $tick = "'";
+    }
+  }
+  if ($tick eq "'") {
+    s/([\'\\])/\\$1/g;
+  } elsif ($self->{unctrl} eq 'unctrl') {
+    s/([\"\\])/\\$1/g ;
+    s/([\000-\037\177])/'^'.pack('c',ord($1)^64)/eg;
+    s/([\200-\377])/'\\0x'.sprintf('%2X',ord($1))/eg
+      if $self->{quoteHighBit};
+  } elsif ($self->{unctrl} eq 'quote') {
+    s/([\"\\\$\@])/\\$1/g if $tick eq '"';
+    s/\033/\\e/g;
+    s/([\000-\037\177])/'\\c'.chr(ord($1)^64)/eg;
+  }
+  s/([\200-\377])/'\\'.sprintf('%3o',ord($1))/eg if $self->{quoteHighBit};
+  ($noticks || /^\d+(\.\d*)?\Z/)
+    ? $_
+      : $tick . $_ . $tick;
+}
+
+sub DumpElem {
+  my ($self, $v) = (shift, shift);
+  my $short = $self->stringify($v, ref $v);
+  my $shortmore = '';
+  if ($self->{veryCompact} && ref $v
+      && (ref $v eq 'ARRAY' and !grep(ref $_, @$v) )) {
+    my $depth = $#$v;
+    ($shortmore, $depth) = (' ...', $self->{arrayDepth} - 1)
+      if $self->{arrayDepth} and $depth >= $self->{arrayDepth};
+    my @a = map $self->stringify($_), @$v[0..$depth];
+    print "0..$#{$v}  @a$shortmore\n";
+  } elsif ($self->{veryCompact} && ref $v
+	   && (ref $v eq 'HASH') and !grep(ref $_, values %$v)) {
+    my @a = sort keys %$v;
+    my $depth = $#a;
+    ($shortmore, $depth) = (' ...', $self->{hashDepth} - 1)
+      if $self->{hashDepth} and $depth >= $self->{hashDepth};
+    my @b = map {$self->stringify($_) . " => " . $self->stringify($$v{$_})}
+      @a[0..$depth];
+    local $" = ', ';
+    print "@b$shortmore\n";
+  } else {
+    print "$short\n";
+    $self->unwrap($v,shift);
+  }
+}
+
+sub unwrap {
+  my $self = shift;
+  return if $DB::signal and $self->{stopDbSignal};
+  my ($v) = shift ;
+  my ($s) = shift ;		# extra no of spaces
+  my $sp;
+  my (%v,@v,$address,$short,$fileno);
+
+  $sp = " " x $s ;
+  $s += 3 ;
+
+  # Check for reused addresses
+  if (ref $v) {
+    my $val = $v;
+    { no strict 'refs';
+      $val = &{'overload::StrVal'}($v)
+	if %overload:: and defined &{'overload::StrVal'};
+    }
+    ($address) = $val =~ /(0x[0-9a-f]+)\)$/ ;
+    if (!$self->{dumpReused} && defined $address) {
+      $address{$address}++ ;
+      if ( $address{$address} > 1 ) {
+	print "${sp}-> REUSED_ADDRESS\n" ;
+	return ;
+      }
+    }
+  } elsif (ref \$v eq 'GLOB') {
+    $address = "$v" . "";	# To avoid a bug with globs
+    $address{$address}++ ;
+    if ( $address{$address} > 1 ) {
+      print "${sp}*DUMPED_GLOB*\n" ;
+      return ;
+    }
+  }
+
+  if (ref $v eq 'Regexp') {
+    my $re = "$v";
+    $re =~ s,/,\\/,g;
+    print "$sp-> qr/$re/\n";
+    return;
+  }
+
+  if ( UNIVERSAL::isa($v, 'HASH') ) {
+    my @sortKeys = sort keys(%$v) ;
+    my $more;
+    my $tHashDepth = $#sortKeys ;
+    $tHashDepth = $#sortKeys < $self->{hashDepth}-1 ? $#sortKeys : $self->{hashDepth}-1
+      unless $self->{hashDepth} eq '' ;
+    $more = "....\n" if $tHashDepth < $#sortKeys ;
+    my $shortmore = "";
+    $shortmore = ", ..." if $tHashDepth < $#sortKeys ;
+    $#sortKeys = $tHashDepth ;
+    if ($self->{compactDump} && !grep(ref $_, values %{$v})) {
+      $short = $sp;
+      my @keys;
+      for (@sortKeys) {
+	push @keys, $self->stringify($_) . " => " . $self->stringify($v->{$_});
+      }
+      $short .= join ', ', @keys;
+      $short .= $shortmore;
+      (print "$short\n"), return if length $short <= $self->{compactDump};
+    }
+    for my $key (@sortKeys) {
+      return if $DB::signal and $self->{stopDbSignal};
+      my $value = $ {$v}{$key} ;
+      print $sp, $self->stringify($key), " => ";
+      $self->DumpElem($value, $s);
+    }
+    print "$sp  empty hash\n" unless @sortKeys;
+    print "$sp$more" if defined $more ;
+  } elsif ( UNIVERSAL::isa($v, 'ARRAY') ) {
+    my $tArrayDepth = $#{$v} ;
+    my $more ;
+    $tArrayDepth = $#$v < $self->{arrayDepth}-1 ? $#$v : $self->{arrayDepth}-1
+      unless  $self->{arrayDepth} eq '' ;
+    $more = "....\n" if $tArrayDepth < $#{$v} ;
+    my $shortmore = "";
+    $shortmore = " ..." if $tArrayDepth < $#{$v} ;
+    if ($self->{compactDump} && !grep(ref $_, @{$v})) {
+      if ($#$v >= 0) {
+	$short = $sp . "0..$#{$v}  " .
+	  join(" ", 
+	       map {exists $v->[$_] ? $self->stringify($v->[$_]) : "empty"} ($[..$tArrayDepth)
+	      ) . "$shortmore";
+      } else {
+	$short = $sp . "empty array";
+      }
+      (print "$short\n"), return if length $short <= $self->{compactDump};
+    }
+    for my $num ($[ .. $tArrayDepth) {
+      return if $DB::signal and $self->{stopDbSignal};
+      print "$sp$num  ";
+      if (exists $v->[$num]) {
+        $self->DumpElem($v->[$num], $s);
+      } else {
+	print "empty slot\n";
+      }
+    }
+    print "$sp  empty array\n" unless @$v;
+    print "$sp$more" if defined $more ;
+  } elsif (  UNIVERSAL::isa($v, 'SCALAR') or ref $v eq 'REF' ) {
+    print "$sp-> ";
+    $self->DumpElem($$v, $s);
+  } elsif ( UNIVERSAL::isa($v, 'CODE') ) {
+    print "$sp-> ";
+    $self->dumpsub(0, $v);
+  } elsif ( UNIVERSAL::isa($v, 'GLOB') ) {
+    print "$sp-> ",$self->stringify($$v,1),"\n";
+    if ($self->{globPrint}) {
+      $s += 3;
+      $self->dumpglob('', $s, "{$$v}", $$v, 1);
+    } elsif (defined ($fileno = fileno($v))) {
+      print( (' ' x ($s+3)) .  "FileHandle({$$v}) => fileno($fileno)\n" );
+    }
+  } elsif (ref \$v eq 'GLOB') {
+    if ($self->{globPrint}) {
+      $self->dumpglob('', $s, "{$v}", $v, 1);
+    } elsif (defined ($fileno = fileno(\$v))) {
+      print( (' ' x $s) .  "FileHandle({$v}) => fileno($fileno)\n" );
+    }
+  }
+}
+
+sub matchvar {
+  $_[0] eq $_[1] or
+    ($_[1] =~ /^([!~])(.)([\x00-\xff]*)/) and
+      ($1 eq '!') ^ (eval {($_[2] . "::" . $_[0]) =~ /$2$3/});
+}
+
+sub compactDump {
+  my $self = shift;
+  $self->{compactDump} = shift if @_;
+  $self->{compactDump} = 6*80-1 
+    if $self->{compactDump} and $self->{compactDump} < 2;
+  $self->{compactDump};
+}
+
+sub veryCompact {
+  my $self = shift;
+  $self->{veryCompact} = shift if @_;
+  $self->compactDump(1) if !$self->{compactDump} and $self->{veryCompact};
+  $self->{veryCompact};
+}
+
+sub set_unctrl {
+  my $self = shift;
+  if (@_) {
+    my $in = shift;
+    if ($in eq 'unctrl' or $in eq 'quote') {
+      $self->{unctrl} = $in;
+    } else {
+      print "Unknown value for `unctrl'.\n";
+    }
+  }
+  $self->{unctrl};
+}
+
+sub set_quote {
+  my $self = shift;
+  if (@_ and $_[0] eq '"') {
+    $self->{tick} = '"';
+    $self->{unctrl} = 'quote';
+  } elsif (@_ and $_[0] eq 'auto') {
+    $self->{tick} = 'auto';
+    $self->{unctrl} = 'quote';
+  } elsif (@_) {		# Need to set
+    $self->{tick} = "'";
+    $self->{unctrl} = 'unctrl';
+  }
+  $self->{tick};
+}
+
+sub dumpglob {
+  my $self = shift;
+  return if $DB::signal and $self->{stopDbSignal};
+  my ($package, $off, $key, $val, $all) = @_;
+  local(*stab) = $val;
+  my $fileno;
+  if (($key !~ /^_</ or $self->{dumpDBFiles}) and defined $stab) {
+    print( (' ' x $off) . "\$", &unctrl($key), " = " );
+    $self->DumpElem($stab, 3+$off);
+  }
+  if (($key !~ /^_</ or $self->{dumpDBFiles}) and @stab) {
+    print( (' ' x $off) . "\@$key = (\n" );
+    $self->unwrap(\@stab,3+$off) ;
+    print( (' ' x $off) .  ")\n" );
+  }
+  if ($key ne "main::" && $key ne "DB::" && %stab
+      && ($self->{dumpPackages} or $key !~ /::$/)
+      && ($key !~ /^_</ or $self->{dumpDBFiles})
+      && !($package eq "Dumpvalue" and $key eq "stab")) {
+    print( (' ' x $off) . "\%$key = (\n" );
+    $self->unwrap(\%stab,3+$off) ;
+    print( (' ' x $off) .  ")\n" );
+  }
+  if (defined ($fileno = fileno(*stab))) {
+    print( (' ' x $off) .  "FileHandle($key) => fileno($fileno)\n" );
+  }
+  if ($all) {
+    if (defined &stab) {
+      $self->dumpsub($off, $key);
+    }
+  }
+}
+
+sub CvGV_name {
+  my $self = shift;
+  my $in = shift;
+  return if $self->{skipCvGV};	# Backdoor to avoid problems if XS broken...
+  $in = \&$in;			# Hard reference...
+  eval {require Devel::Peek; 1} or return;
+  my $gv = Devel::Peek::CvGV($in) or return;
+  *$gv{PACKAGE} . '::' . *$gv{NAME};
+}
+
+sub dumpsub {
+  my $self = shift;
+  my ($off,$sub) = @_;
+  my $ini = $sub;
+  my $s;
+  $sub = $1 if $sub =~ /^\{\*(.*)\}$/;
+  my $subref = defined $1 ? \&$sub : \&$ini;
+  my $place = $DB::sub{$sub} || (($s = $subs{"$subref"}) && $DB::sub{$s})
+    || (($s = $self->CvGV_name($subref)) && $DB::sub{$s})
+    || ($self->{subdump} && ($s = $self->findsubs("$subref"))
+	&& $DB::sub{$s});
+  $s = $sub unless defined $s;
+  $place = '???' unless defined $place;
+  print( (' ' x $off) .  "&$s in $place\n" );
+}
+
+sub findsubs {
+  my $self = shift;
+  return undef unless %DB::sub;
+  my ($addr, $name, $loc);
+  while (($name, $loc) = each %DB::sub) {
+    $addr = \&$name;
+    $subs{"$addr"} = $name;
+  }
+  $self->{subdump} = 0;
+  $subs{ shift() };
+}
+
+sub dumpvars {
+  my $self = shift;
+  my ($package,@vars) = @_;
+  local(%address,$^W);
+  my ($key,$val);
+  $package .= "::" unless $package =~ /::$/;
+  *stab = *main::;
+
+  while ($package =~ /(\w+?::)/g) {
+    *stab = $ {stab}{$1};
+  }
+  $self->{TotalStrings} = 0;
+  $self->{Strings} = 0;
+  $self->{CompleteTotal} = 0;
+  while (($key,$val) = each(%stab)) {
+    return if $DB::signal and $self->{stopDbSignal};
+    next if @vars && !grep( matchvar($key, $_), @vars );
+    if ($self->{usageOnly}) {
+      $self->globUsage(\$val, $key)
+	if ($package ne 'Dumpvalue' or $key ne 'stab')
+	   and ref(\$val) eq 'GLOB';
+    } else {
+      $self->dumpglob($package, 0,$key, $val);
+    }
+  }
+  if ($self->{usageOnly}) {
+    print <<EOP;
+String space: $self->{TotalStrings} bytes in $self->{Strings} strings.
+EOP
+    $self->{CompleteTotal} += $self->{TotalStrings};
+    print <<EOP;
+Grand total = $self->{CompleteTotal} bytes (1 level deep) + overhead.
+EOP
+  }
+}
+
+sub scalarUsage {
+  my $self = shift;
+  my $size = length($_[0]);
+  $self->{TotalStrings} += $size;
+  $self->{Strings}++;
+  $size;
+}
+
+sub arrayUsage {		# array ref, name
+  my $self = shift;
+  my $size = 0;
+  map {$size += $self->scalarUsage($_)} @{$_[0]};
+  my $len = @{$_[0]};
+  print "\@$_[1] = $len item", ($len > 1 ? "s" : ""), " (data: $size bytes)\n"
+      if defined $_[1];
+  $self->{CompleteTotal} +=  $size;
+  $size;
+}
+
+sub hashUsage {			# hash ref, name
+  my $self = shift;
+  my @keys = keys %{$_[0]};
+  my @values = values %{$_[0]};
+  my $keys = $self->arrayUsage(\@keys);
+  my $values = $self->arrayUsage(\@values);
+  my $len = @keys;
+  my $total = $keys + $values;
+  print "\%$_[1] = $len item", ($len > 1 ? "s" : ""),
+    " (keys: $keys; values: $values; total: $total bytes)\n"
+      if defined $_[1];
+  $total;
+}
+
+sub globUsage {			# glob ref, name
+  my $self = shift;
+  local *stab = *{$_[0]};
+  my $total = 0;
+  $total += $self->scalarUsage($stab) if defined $stab;
+  $total += $self->arrayUsage(\@stab, $_[1]) if @stab;
+  $total += $self->hashUsage(\%stab, $_[1]) 
+    if %stab and $_[1] ne "main::" and $_[1] ne "DB::";	
+  #and !($package eq "Dumpvalue" and $key eq "stab"));
+  $total;
+}
+
+1;
+
+=head1 NAME
+
+Dumpvalue - provides screen dump of Perl data.
+
+=head1 SYNOPSIS
+
+  use Dumpvalue;
+  my $dumper = new Dumpvalue;
+  $dumper->set(globPrint => 1);
+  $dumper->dumpValue(\*::);
+  $dumper->dumpvars('main');
+
+=head1 DESCRIPTION
+
+=head2 Creation
+
+A new dumper is created by a call
+
+  $d = new Dumpvalue(option1 => value1, option2 => value2)
+
+Recognized options:
+
+=over
+
+=item C<arrayDepth>, C<hashDepth>
+
+Print only first N elements of arrays and hashes.  If false, prints all the
+elements.
+
+=item C<compactDump>, C<veryCompact>
+
+Change style of array and hash dump.  If true, short array
+may be printed on one line.
+
+=item C<globPrint>
+
+Whether to print contents of globs.
+
+=item C<DumpDBFiles>
+
+Dump arrays holding contents of debugged files.
+
+=item C<DumpPackages>
+
+Dump symbol tables of packages.
+
+=item C<DumpReused>
+
+Dump contents of "reused" addresses.
+
+=item C<tick>, C<HighBit>, C<printUndef>
+
+Change style of string dump.  Default value of C<tick> is C<auto>, one
+can enable either double-quotish dump, or single-quotish by setting it
+to C<"> or C<'>.  By default, characters with high bit set are printed
+I<as is>.
+
+=item C<UsageOnly>
+
+I<very> rudimentally per-package memory usage dump.  If set,
+C<dumpvars> calculates total size of strings in variables in the package.
+
+=item unctrl
+
+Changes the style of printout of strings.  Possible values are
+C<unctrl> and C<quote>.
+
+=item subdump
+
+Whether to try to find the subroutine name given the reference.
+
+=item bareStringify
+
+Whether to write the non-overloaded form of the stringify-overloaded objects.
+
+=item quoteHighBit
+
+Whether to print chars with high bit set in binary or "as is".
+
+=item stopDbSignal
+
+Whether to abort printing if debugger signal flag is raised.
+
+=back
+
+Later in the life of the object the methods may be queries with get()
+method and set() method (which accept multiple arguments).
+
+=head2 Methods
+
+=over
+
+=item dumpValue
+
+  $dumper->dumpValue($value);
+  $dumper->dumpValue([$value1, $value2]);
+
+=item dumpValues
+
+  $dumper->dumpValues($value1, $value2);
+
+=item dumpvars
+
+  $dumper->dumpvars('my_package');
+  $dumper->dumpvars('my_package', 'foo', '~bar$', '!......');
+
+The optional arguments are considered as literal strings unless they
+start with C<~> or C<!>, in which case they are interpreted as regular
+expressions (possibly negated).
+
+The second example prints entries with names C<foo>, and also entries
+with names which ends on C<bar>, or are shorter than 5 chars.
+
+=item set_quote
+
+  $d->set_quote('"');
+
+Sets C<tick> and C<unctrl> options to suitable values for printout with the
+given quote char.  Possible values are C<auto>, C<'> and C<">.
+
+=item set_unctrl
+
+  $d->set_unctrl('"');
+
+Sets C<unctrl> option with checking for an invalid argument.
+Possible values are C<unctrl> and C<quote>.
+
+=item compactDump
+
+  $d->compactDump(1);
+
+Sets C<compactDump> option.  If the value is 1, sets to a reasonable
+big number.
+
+=item veryCompact
+
+  $d->veryCompact(1);
+
+Sets C<compactDump> and C<veryCompact> options simultaneously.
+
+=item set
+
+  $d->set(option1 => value1, option2 => value2);
+
+=item get
+
+  @values = $d->get('option1', 'option2');
+
+=back
+
+=cut
+
Index: /for-distributions/trunk/bin/windows/perl/lib/DynaLoader.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/DynaLoader.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/DynaLoader.pm	(revision 14265)
@@ -0,0 +1,800 @@
+
+# Generated from DynaLoader.pm.PL
+
+package DynaLoader;
+
+#   And Gandalf said: 'Many folk like to know beforehand what is to
+#   be set on the table; but those who have laboured to prepare the
+#   feast like to keep their secret; for wonder makes the words of
+#   praise louder.'
+
+#   (Quote from Tolkien suggested by Anno Siegel.)
+#
+# See pod text at end of file for documentation.
+# See also ext/DynaLoader/README in source tree for other information.
+#
+# Tim.Bunce@ig.co.uk, August 1994
+
+use vars qw($VERSION *AUTOLOAD);
+
+$VERSION = 1.04;	# avoid typo warning
+
+require AutoLoader;
+*AUTOLOAD = \&AutoLoader::AUTOLOAD;
+
+use Config;
+
+# The following require can't be removed during maintenance
+# releases, sadly, because of the risk of buggy code that does 
+# require Carp; Carp::croak "..."; without brackets dying 
+# if Carp hasn't been loaded in earlier compile time. :-( 
+# We'll let those bugs get found on the development track.
+require Carp if $] < 5.00450; 
+
+# enable debug/trace messages from DynaLoader perl code
+$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
+
+#
+# Flags to alter dl_load_file behaviour.  Assigned bits:
+#   0x01  make symbols available for linking later dl_load_file's.
+#         (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL))
+#         (ignored under VMS; effect is built-in to image linking)
+#
+# This is called as a class method $module->dl_load_flags.  The
+# definition here will be inherited and result on "default" loading
+# behaviour unless a sub-class of DynaLoader defines its own version.
+#
+
+sub dl_load_flags { 0x00 }
+
+# ($dl_dlext, $dlsrc)
+#         = @Config::Config{'dlext', 'dlsrc'};
+  ($dl_dlext, $dlsrc) = ('dll','dl_win32.xs')
+;
+# Some systems need special handling to expand file specifications
+# (VMS support by Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>)
+# See dl_expandspec() for more details. Should be harmless but
+# inefficient to define on systems that don't need it.
+$Is_VMS    = $^O eq 'VMS';
+$do_expand = $Is_VMS;
+$Is_MacOS  = $^O eq 'MacOS';
+
+@dl_require_symbols = ();       # names of symbols we need
+@dl_resolve_using   = ();       # names of files to link with
+@dl_library_path    = ();       # path to look for files
+@dl_librefs         = ();       # things we have loaded
+@dl_modules         = ();       # Modules we have loaded
+
+# This is a fix to support DLD's unfortunate desire to relink -lc
+@dl_resolve_using = dl_findfile('-lc') if $dlsrc eq "dl_dld.xs";
+
+# Initialise @dl_library_path with the 'standard' library path
+# for this platform as determined by Configure.
+
+push(@dl_library_path, split(' ', $Config::Config{libpth}));
+
+
+my $ldlibpthname         = $Config::Config{ldlibpthname};
+my $ldlibpthname_defined = defined $Config::Config{ldlibpthname};
+my $pthsep               = $Config::Config{path_sep};
+
+# Add to @dl_library_path any extra directories we can gather from environment
+# during runtime.
+
+if ($ldlibpthname_defined &&
+    exists $ENV{$ldlibpthname}) {
+    push(@dl_library_path, split(/$pthsep/, $ENV{$ldlibpthname}));
+}
+
+# E.g. HP-UX supports both its native SHLIB_PATH *and* LD_LIBRARY_PATH.
+
+if ($ldlibpthname_defined &&
+    $ldlibpthname ne 'LD_LIBRARY_PATH' &&
+    exists $ENV{LD_LIBRARY_PATH}) {
+    push(@dl_library_path, split(/$pthsep/, $ENV{LD_LIBRARY_PATH}));
+}
+
+
+# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
+# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB
+boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
+                                !defined(&dl_error);
+
+if ($dl_debug) {
+    print STDERR "DynaLoader.pm loaded (@INC, @dl_library_path)\n";
+    print STDERR "DynaLoader not linked into this perl\n"
+	    unless defined(&boot_DynaLoader);
+}
+
+1; # End of main code
+
+
+sub croak   { require Carp; Carp::croak(@_)   }
+
+sub bootstrap_inherit {
+    my $module = $_[0];
+    local *isa = *{"$module\::ISA"};
+    local @isa = (@isa, 'DynaLoader');
+    # Cannot goto due to delocalization.  Will report errors on a wrong line?
+    bootstrap(@_);
+}
+
+# The bootstrap function cannot be autoloaded (without complications)
+# so we define it here:
+
+sub bootstrap {
+    # use local vars to enable $module.bs script to edit values
+    local(@args) = @_;
+    local($module) = $args[0];
+    local(@dirs, $file);
+
+    unless ($module) {
+	require Carp;
+	Carp::confess("Usage: DynaLoader::bootstrap(module)");
+    }
+
+    # A common error on platforms which don't support dynamic loading.
+    # Since it's fatal and potentially confusing we give a detailed message.
+    croak("Can't load module $module, dynamic loading not available in this perl.\n".
+	"  (You may need to build a new perl executable which either supports\n".
+	"  dynamic loading or has the $module module statically linked into it.)\n")
+	unless defined(&dl_load_file);
+
+    my @modparts = split(/::/,$module);
+    my $modfname = $modparts[-1];
+
+    # Some systems have restrictions on files names for DLL's etc.
+    # mod2fname returns appropriate file base name (typically truncated)
+    # It may also edit @modparts if required.
+    $modfname = &mod2fname(\@modparts) if defined &mod2fname;
+
+    my $modpname = join(($Is_MacOS ? ':' : '/'),@modparts);
+
+    print STDERR "DynaLoader::bootstrap for $module ",
+		($Is_MacOS
+		       ? "(:auto:$modpname:$modfname.$dl_dlext)\n" :
+		       "(auto/$modpname/$modfname.$dl_dlext)\n")
+	if $dl_debug;
+
+    foreach (@INC) {
+	chop($_ = VMS::Filespec::unixpath($_)) if $Is_VMS;
+	my $dir;
+	if ($Is_MacOS) {
+	    chop $_  if /:$/;
+	    $dir = "$_:auto:$modpname";
+	} else {
+	    $dir = "$_/auto/$modpname";
+	}
+	next unless -d $dir; # skip over uninteresting directories
+
+	# check for common cases to avoid autoload of dl_findfile
+	my $try = $Is_MacOS ? "$dir:$modfname.$dl_dlext" : "$dir/$modfname.$dl_dlext";
+	last if $file = ($do_expand) ? dl_expandspec($try) : (-f $try && $try);
+
+	# no luck here, save dir for possible later dl_findfile search
+	push @dirs, $dir;
+    }
+    # last resort, let dl_findfile have a go in all known locations
+    $file = dl_findfile(map("-L$_",@dirs,@INC), $modfname) unless $file;
+
+    croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)")
+	unless $file;	# wording similar to error from 'require'
+
+    $file = uc($file) if $Is_VMS && $Config::Config{d_vms_case_sensitive_symbols};
+    my $bootname = "boot_$module";
+    $bootname =~ s/\W/_/g;
+    @dl_require_symbols = ($bootname);
+
+    # Execute optional '.bootstrap' perl script for this module.
+    # The .bs file can be used to configure @dl_resolve_using etc to
+    # match the needs of the individual module on this architecture.
+    my $bs = $file;
+    $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
+    if (-s $bs) { # only read file if it's not empty
+        print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug;
+        eval { do $bs; };
+        warn "$bs: $@\n" if $@;
+    }
+
+    # Many dynamic extension loading problems will appear to come from
+    # this section of code: XYZ failed at line 123 of DynaLoader.pm.
+    # Often these errors are actually occurring in the initialisation
+    # C code of the extension XS file. Perl reports the error as being
+    # in this perl code simply because this was the last perl code
+    # it executed.
+
+    my $libref = dl_load_file($file, $module->dl_load_flags) or
+	croak("Can't load '$file' for module $module: ".dl_error());
+
+    push(@dl_librefs,$libref);  # record loaded object
+
+    my @unresolved = dl_undef_symbols();
+    if (@unresolved) {
+	require Carp;
+	Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
+    }
+
+    my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or
+         croak("Can't find '$bootname' symbol in $file\n");
+
+    my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
+
+    push(@dl_modules, $module); # record loaded module
+
+    # See comment block above
+    &$xs(@args);
+}
+
+
+#sub _check_file {   # private utility to handle dl_expandspec vs -f tests
+#    my($file) = @_;
+#    return $file if (!$do_expand && -f $file); # the common case
+#    return $file if ( $do_expand && ($file=dl_expandspec($file)));
+#    return undef;
+#}
+
+
+# Let autosplit and the autoloader deal with these functions:
+__END__
+
+
+sub dl_findfile {
+    # Read ext/DynaLoader/DynaLoader.doc for detailed information.
+    # This function does not automatically consider the architecture
+    # or the perl library auto directories.
+    my (@args) = @_;
+    my (@dirs,  $dir);   # which directories to search
+    my (@found);         # full paths to real files we have found
+    my $dl_ext= 'dll'; # $Config::Config{'dlext'} suffix for perl extensions
+    my $dl_so = 'dll'; # $Config::Config{'so'} suffix for shared libraries
+
+    print STDERR "dl_findfile(@args)\n" if $dl_debug;
+
+    # accumulate directories but process files as they appear
+    arg: foreach(@args) {
+        #  Special fast case: full filepath requires no search
+        if ($Is_VMS && m%[:>/\]]% && -f $_) {
+	    push(@found,dl_expandspec(VMS::Filespec::vmsify($_)));
+	    last arg unless wantarray;
+	    next;
+        }
+	elsif ($Is_MacOS) {
+	    if (m/:/ && -f $_) {
+	    	push(@found,$_);
+	    	last arg unless wantarray;
+	    }
+	}
+        elsif (m:/: && -f $_ && !$do_expand) {
+	    push(@found,$_);
+	    last arg unless wantarray;
+	    next;
+	}
+
+        # Deal with directories first:
+        #  Using a -L prefix is the preferred option (faster and more robust)
+        if (m:^-L:) { s/^-L//; push(@dirs, $_); next; }
+
+	if ($Is_MacOS) {
+            #  Otherwise we try to try to spot directories by a heuristic
+            #  (this is a more complicated issue than it first appears)
+	    if (m/:/ && -d $_) {   push(@dirs, $_); next; }
+            #  Only files should get this far...
+            my(@names, $name);    # what filenames to look for
+	    s/^-l//;
+	    push(@names, $_);
+            foreach $dir (@dirs, @dl_library_path) {
+            	next unless -d $dir;
+		$dir =~ s/^([^:]+)$/:$1/;
+		$dir =~ s/:$//;
+            	foreach $name (@names) {
+	    	    my($file) = "$dir:$name";
+                    print STDERR " checking in $dir for $name\n" if $dl_debug;
+		    if (-f $file) {
+                    	push(@found, $file);
+                    	next arg; # no need to look any further
+                    }
+                }
+	    }
+	    next;
+	}
+	
+        #  Otherwise we try to try to spot directories by a heuristic
+        #  (this is a more complicated issue than it first appears)
+        if (m:/: && -d $_) {   push(@dirs, $_); next; }
+
+        # VMS: we may be using native VMS directory syntax instead of
+        # Unix emulation, so check this as well
+        if ($Is_VMS && /[:>\]]/ && -d $_) {   push(@dirs, $_); next; }
+
+        #  Only files should get this far...
+        my(@names, $name);    # what filenames to look for
+        if (m:-l: ) {          # convert -lname to appropriate library name
+            s/-l//;
+            push(@names,"lib$_.$dl_so");
+            push(@names,"lib$_.a");
+        } else {                # Umm, a bare name. Try various alternatives:
+            # these should be ordered with the most likely first
+            push(@names,"$_.$dl_ext")    unless m/\.$dl_ext$/o;
+            push(@names,"$_.$dl_so")     unless m/\.$dl_so$/o;
+            push(@names,"lib$_.$dl_so")  unless m:/:;
+            push(@names,"$_.a")          if !m/\.a$/ and $dlsrc eq "dl_dld.xs";
+            push(@names, $_);
+        }
+        foreach $dir (@dirs, @dl_library_path) {
+            next unless -d $dir;
+            chop($dir = VMS::Filespec::unixpath($dir)) if $Is_VMS;
+            foreach $name (@names) {
+		my($file) = "$dir/$name";
+                print STDERR " checking in $dir for $name\n" if $dl_debug;
+		$file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file);
+		#$file = _check_file($file);
+		if ($file) {
+                    push(@found, $file);
+                    next arg; # no need to look any further
+                }
+            }
+        }
+    }
+    if ($dl_debug) {
+        foreach(@dirs) {
+            print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_;
+        }
+        print STDERR "dl_findfile found: @found\n";
+    }
+    return $found[0] unless wantarray;
+    @found;
+}
+
+
+sub dl_expandspec {
+    my($spec) = @_;
+    # Optional function invoked if DynaLoader.pm sets $do_expand.
+    # Most systems do not require or use this function.
+    # Some systems may implement it in the dl_*.xs file in which case
+    # this autoload version will not be called but is harmless.
+
+    # This function is designed to deal with systems which treat some
+    # 'filenames' in a special way. For example VMS 'Logical Names'
+    # (something like unix environment variables - but different).
+    # This function should recognise such names and expand them into
+    # full file paths.
+    # Must return undef if $spec is invalid or file does not exist.
+
+    my $file = $spec; # default output to input
+
+    if ($Is_VMS) { # dl_expandspec should be defined in dl_vms.xs
+	require Carp;
+	Carp::croak("dl_expandspec: should be defined in XS file!\n");
+    } else {
+	return undef unless -f $file;
+    }
+    print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug;
+    $file;
+}
+
+sub dl_find_symbol_anywhere
+{
+    my $sym = shift;
+    my $libref;
+    foreach $libref (@dl_librefs) {
+	my $symref = dl_find_symbol($libref,$sym);
+	return $symref if $symref;
+    }
+    return undef;
+}
+
+=head1 NAME
+
+DynaLoader - Dynamically load C libraries into Perl code
+
+dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_unload_file(), dl_find_symbol(), dl_find_symbol_anywhere(), dl_undef_symbols(), dl_install_xsub(), dl_load_flags(), bootstrap() - routines used by DynaLoader modules
+
+=head1 SYNOPSIS
+
+    package YourPackage;
+    require DynaLoader;
+    @ISA = qw(... DynaLoader ...);
+    bootstrap YourPackage;
+
+    # optional method for 'global' loading
+    sub dl_load_flags { 0x01 }     
+
+
+=head1 DESCRIPTION
+
+This document defines a standard generic interface to the dynamic
+linking mechanisms available on many platforms.  Its primary purpose is
+to implement automatic dynamic loading of Perl modules.
+
+This document serves as both a specification for anyone wishing to
+implement the DynaLoader for a new platform and as a guide for
+anyone wishing to use the DynaLoader directly in an application.
+
+The DynaLoader is designed to be a very simple high-level
+interface that is sufficiently general to cover the requirements
+of SunOS, HP-UX, NeXT, Linux, VMS and other platforms.
+
+It is also hoped that the interface will cover the needs of OS/2, NT
+etc and also allow pseudo-dynamic linking (using C<ld -A> at runtime).
+
+It must be stressed that the DynaLoader, by itself, is practically
+useless for accessing non-Perl libraries because it provides almost no
+Perl-to-C 'glue'.  There is, for example, no mechanism for calling a C
+library function or supplying arguments.  A C::DynaLib module
+is available from CPAN sites which performs that function for some
+common system types.
+
+DynaLoader Interface Summary
+
+  @dl_library_path
+  @dl_resolve_using
+  @dl_require_symbols
+  $dl_debug
+  @dl_librefs
+  @dl_modules
+                                                  Implemented in:
+  bootstrap($modulename)                               Perl
+  @filepaths = dl_findfile(@names)                     Perl
+  $flags = $modulename->dl_load_flags                  Perl
+  $symref  = dl_find_symbol_anywhere($symbol)          Perl
+
+  $libref  = dl_load_file($filename, $flags)           C
+  $status  = dl_unload_file($libref)                   C
+  $symref  = dl_find_symbol($libref, $symbol)          C
+  @symbols = dl_undef_symbols()                        C
+  dl_install_xsub($name, $symref [, $filename])        C
+  $message = dl_error                                  C
+
+=over 4
+
+=item @dl_library_path
+
+The standard/default list of directories in which dl_findfile() will
+search for libraries etc.  Directories are searched in order:
+$dl_library_path[0], [1], ... etc
+
+@dl_library_path is initialised to hold the list of 'normal' directories
+(F</usr/lib>, etc) determined by B<Configure> (C<$Config{'libpth'}>).  This should
+ensure portability across a wide range of platforms.
+
+@dl_library_path should also be initialised with any other directories
+that can be determined from the environment at runtime (such as
+LD_LIBRARY_PATH for SunOS).
+
+After initialisation @dl_library_path can be manipulated by an
+application using push and unshift before calling dl_findfile().
+Unshift can be used to add directories to the front of the search order
+either to save search time or to override libraries with the same name
+in the 'normal' directories.
+
+The load function that dl_load_file() calls may require an absolute
+pathname.  The dl_findfile() function and @dl_library_path can be
+used to search for and return the absolute pathname for the
+library/object that you wish to load.
+
+=item @dl_resolve_using
+
+A list of additional libraries or other shared objects which can be
+used to resolve any undefined symbols that might be generated by a
+later call to load_file().
+
+This is only required on some platforms which do not handle dependent
+libraries automatically.  For example the Socket Perl extension
+library (F<auto/Socket/Socket.so>) contains references to many socket
+functions which need to be resolved when it's loaded.  Most platforms
+will automatically know where to find the 'dependent' library (e.g.,
+F</usr/lib/libsocket.so>).  A few platforms need to be told the
+location of the dependent library explicitly.  Use @dl_resolve_using
+for this.
+
+Example usage:
+
+    @dl_resolve_using = dl_findfile('-lsocket');
+
+=item @dl_require_symbols
+
+A list of one or more symbol names that are in the library/object file
+to be dynamically loaded.  This is only required on some platforms.
+
+=item @dl_librefs
+
+An array of the handles returned by successful calls to dl_load_file(),
+made by bootstrap, in the order in which they were loaded.
+Can be used with dl_find_symbol() to look for a symbol in any of
+the loaded files.
+
+=item @dl_modules
+
+An array of module (package) names that have been bootstrap'ed.
+
+=item dl_error()
+
+Syntax:
+
+    $message = dl_error();
+
+Error message text from the last failed DynaLoader function.  Note
+that, similar to errno in unix, a successful function call does not
+reset this message.
+
+Implementations should detect the error as soon as it occurs in any of
+the other functions and save the corresponding message for later
+retrieval.  This will avoid problems on some platforms (such as SunOS)
+where the error message is very temporary (e.g., dlerror()).
+
+=item $dl_debug
+
+Internal debugging messages are enabled when $dl_debug is set true.
+Currently setting $dl_debug only affects the Perl side of the
+DynaLoader.  These messages should help an application developer to
+resolve any DynaLoader usage problems.
+
+$dl_debug is set to C<$ENV{'PERL_DL_DEBUG'}> if defined.
+
+For the DynaLoader developer/porter there is a similar debugging
+variable added to the C code (see dlutils.c) and enabled if Perl was
+built with the B<-DDEBUGGING> flag.  This can also be set via the
+PERL_DL_DEBUG environment variable.  Set to 1 for minimal information or
+higher for more.
+
+=item dl_findfile()
+
+Syntax:
+
+    @filepaths = dl_findfile(@names)
+
+Determine the full paths (including file suffix) of one or more
+loadable files given their generic names and optionally one or more
+directories.  Searches directories in @dl_library_path by default and
+returns an empty list if no files were found.
+
+Names can be specified in a variety of platform independent forms.  Any
+names in the form B<-lname> are converted into F<libname.*>, where F<.*> is
+an appropriate suffix for the platform.
+
+If a name does not already have a suitable prefix and/or suffix then
+the corresponding file will be searched for by trying combinations of
+prefix and suffix appropriate to the platform: "$name.o", "lib$name.*"
+and "$name".
+
+If any directories are included in @names they are searched before
+@dl_library_path.  Directories may be specified as B<-Ldir>.  Any other
+names are treated as filenames to be searched for.
+
+Using arguments of the form C<-Ldir> and C<-lname> is recommended.
+
+Example: 
+
+    @dl_resolve_using = dl_findfile(qw(-L/usr/5lib -lposix));
+
+
+=item dl_expandspec()
+
+Syntax:
+
+    $filepath = dl_expandspec($spec)
+
+Some unusual systems, such as VMS, require special filename handling in
+order to deal with symbolic names for files (i.e., VMS's Logical Names).
+
+To support these systems a dl_expandspec() function can be implemented
+either in the F<dl_*.xs> file or code can be added to the autoloadable
+dl_expandspec() function in F<DynaLoader.pm>.  See F<DynaLoader.pm> for
+more information.
+
+=item dl_load_file()
+
+Syntax:
+
+    $libref = dl_load_file($filename, $flags)
+
+Dynamically load $filename, which must be the path to a shared object
+or library.  An opaque 'library reference' is returned as a handle for
+the loaded object.  Returns undef on error.
+
+The $flags argument to alters dl_load_file behaviour.  
+Assigned bits:
+
+ 0x01  make symbols available for linking later dl_load_file's.
+       (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL))
+       (ignored under VMS; this is a normal part of image linking)
+
+(On systems that provide a handle for the loaded object such as SunOS
+and HPUX, $libref will be that handle.  On other systems $libref will
+typically be $filename or a pointer to a buffer containing $filename.
+The application should not examine or alter $libref in any way.)
+
+This is the function that does the real work.  It should use the
+current values of @dl_require_symbols and @dl_resolve_using if required.
+
+    SunOS: dlopen($filename)
+    HP-UX: shl_load($filename)
+    Linux: dld_create_reference(@dl_require_symbols); dld_link($filename)
+    NeXT:  rld_load($filename, @dl_resolve_using)
+    VMS:   lib$find_image_symbol($filename,$dl_require_symbols[0])
+
+(The dlopen() function is also used by Solaris and some versions of
+Linux, and is a common choice when providing a "wrapper" on other
+mechanisms as is done in the OS/2 port.)
+
+=item dl_unload_file()
+
+Syntax:
+
+    $status = dl_unload_file($libref)
+
+Dynamically unload $libref, which must be an opaque 'library reference' as
+returned from dl_load_file.  Returns one on success and zero on failure.
+
+This function is optional and may not necessarily be provided on all platforms.
+If it is defined, it is called automatically when the interpreter exits for
+every shared object or library loaded by DynaLoader::bootstrap.  All such
+library references are stored in @dl_librefs by DynaLoader::Bootstrap as it
+loads the libraries.  The files are unloaded in last-in, first-out order.
+
+This unloading is usually necessary when embedding a shared-object perl (e.g.
+one configured with -Duseshrplib) within a larger application, and the perl
+interpreter is created and destroyed several times within the lifetime of the
+application.  In this case it is possible that the system dynamic linker will
+unload and then subsequently reload the shared libperl without relocating any
+references to it from any files DynaLoaded by the previous incarnation of the
+interpreter.  As a result, any shared objects opened by DynaLoader may point to
+a now invalid 'ghost' of the libperl shared object, causing apparently random
+memory corruption and crashes.  This behaviour is most commonly seen when using
+Apache and mod_perl built with the APXS mechanism.
+
+    SunOS: dlclose($libref)
+    HP-UX: ???
+    Linux: ???
+    NeXT:  ???
+    VMS:   ???
+
+(The dlclose() function is also used by Solaris and some versions of
+Linux, and is a common choice when providing a "wrapper" on other
+mechanisms as is done in the OS/2 port.)
+
+=item dl_loadflags()
+
+Syntax:
+
+    $flags = dl_loadflags $modulename;
+
+Designed to be a method call, and to be overridden by a derived class
+(i.e. a class which has DynaLoader in its @ISA).  The definition in
+DynaLoader itself returns 0, which produces standard behavior from
+dl_load_file().
+
+=item dl_find_symbol()
+
+Syntax:
+
+    $symref = dl_find_symbol($libref, $symbol)
+
+Return the address of the symbol $symbol or C<undef> if not found.  If the
+target system has separate functions to search for symbols of different
+types then dl_find_symbol() should search for function symbols first and
+then other types.
+
+The exact manner in which the address is returned in $symref is not
+currently defined.  The only initial requirement is that $symref can
+be passed to, and understood by, dl_install_xsub().
+
+    SunOS: dlsym($libref, $symbol)
+    HP-UX: shl_findsym($libref, $symbol)
+    Linux: dld_get_func($symbol) and/or dld_get_symbol($symbol)
+    NeXT:  rld_lookup("_$symbol")
+    VMS:   lib$find_image_symbol($libref,$symbol)
+
+
+=item dl_find_symbol_anywhere()
+
+Syntax:
+
+    $symref = dl_find_symbol_anywhere($symbol)
+
+Applies dl_find_symbol() to the members of @dl_librefs and returns
+the first match found.
+
+=item dl_undef_symbols()
+
+Example
+
+    @symbols = dl_undef_symbols()
+
+Return a list of symbol names which remain undefined after load_file().
+Returns C<()> if not known.  Don't worry if your platform does not provide
+a mechanism for this.  Most do not need it and hence do not provide it,
+they just return an empty list.
+
+
+=item dl_install_xsub()
+
+Syntax:
+
+    dl_install_xsub($perl_name, $symref [, $filename])
+
+Create a new Perl external subroutine named $perl_name using $symref as
+a pointer to the function which implements the routine.  This is simply
+a direct call to newXSUB().  Returns a reference to the installed
+function.
+
+The $filename parameter is used by Perl to identify the source file for
+the function if required by die(), caller() or the debugger.  If
+$filename is not defined then "DynaLoader" will be used.
+
+
+=item bootstrap()
+
+Syntax:
+
+bootstrap($module)
+
+This is the normal entry point for automatic dynamic loading in Perl.
+
+It performs the following actions:
+
+=over 8
+
+=item *
+
+locates an auto/$module directory by searching @INC
+
+=item *
+
+uses dl_findfile() to determine the filename to load
+
+=item *
+
+sets @dl_require_symbols to C<("boot_$module")>
+
+=item *
+
+executes an F<auto/$module/$module.bs> file if it exists
+(typically used to add to @dl_resolve_using any files which
+are required to load the module on the current platform)
+
+=item *
+
+calls dl_load_flags() to determine how to load the file.
+
+=item *
+
+calls dl_load_file() to load the file
+
+=item *
+
+calls dl_undef_symbols() and warns if any symbols are undefined
+
+=item *
+
+calls dl_find_symbol() for "boot_$module"
+
+=item *
+
+calls dl_install_xsub() to install it as "${module}::bootstrap"
+
+=item *
+
+calls &{"${module}::bootstrap"} to bootstrap the module (actually
+it uses the function reference returned by dl_install_xsub for speed)
+
+=back
+
+=back
+
+
+=head1 AUTHOR
+
+Tim Bunce, 11 August 1994.
+
+This interface is based on the work and comments of (in no particular
+order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno
+Siegel, Thomas Neumann, Paul Marquess, Charles Bailey, myself and others.
+
+Larry Wall designed the elegant inherited bootstrap mechanism and
+implemented the first Perl 5 dynamic loader using it.
+
+Solaris global loading added by Nick Ing-Simmons with design/coding
+assistance from Tim Bunce, January 1996.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/English.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/English.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/English.pm	(revision 14265)
@@ -0,0 +1,194 @@
+package English;
+
+require Exporter;
+@ISA = (Exporter);
+
+=head1 NAME
+
+English - use nice English (or awk) names for ugly punctuation variables
+
+=head1 SYNOPSIS
+
+    use English;
+    ...
+    if ($ERRNO =~ /denied/) { ... }
+
+=head1 DESCRIPTION
+
+This module provides aliases for the built-in variables whose
+names no one seems to like to read.  Variables with side-effects
+which get triggered just by accessing them (like $0) will still 
+be affected.
+
+For those variables that have an B<awk> version, both long
+and short English alternatives are provided.  For example, 
+the C<$/> variable can be referred to either $RS or 
+$INPUT_RECORD_SEPARATOR if you are using the English module.
+
+See L<perlvar> for a complete list of these.
+
+=head1 BUGS
+
+This module provokes sizeable inefficiencies for regular expressions,
+due to unfortunate implementation details.  If performance matters,
+consider avoiding English.
+
+=cut
+
+no warnings;
+
+# Grandfather $NAME import
+sub import {
+    my $this = shift;
+    my @list = @_;
+    local $Exporter::ExportLevel = 1;
+    Exporter::import($this,grep {s/^\$/*/} @list);
+}
+
+@EXPORT = qw(
+	*ARG
+	*MATCH
+	*PREMATCH
+	*POSTMATCH
+	*LAST_PAREN_MATCH
+	*INPUT_LINE_NUMBER
+	*NR
+	*INPUT_RECORD_SEPARATOR
+	*RS
+	*OUTPUT_AUTOFLUSH
+	*OUTPUT_FIELD_SEPARATOR
+	*OFS
+	*OUTPUT_RECORD_SEPARATOR
+	*ORS
+	*LIST_SEPARATOR
+	*SUBSCRIPT_SEPARATOR
+	*SUBSEP
+	*FORMAT_PAGE_NUMBER
+	*FORMAT_LINES_PER_PAGE
+	*FORMAT_LINES_LEFT
+	*FORMAT_NAME
+	*FORMAT_TOP_NAME
+	*FORMAT_LINE_BREAK_CHARACTERS
+	*FORMAT_FORMFEED
+	*CHILD_ERROR
+	*OS_ERROR
+	*ERRNO
+	*EXTENDED_OS_ERROR
+	*EVAL_ERROR
+	*PROCESS_ID
+	*PID
+	*REAL_USER_ID
+	*UID
+	*EFFECTIVE_USER_ID
+	*EUID
+	*REAL_GROUP_ID
+	*GID
+	*EFFECTIVE_GROUP_ID
+	*EGID
+	*PROGRAM_NAME
+	*PERL_VERSION
+	*ACCUMULATOR
+	*DEBUGGING
+	*SYSTEM_FD_MAX
+	*INPLACE_EDIT
+	*PERLDB
+	*BASETIME
+	*WARNING
+	*EXECUTABLE_NAME
+	*OSNAME
+	*LAST_REGEXP_CODE_RESULT
+	*EXCEPTIONS_BEING_CAUGHT
+	@LAST_MATCH_START
+	@LAST_MATCH_END
+);
+
+# The ground of all being. @ARG is deprecated (5.005 makes @_ lexical)
+
+	*ARG					= *_	;
+
+# Matching.
+
+	*MATCH					= *&	;
+	*PREMATCH				= *`	;
+	*POSTMATCH				= *'	;
+	*LAST_PAREN_MATCH			= *+	;
+	*LAST_MATCH_START			= *-{ARRAY} ;
+	*LAST_MATCH_END				= *+{ARRAY} ;
+
+# Input.
+
+	*INPUT_LINE_NUMBER			= *.	;
+	    *NR					= *.	;
+	*INPUT_RECORD_SEPARATOR			= */	;
+	    *RS					= */	;
+
+# Output.
+
+	*OUTPUT_AUTOFLUSH			= *|	;
+	*OUTPUT_FIELD_SEPARATOR			= *,	;
+	    *OFS				= *,	;
+	*OUTPUT_RECORD_SEPARATOR		= *\	;
+	    *ORS				= *\	;
+
+# Interpolation "constants".
+
+	*LIST_SEPARATOR				= *"	;
+	*SUBSCRIPT_SEPARATOR			= *;	;
+	    *SUBSEP				= *;	;
+
+# Formats
+
+	*FORMAT_PAGE_NUMBER			= *%	;
+	*FORMAT_LINES_PER_PAGE			= *=	;
+	*FORMAT_LINES_LEFT			= *-	;
+	*FORMAT_NAME				= *~	;
+	*FORMAT_TOP_NAME			= *^	;
+	*FORMAT_LINE_BREAK_CHARACTERS		= *:	;
+	*FORMAT_FORMFEED			= *^L	;
+
+# Error status.
+
+	*CHILD_ERROR				= *?	;
+	*OS_ERROR				= *!	;
+	    *ERRNO				= *!	;
+	*EXTENDED_OS_ERROR			= *^E	;
+	*EVAL_ERROR				= *@	;
+
+# Process info.
+
+	*PROCESS_ID				= *$	;
+	    *PID				= *$	;
+	*REAL_USER_ID				= *<	;
+	    *UID				= *<	;
+	*EFFECTIVE_USER_ID			= *>	;
+	    *EUID				= *>	;
+	*REAL_GROUP_ID				= *(	;
+	    *GID				= *(	;
+	*EFFECTIVE_GROUP_ID			= *)	;
+	    *EGID				= *)	;
+	*PROGRAM_NAME				= *0	;
+
+# Internals.
+
+	*PERL_VERSION				= *^V	;
+	*ACCUMULATOR				= *^A	;
+	*COMPILING				= *^C	;
+	*DEBUGGING				= *^D	;
+	*SYSTEM_FD_MAX				= *^F	;
+	*INPLACE_EDIT				= *^I	;
+	*PERLDB					= *^P	;
+	*LAST_REGEXP_CODE_RESULT		= *^R	;
+	*EXCEPTIONS_BEING_CAUGHT		= *^S	;
+	*BASETIME				= *^T	;
+	*WARNING				= *^W	;
+	*EXECUTABLE_NAME			= *^X	;
+	*OSNAME					= *^O	;
+
+# Deprecated.
+
+#	*ARRAY_BASE				= *[	;
+#	*OFMT					= *#	;
+#	*MULTILINE_MATCHING			= **	;
+#	*OLD_PERL_VERSION			= *]	;
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Env.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Env.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Env.pm	(revision 14265)
@@ -0,0 +1,233 @@
+package Env;
+
+=head1 NAME
+
+Env - perl module that imports environment variables as scalars or arrays
+
+=head1 SYNOPSIS
+
+    use Env;
+    use Env qw(PATH HOME TERM);
+    use Env qw($SHELL @LD_LIBRARY_PATH);
+
+=head1 DESCRIPTION
+
+Perl maintains environment variables in a special hash named C<%ENV>.  For
+when this access method is inconvenient, the Perl module C<Env> allows
+environment variables to be treated as scalar or array variables.
+
+The C<Env::import()> function ties environment variables with suitable
+names to global Perl variables with the same names.  By default it
+ties all existing environment variables (C<keys %ENV>) to scalars.  If
+the C<import> function receives arguments, it takes them to be a list of
+variables to tie; it's okay if they don't yet exist. The scalar type
+prefix '$' is inferred for any element of this list not prefixed by '$'
+or '@'. Arrays are implemented in terms of C<split> and C<join>, using
+C<$Config::Config{path_sep}> as the delimiter.
+
+After an environment variable is tied, merely use it like a normal variable.
+You may access its value 
+
+    @path = split(/:/, $PATH);
+    print join("\n", @LD_LIBRARY_PATH), "\n";
+
+or modify it
+
+    $PATH .= ":.";
+    push @LD_LIBRARY_PATH, $dir;
+
+however you'd like. Bear in mind, however, that each access to a tied array
+variable requires splitting the environment variable's string anew.
+
+The code:
+
+    use Env qw(@PATH);
+    push @PATH, '.';
+
+is equivalent to:
+
+    use Env qw(PATH);
+    $PATH .= ":.";
+
+except that if C<$ENV{PATH}> started out empty, the second approach leaves
+it with the (odd) value "C<:.>", but the first approach leaves it with "C<.>".
+
+To remove a tied environment variable from
+the environment, assign it the undefined value
+
+    undef $PATH;
+    undef @LD_LIBRARY_PATH;
+
+=head1 LIMITATIONS
+
+On VMS systems, arrays tied to environment variables are read-only. Attempting
+to change anything will cause a warning.
+
+=head1 AUTHOR
+
+Chip Salzenberg E<lt>F<chip@fin.uucp>E<gt>
+and
+Gregor N. Purdy E<lt>F<gregor@focusresearch.com>E<gt>
+
+=cut
+
+sub import {
+    my ($callpack) = caller(0);
+    my $pack = shift;
+    my @vars = grep /^[\$\@]?[A-Za-z_]\w*$/, (@_ ? @_ : keys(%ENV));
+    return unless @vars;
+
+    @vars = map { m/^[\$\@]/ ? $_ : '$'.$_ } @vars;
+
+    eval "package $callpack; use vars qw(" . join(' ', @vars) . ")";
+    die $@ if $@;
+    foreach (@vars) {
+	my ($type, $name) = m/^([\$\@])(.*)$/;
+	if ($type eq '$') {
+	    tie ${"${callpack}::$name"}, Env, $name;
+	} else {
+	    if ($^O eq 'VMS') {
+		tie @{"${callpack}::$name"}, Env::Array::VMS, $name;
+	    } else {
+		tie @{"${callpack}::$name"}, Env::Array, $name;
+	    }
+	}
+    }
+}
+
+sub TIESCALAR {
+    bless \($_[1]);
+}
+
+sub FETCH {
+    my ($self) = @_;
+    $ENV{$$self};
+}
+
+sub STORE {
+    my ($self, $value) = @_;
+    if (defined($value)) {
+	$ENV{$$self} = $value;
+    } else {
+	delete $ENV{$$self};
+    }
+}
+
+######################################################################
+
+package Env::Array;
+ 
+use Config;
+use Tie::Array;
+
+@ISA = qw(Tie::Array);
+
+my $sep = $Config::Config{path_sep};
+
+sub TIEARRAY {
+    bless \($_[1]);
+}
+
+sub FETCHSIZE {
+    my ($self) = @_;
+    my @temp = split($sep, $ENV{$$self});
+    return scalar(@temp);
+}
+
+sub STORESIZE {
+    my ($self, $size) = @_;
+    my @temp = split($sep, $ENV{$$self});
+    $#temp = $size - 1;
+    $ENV{$$self} = join($sep, @temp);
+}
+
+sub CLEAR {
+    my ($self) = @_;
+    $ENV{$$self} = '';
+}
+
+sub FETCH {
+    my ($self, $index) = @_;
+    return (split($sep, $ENV{$$self}))[$index];
+}
+
+sub STORE {
+    my ($self, $index, $value) = @_;
+    my @temp = split($sep, $ENV{$$self});
+    $temp[$index] = $value;
+    $ENV{$$self} = join($sep, @temp);
+    return $value;
+}
+
+sub PUSH {
+    my $self = shift;
+    my @temp = split($sep, $ENV{$$self});
+    push @temp, @_;
+    $ENV{$$self} = join($sep, @temp);
+    return scalar(@temp);
+}
+
+sub POP {
+    my ($self) = @_;
+    my @temp = split($sep, $ENV{$$self});
+    my $result = pop @temp;
+    $ENV{$$self} = join($sep, @temp);
+    return $result;
+}
+
+sub UNSHIFT {
+    my $self = shift;
+    my @temp = split($sep, $ENV{$$self});
+    my $result = unshift @temp, @_;
+    $ENV{$$self} = join($sep, @temp);
+    return $result;
+}
+
+sub SHIFT {
+    my ($self) = @_;
+    my @temp = split($sep, $ENV{$$self});
+    my $result = shift @temp;
+    $ENV{$$self} = join($sep, @temp);
+    return $result;
+}
+
+sub SPLICE {
+    my $self = shift;
+    my $offset = shift;
+    my $length = shift;
+    my @temp = split($sep, $ENV{$$self});
+    if (wantarray) {
+	my @result = splice @temp, $self, $offset, $length, @_;
+	$ENV{$$self} = join($sep, @temp);
+	return @result;
+    } else {
+	my $result = scalar splice @temp, $offset, $length, @_;
+	$ENV{$$self} = join($sep, @temp);
+	return $result;
+    }
+}
+
+######################################################################
+
+package Env::Array::VMS;
+use Tie::Array;
+
+@ISA = qw(Tie::Array);
+ 
+sub TIEARRAY {
+    bless \($_[1]);
+}
+
+sub FETCHSIZE {
+    my ($self) = @_;
+    my $i = 0;
+    while ($i < 127 and defined $ENV{$$self . ';' . $i}) { $i++; };
+    return $i;
+}
+
+sub FETCH {
+    my ($self, $index) = @_;
+    return $ENV{$$self . ';' . $index};
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Errno.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Errno.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Errno.pm	(revision 14265)
@@ -0,0 +1,172 @@
+#
+# This file is auto-generated. ***ANY*** changes here will be lost
+#
+
+package Errno;
+use vars qw(@EXPORT_OK %EXPORT_TAGS @ISA $VERSION %errno $AUTOLOAD);
+use Exporter ();
+use Config;
+use strict;
+
+"$Config{'archname'}-$Config{'osvers'}" eq
+"MSWin32-x86-multi-thread-4.0" or
+	die "Errno architecture (MSWin32-x86-multi-thread-4.0) does not match executable architecture ($Config{'archname'}-$Config{'osvers'})";
+
+$VERSION = "1.111";
+@ISA = qw(Exporter);
+
+@EXPORT_OK = qw(ENFILE EACCES EPERM EPIPE ERANGE ENOSPC ESPIPE
+	EDEADLOCK ENOMEM ENOTTY ENOSYS EAGAIN EXDEV ECHILD ENOTDIR ESRCH
+	EISDIR EROFS EEXIST ENODEV EBADF EMLINK EINVAL ENOLCK ENXIO
+	ENAMETOOLONG E2BIG EBUSY ENOENT EINTR ENOTEMPTY EDOM EDEADLK EIO
+	EFAULT EFBIG ENOEXEC EMFILE EILSEQ);
+
+%EXPORT_TAGS = (
+    POSIX => [qw(
+	E2BIG EACCES EAGAIN EBADF EBUSY ECHILD EDEADLK EDOM EEXIST EFAULT
+	EFBIG EINTR EINVAL EIO EISDIR EMFILE EMLINK ENAMETOOLONG ENFILE ENODEV
+	ENOENT ENOEXEC ENOLCK ENOMEM ENOSPC ENOSYS ENOTDIR ENOTEMPTY ENOTTY
+	ENXIO EPERM EPIPE ERANGE EROFS ESPIPE ESRCH EXDEV
+    )]
+);
+
+sub EPERM () { 1 }
+sub ENOENT () { 2 }
+sub ESRCH () { 3 }
+sub EINTR () { 4 }
+sub EIO () { 5 }
+sub ENXIO () { 6 }
+sub E2BIG () { 7 }
+sub ENOEXEC () { 8 }
+sub EBADF () { 9 }
+sub ECHILD () { 10 }
+sub EAGAIN () { 11 }
+sub ENOMEM () { 12 }
+sub EACCES () { 13 }
+sub EFAULT () { 14 }
+sub EBUSY () { 16 }
+sub EEXIST () { 17 }
+sub EXDEV () { 18 }
+sub ENODEV () { 19 }
+sub ENOTDIR () { 20 }
+sub EISDIR () { 21 }
+sub EINVAL () { 22 }
+sub ENFILE () { 23 }
+sub EMFILE () { 24 }
+sub ENOTTY () { 25 }
+sub EFBIG () { 27 }
+sub ENOSPC () { 28 }
+sub ESPIPE () { 29 }
+sub EROFS () { 30 }
+sub EMLINK () { 31 }
+sub EPIPE () { 32 }
+sub EDOM () { 33 }
+sub ERANGE () { 34 }
+sub EDEADLK () { 36 }
+sub EDEADLOCK () { 36 }
+sub ENAMETOOLONG () { 38 }
+sub ENOLCK () { 39 }
+sub ENOSYS () { 40 }
+sub ENOTEMPTY () { 41 }
+sub EILSEQ () { 42 }
+
+sub TIEHASH { bless [] }
+
+sub FETCH {
+    my ($self, $errname) = @_;
+    my $proto = prototype("Errno::$errname");
+    my $errno = "";
+    if (defined($proto) && $proto eq "") {
+	no strict 'refs';
+	$errno = &$errname;
+        $errno = 0 unless $! == $errno;
+    }
+    return $errno;
+}
+
+sub STORE {
+    require Carp;
+    Carp::confess("ERRNO hash is read only!");
+}
+
+*CLEAR = \&STORE;
+*DELETE = \&STORE;
+
+sub NEXTKEY {
+    my($k,$v);
+    while(($k,$v) = each %Errno::) {
+	my $proto = prototype("Errno::$k");
+	last if (defined($proto) && $proto eq "");
+    }
+    $k
+}
+
+sub FIRSTKEY {
+    my $s = scalar keys %Errno::;	# initialize iterator
+    goto &NEXTKEY;
+}
+
+sub EXISTS {
+    my ($self, $errname) = @_;
+    my $proto = prototype($errname);
+    defined($proto) && $proto eq "";
+}
+
+tie %!, __PACKAGE__;
+
+1;
+__END__
+
+=head1 NAME
+
+Errno - System errno constants
+
+=head1 SYNOPSIS
+
+    use Errno qw(EINTR EIO :POSIX);
+
+=head1 DESCRIPTION
+
+C<Errno> defines and conditionally exports all the error constants
+defined in your system C<errno.h> include file. It has a single export
+tag, C<:POSIX>, which will export all POSIX defined error numbers.
+
+C<Errno> also makes C<%!> magic such that each element of C<%!> has a
+non-zero value only if C<$!> is set to that value. For example:
+
+    use Errno;
+
+    unless (open(FH, "/fangorn/spouse")) {
+        if ($!{ENOENT}) {
+            warn "Get a wife!\n";
+        } else {
+            warn "This path is barred: $!";
+        } 
+    } 
+
+If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
+returns C<"">.  You may use C<exists $!{EFOO}> to check whether the
+constant is available on the system.
+
+=head1 CAVEATS
+
+Importing a particular constant may not be very portable, because the
+import will fail on platforms that do not have that constant.  A more
+portable way to set C<$!> to a valid value is to use:
+
+    if (exists &Errno::EFOO) {
+        $! = &Errno::EFOO;
+    }
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997-8 Graham Barr. All rights reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
Index: /for-distributions/trunk/bin/windows/perl/lib/Exporter.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Exporter.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Exporter.pm	(revision 14265)
@@ -0,0 +1,313 @@
+package Exporter;
+
+require 5.001;
+
+$ExportLevel = 0;
+$Verbose ||= 0;
+$VERSION = '5.562';
+
+sub export_to_level {
+  require Exporter::Heavy;
+  goto &heavy_export_to_level;
+}
+
+sub export {
+  require Exporter::Heavy;
+  goto &heavy_export;
+}
+
+sub export_tags {
+  require Exporter::Heavy;
+  _push_tags((caller)[0], "EXPORT",    \@_);
+}
+
+sub export_ok_tags {
+  require Exporter::Heavy;
+  _push_tags((caller)[0], "EXPORT_OK", \@_);
+}
+
+sub import {
+  my $pkg = shift;
+  my $callpkg = caller($ExportLevel);
+  *exports = *{"$pkg\::EXPORT"};
+  # We *need* to treat @{"$pkg\::EXPORT_FAIL"} since Carp uses it :-(
+  *fail = *{"$pkg\::EXPORT_FAIL"};
+  return export $pkg, $callpkg, @_
+    if $Verbose or $Debug or @fail > 1;
+  my $args = @_ or @_ = @exports;
+  
+  if ($args and not %exports) {
+    foreach my $sym (@exports, @{"$pkg\::EXPORT_OK"}) {
+      $sym =~ s/^&//;
+      $exports{$sym} = 1;
+    }
+  }
+  if ($Verbose or $Debug 
+      or grep {/\W/ or $args and not exists $exports{$_}
+	       or @fail and $_ eq $fail[0]
+	       or (@{"$pkg\::EXPORT_OK"} 
+		   and $_ eq ${"$pkg\::EXPORT_OK"}[0])} @_) {
+    return export $pkg, $callpkg, ($args ? @_ : ());
+  }
+  #local $SIG{__WARN__} = sub {require Carp; goto &Carp::carp};
+  local $SIG{__WARN__} = 
+	sub {require Carp; local $Carp::CarpLevel = 1; &Carp::carp};
+  foreach $sym (@_) {
+    # shortcut for the common case of no type character
+    *{"$callpkg\::$sym"} = \&{"$pkg\::$sym"};
+  }
+}
+
+1;
+
+# A simple self test harness. Change 'require Carp' to 'use Carp ()' for testing.
+# package main; eval(join('',<DATA>)) or die $@ unless caller;
+__END__
+package Test;
+$INC{'Exporter.pm'} = 1;
+@ISA = qw(Exporter);
+@EXPORT      = qw(A1 A2 A3 A4 A5);
+@EXPORT_OK   = qw(B1 B2 B3 B4 B5);
+%EXPORT_TAGS = (T1=>[qw(A1 A2 B1 B2)], T2=>[qw(A1 A2 B3 B4)], T3=>[qw(X3)]);
+@EXPORT_FAIL = qw(B4);
+Exporter::export_ok_tags('T3', 'unknown_tag');
+sub export_fail {
+    map { "Test::$_" } @_	# edit symbols just as an example
+}
+
+package main;
+$Exporter::Verbose = 1;
+#import Test;
+#import Test qw(X3);		# export ok via export_ok_tags()
+#import Test qw(:T1 !A2 /5/ !/3/ B5);
+import Test qw(:T2 !B4);
+import Test qw(:T2);		# should fail
+1;
+
+=head1 NAME
+
+Exporter - Implements default import method for modules
+
+=head1 SYNOPSIS
+
+In module ModuleName.pm:
+
+  package ModuleName;
+  require Exporter;
+  @ISA = qw(Exporter);
+
+  @EXPORT = qw(...);            # symbols to export by default
+  @EXPORT_OK = qw(...);         # symbols to export on request
+  %EXPORT_TAGS = tag => [...];  # define names for sets of symbols
+
+In other files which wish to use ModuleName:
+
+  use ModuleName;               # import default symbols into my package
+
+  use ModuleName qw(...);       # import listed symbols into my package
+
+  use ModuleName ();            # do not import any symbols
+
+=head1 DESCRIPTION
+
+The Exporter module implements a default C<import> method which
+many modules choose to inherit rather than implement their own.
+
+Perl automatically calls the C<import> method when processing a
+C<use> statement for a module. Modules and C<use> are documented
+in L<perlfunc> and L<perlmod>. Understanding the concept of
+modules and how the C<use> statement operates is important to
+understanding the Exporter.
+
+=head2 How to Export
+
+The arrays C<@EXPORT> and C<@EXPORT_OK> in a module hold lists of
+symbols that are going to be exported into the users name space by
+default, or which they can request to be exported, respectively.  The
+symbols can represent functions, scalars, arrays, hashes, or typeglobs.
+The symbols must be given by full name with the exception that the
+ampersand in front of a function is optional, e.g.
+
+    @EXPORT    = qw(afunc $scalar @array);   # afunc is a function
+    @EXPORT_OK = qw(&bfunc %hash *typeglob); # explicit prefix on &bfunc
+
+=head2 Selecting What To Export
+
+Do B<not> export method names!
+
+Do B<not> export anything else by default without a good reason!
+
+Exports pollute the namespace of the module user.  If you must export
+try to use @EXPORT_OK in preference to @EXPORT and avoid short or
+common symbol names to reduce the risk of name clashes.
+
+Generally anything not exported is still accessible from outside the
+module using the ModuleName::item_name (or $blessed_ref-E<gt>method)
+syntax.  By convention you can use a leading underscore on names to
+informally indicate that they are 'internal' and not for public use.
+
+(It is actually possible to get private functions by saying:
+
+  my $subref = sub { ... };
+  &$subref;
+
+But there's no way to call that directly as a method, since a method
+must have a name in the symbol table.)
+
+As a general rule, if the module is trying to be object oriented
+then export nothing. If it's just a collection of functions then
+@EXPORT_OK anything but use @EXPORT with caution.
+
+Other module design guidelines can be found in L<perlmod>.
+
+=head2 Specialised Import Lists
+
+If the first entry in an import list begins with !, : or / then the
+list is treated as a series of specifications which either add to or
+delete from the list of names to import. They are processed left to
+right. Specifications are in the form:
+
+    [!]name         This name only
+    [!]:DEFAULT     All names in @EXPORT
+    [!]:tag         All names in $EXPORT_TAGS{tag} anonymous list
+    [!]/pattern/    All names in @EXPORT and @EXPORT_OK which match
+
+A leading ! indicates that matching names should be deleted from the
+list of names to import.  If the first specification is a deletion it
+is treated as though preceded by :DEFAULT. If you just want to import
+extra names in addition to the default set you will still need to
+include :DEFAULT explicitly.
+
+e.g., Module.pm defines:
+
+    @EXPORT      = qw(A1 A2 A3 A4 A5);
+    @EXPORT_OK   = qw(B1 B2 B3 B4 B5);
+    %EXPORT_TAGS = (T1 => [qw(A1 A2 B1 B2)], T2 => [qw(A1 A2 B3 B4)]);
+
+    Note that you cannot use tags in @EXPORT or @EXPORT_OK.
+    Names in EXPORT_TAGS must also appear in @EXPORT or @EXPORT_OK.
+
+An application using Module can say something like:
+
+    use Module qw(:DEFAULT :T2 !B3 A3);
+
+Other examples include:
+
+    use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET);
+    use POSIX  qw(:errno_h :termios_h !TCSADRAIN !/^EXIT/);
+
+Remember that most patterns (using //) will need to be anchored
+with a leading ^, e.g., C</^EXIT/> rather than C</EXIT/>.
+
+You can say C<BEGIN { $Exporter::Verbose=1 }> to see how the
+specifications are being processed and what is actually being imported
+into modules.
+
+=head2 Exporting without using Export's import method
+
+Exporter has a special method, 'export_to_level' which is used in situations
+where you can't directly call Export's import method. The export_to_level
+method looks like:
+
+MyPackage->export_to_level($where_to_export, $package, @what_to_export);
+
+where $where_to_export is an integer telling how far up the calling stack
+to export your symbols, and @what_to_export is an array telling what
+symbols *to* export (usually this is @_).  The $package argument is
+currently unused.
+
+For example, suppose that you have a module, A, which already has an
+import function:
+
+package A;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw ($b);
+
+sub import
+{
+    $A::b = 1;     # not a very useful import method
+}
+
+and you want to Export symbol $A::b back to the module that called 
+package A. Since Exporter relies on the import method to work, via 
+inheritance, as it stands Exporter::import() will never get called. 
+Instead, say the following:
+
+package A;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw ($b);
+
+sub import
+{
+    $A::b = 1;
+    A->export_to_level(1, @_);
+}
+
+This will export the symbols one level 'above' the current package - ie: to 
+the program or module that used package A. 
+
+Note: Be careful not to modify '@_' at all before you call export_to_level
+- or people using your package will get very unexplained results!
+
+
+=head2 Module Version Checking
+
+The Exporter module will convert an attempt to import a number from a
+module into a call to $module_name-E<gt>require_version($value). This can
+be used to validate that the version of the module being used is
+greater than or equal to the required version.
+
+The Exporter module supplies a default require_version method which
+checks the value of $VERSION in the exporting module.
+
+Since the default require_version method treats the $VERSION number as
+a simple numeric value it will regard version 1.10 as lower than
+1.9. For this reason it is strongly recommended that you use numbers
+with at least two decimal places, e.g., 1.09.
+
+=head2 Managing Unknown Symbols
+
+In some situations you may want to prevent certain symbols from being
+exported. Typically this applies to extensions which have functions
+or constants that may not exist on some systems.
+
+The names of any symbols that cannot be exported should be listed
+in the C<@EXPORT_FAIL> array.
+
+If a module attempts to import any of these symbols the Exporter
+will give the module an opportunity to handle the situation before
+generating an error. The Exporter will call an export_fail method
+with a list of the failed symbols:
+
+  @failed_symbols = $module_name->export_fail(@failed_symbols);
+
+If the export_fail method returns an empty list then no error is
+recorded and all the requested symbols are exported. If the returned
+list is not empty then an error is generated for each symbol and the
+export fails. The Exporter provides a default export_fail method which
+simply returns the list unchanged.
+
+Uses for the export_fail method include giving better error messages
+for some symbols and performing lazy architectural checks (put more
+symbols into @EXPORT_FAIL by default and then take them out if someone
+actually tries to use them and an expensive check shows that they are
+usable on that platform).
+
+=head2 Tag Handling Utility Functions
+
+Since the symbols listed within %EXPORT_TAGS must also appear in either
+@EXPORT or @EXPORT_OK, two utility functions are provided which allow
+you to easily add tagged sets of symbols to @EXPORT or @EXPORT_OK:
+
+  %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]);
+
+  Exporter::export_tags('foo');     # add aa, bb and cc to @EXPORT
+  Exporter::export_ok_tags('bar');  # add aa, cc and dd to @EXPORT_OK
+
+Any names which are not tags are added to @EXPORT or @EXPORT_OK
+unchanged but will trigger a warning (with C<-w>) to avoid misspelt tags
+names being silently added to @EXPORT or @EXPORT_OK. Future versions
+may make this a fatal error.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/Exporter/Heavy.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Exporter/Heavy.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Exporter/Heavy.pm	(revision 14265)
@@ -0,0 +1,225 @@
+package Exporter;
+
+=head1 NAME
+
+Exporter::Heavy - Exporter guts
+
+=head1 SYNOPIS
+
+(internal use only)
+
+=head1 DESCRIPTION
+
+No user-serviceable parts inside.
+
+=cut
+#
+# We go to a lot of trouble not to 'require Carp' at file scope,
+#  because Carp requires Exporter, and something has to give.
+#
+
+sub heavy_export {
+
+    # First make import warnings look like they're coming from the "use".
+    local $SIG{__WARN__} = sub {
+	my $text = shift;
+	if ($text =~ s/ at \S*Exporter\S*.pm line \d+.*\n//) {
+	    require Carp;
+	    local $Carp::CarpLevel = 1;	# ignore package calling us too.
+	    Carp::carp($text);
+	}
+	else {
+	    warn $text;
+	}
+    };
+    local $SIG{__DIE__} = sub {
+	require Carp;
+	local $Carp::CarpLevel = 1;	# ignore package calling us too.
+	Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")
+	    if $_[0] =~ /^Unable to create sub named "(.*?)::"/;
+    };
+
+    my($pkg, $callpkg, @imports) = @_;
+    my($type, $sym, $oops);
+    *exports = *{"${pkg}::EXPORT"};
+
+    if (@imports) {
+	if (!%exports) {
+	    grep(s/^&//, @exports);
+	    @exports{@exports} = (1) x @exports;
+	    my $ok = \@{"${pkg}::EXPORT_OK"};
+	    if (@$ok) {
+		grep(s/^&//, @$ok);
+		@exports{@$ok} = (1) x @$ok;
+	    }
+	}
+
+	if ($imports[0] =~ m#^[/!:]#){
+	    my $tagsref = \%{"${pkg}::EXPORT_TAGS"};
+	    my $tagdata;
+	    my %imports;
+	    my($remove, $spec, @names, @allexports);
+	    # negated first item implies starting with default set:
+	    unshift @imports, ':DEFAULT' if $imports[0] =~ m/^!/;
+	    foreach $spec (@imports){
+		$remove = $spec =~ s/^!//;
+
+		if ($spec =~ s/^://){
+		    if ($spec eq 'DEFAULT'){
+			@names = @exports;
+		    }
+		    elsif ($tagdata = $tagsref->{$spec}) {
+			@names = @$tagdata;
+		    }
+		    else {
+			warn qq["$spec" is not defined in %${pkg}::EXPORT_TAGS];
+			++$oops;
+			next;
+		    }
+		}
+		elsif ($spec =~ m:^/(.*)/$:){
+		    my $patn = $1;
+		    @allexports = keys %exports unless @allexports; # only do keys once
+		    @names = grep(/$patn/, @allexports); # not anchored by default
+		}
+		else {
+		    @names = ($spec); # is a normal symbol name
+		}
+
+		warn "Import ".($remove ? "del":"add").": @names "
+		    if $Verbose;
+
+		if ($remove) {
+		   foreach $sym (@names) { delete $imports{$sym} } 
+		}
+		else {
+		    @imports{@names} = (1) x @names;
+		}
+	    }
+	    @imports = keys %imports;
+	}
+
+	foreach $sym (@imports) {
+	    if (!$exports{$sym}) {
+		if ($sym =~ m/^\d/) {
+		    $pkg->require_version($sym);
+		    # If the version number was the only thing specified
+		    # then we should act as if nothing was specified:
+		    if (@imports == 1) {
+			@imports = @exports;
+			last;
+		    }
+		    # We need a way to emulate 'use Foo ()' but still
+		    # allow an easy version check: "use Foo 1.23, ''";
+		    if (@imports == 2 and !$imports[1]) {
+			@imports = ();
+			last;
+		    }
+		} elsif ($sym !~ s/^&// || !$exports{$sym}) {
+                    require Carp;
+		    Carp::carp(qq["$sym" is not exported by the $pkg module]);
+		    $oops++;
+		}
+	    }
+	}
+	if ($oops) {
+	    require Carp;
+	    Carp::croak("Can't continue after import errors");
+	}
+    }
+    else {
+	@imports = @exports;
+    }
+
+    *fail = *{"${pkg}::EXPORT_FAIL"};
+    if (@fail) {
+	if (!%fail) {
+	    # Build cache of symbols. Optimise the lookup by adding
+	    # barewords twice... both with and without a leading &.
+	    # (Technique could be applied to %exports cache at cost of memory)
+	    my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @fail;
+	    warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Verbose;
+	    @fail{@expanded} = (1) x @expanded;
+	}
+	my @failed;
+	foreach $sym (@imports) { push(@failed, $sym) if $fail{$sym} }
+	if (@failed) {
+	    @failed = $pkg->export_fail(@failed);
+	    foreach $sym (@failed) {
+                require Carp;
+		Carp::carp(qq["$sym" is not implemented by the $pkg module ],
+			"on this architecture");
+	    }
+	    if (@failed) {
+		require Carp;
+		Carp::croak("Can't continue after import errors");
+	    }
+	}
+    }
+
+    warn "Importing into $callpkg from $pkg: ",
+		join(", ",sort @imports) if $Verbose;
+
+    foreach $sym (@imports) {
+	# shortcut for the common case of no type character
+	(*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
+	    unless $sym =~ s/^(\W)//;
+	$type = $1;
+	*{"${callpkg}::$sym"} =
+	    $type eq '&' ? \&{"${pkg}::$sym"} :
+	    $type eq '$' ? \${"${pkg}::$sym"} :
+	    $type eq '@' ? \@{"${pkg}::$sym"} :
+	    $type eq '%' ? \%{"${pkg}::$sym"} :
+	    $type eq '*' ?  *{"${pkg}::$sym"} :
+	    do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
+    }
+}
+
+sub heavy_export_to_level
+{
+      my $pkg = shift;
+      my $level = shift;
+      (undef) = shift;			# XXX redundant arg
+      my $callpkg = caller($level);
+      $pkg->export($callpkg, @_);
+}
+
+# Utility functions
+
+sub _push_tags {
+    my($pkg, $var, $syms) = @_;
+    my $nontag;
+    *export_tags = \%{"${pkg}::EXPORT_TAGS"};
+    push(@{"${pkg}::$var"},
+	map { $export_tags{$_} ? @{$export_tags{$_}} : scalar(++$nontag,$_) }
+		(@$syms) ? @$syms : keys %export_tags);
+    if ($nontag and $^W) {
+	# This may change to a die one day
+	require Carp;
+	Carp::carp("Some names are not tags");
+    }
+}
+
+# Default methods
+
+sub export_fail {
+    my $self = shift;
+    @_;
+}
+
+sub require_version {
+    my($self, $wanted) = @_;
+    my $pkg = ref $self || $self;
+    my $version = ${"${pkg}::VERSION"};
+    if (!$version or $version < $wanted) {
+	$version ||= "(undef)";
+	    # %INC contains slashes, but $pkg contains double-colons.
+	my $file = (map {s,::,/,g; $INC{$_}} "$pkg.pm")[0];
+	$file &&= " ($file)";
+	require Carp;
+	Carp::croak("$pkg $wanted required--this is only version $version$file")
+    }
+    $version;
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Fatal.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Fatal.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Fatal.pm	(revision 14265)
@@ -0,0 +1,186 @@
+package Fatal;
+
+use 5.005_64;
+use Carp;
+use strict;
+our($AUTOLOAD, $Debug, $VERSION);
+
+$VERSION = 1.02;
+
+$Debug = 0 unless defined $Debug;
+
+sub import {
+    my $self = shift(@_);
+    my($sym, $pkg);
+    my $void = 0;
+    $pkg = (caller)[0];
+    foreach $sym (@_) {
+	if ($sym eq ":void") {
+	    $void = 1;
+	}
+	else {
+	    &_make_fatal($sym, $pkg, $void);
+	}
+    }
+};
+
+sub AUTOLOAD {
+    my $cmd = $AUTOLOAD;
+    $cmd =~ s/.*:://;
+    &_make_fatal($cmd, (caller)[0]);
+    goto &$AUTOLOAD;
+}
+
+sub fill_protos {
+  my $proto = shift;
+  my ($n, $isref, @out, @out1, $seen_semi) = -1;
+  while ($proto =~ /\S/) {
+    $n++;
+    push(@out1,[$n,@out]) if $seen_semi;
+    push(@out, $1 . "{\$_[$n]}"), next if $proto =~ s/^\s*\\([\@%\$\&])//;
+    push(@out, "\$_[$n]"), next if $proto =~ s/^\s*([*\$&])//;
+    push(@out, "\@_[$n..\$#_]"), last if $proto =~ s/^\s*(;\s*)?\@//;
+    $seen_semi = 1, $n--, next if $proto =~ s/^\s*;//; # XXXX ????
+    die "Unknown prototype letters: \"$proto\"";
+  }
+  push(@out1,[$n+1,@out]);
+  @out1;
+}
+
+sub write_invocation {
+  my ($core, $call, $name, $void, @argvs) = @_;
+  if (@argvs == 1) {		# No optional arguments
+    my @argv = @{$argvs[0]};
+    shift @argv;
+    return "\t" . one_invocation($core, $call, $name, $void, @argv) . ";\n";
+  } else {
+    my $else = "\t";
+    my (@out, @argv, $n);
+    while (@argvs) {
+      @argv = @{shift @argvs};
+      $n = shift @argv;
+      push @out, "$ {else}if (\@_ == $n) {\n";
+      $else = "\t} els";
+      push @out, 
+          "\t\treturn " . one_invocation($core, $call, $name, $void, @argv) . ";\n";
+    }
+    push @out, <<EOC;
+	}
+	die "$name(\@_): Do not expect to get ", scalar \@_, " arguments";
+EOC
+    return join '', @out;
+  }
+}
+
+sub one_invocation {
+  my ($core, $call, $name, $void, @argv) = @_;
+  local $" = ', ';
+  if ($void) { 
+    return qq/(defined wantarray)?$call(@argv):
+              $call(@argv) || croak "Can't $name(\@_)/ . 
+           ($core ? ': $!' : ', \$! is \"$!\"') . '"'
+  } else {
+    return qq{$call(@argv) || croak "Can't $name(\@_)} . 
+           ($core ? ': $!' : ', \$! is \"$!\"') . '"';
+  }
+}
+
+sub _make_fatal {
+    my($sub, $pkg, $void) = @_;
+    my($name, $code, $sref, $real_proto, $proto, $core, $call);
+    my $ini = $sub;
+
+    $sub = "${pkg}::$sub" unless $sub =~ /::/;
+    $name = $sub;
+    $name =~ s/.*::// or $name =~ s/^&//;
+    print "# _make_fatal: sub=$sub pkg=$pkg name=$name void=$void\n" if $Debug;
+    croak "Bad subroutine name for Fatal: $name" unless $name =~ /^\w+$/;
+    if (defined(&$sub)) {	# user subroutine
+	$sref = \&$sub;
+	$proto = prototype $sref;
+	$call = '&$sref';
+    } elsif ($sub eq $ini) {	# Stray user subroutine
+	die "$sub is not a Perl subroutine" 
+    } else {			# CORE subroutine
+        $proto = eval { prototype "CORE::$name" };
+	die "$name is neither a builtin, nor a Perl subroutine" 
+	  if $@;
+	die "Cannot make a non-overridable builtin fatal"
+	  if not defined $proto;
+	$core = 1;
+	$call = "CORE::$name";
+    }
+    if (defined $proto) {
+      $real_proto = " ($proto)";
+    } else {
+      $real_proto = '';
+      $proto = '@';
+    }
+    $code = <<EOS;
+sub$real_proto {
+	local(\$", \$!) = (', ', 0);
+EOS
+    my @protos = fill_protos($proto);
+    $code .= write_invocation($core, $call, $name, $void, @protos);
+    $code .= "}\n";
+    print $code if $Debug;
+    {
+      no strict 'refs'; # to avoid: Can't use string (...) as a symbol ref ...
+      $code = eval("package $pkg; use Carp; $code");
+      die if $@;
+      no warnings;   # to avoid: Subroutine foo redefined ...
+      *{$sub} = $code;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Fatal - replace functions with equivalents which succeed or die
+
+=head1 SYNOPSIS
+
+    use Fatal qw(open close);
+
+    sub juggle { . . . }
+    import Fatal 'juggle';
+
+=head1 DESCRIPTION
+
+C<Fatal> provides a way to conveniently replace functions which normally
+return a false value when they fail with equivalents which raise exceptions
+if they are not successful.  This lets you use these functions without
+having to test their return values explicitly on each call.  Exceptions
+can be caught using C<eval{}>.  See L<perlfunc> and L<perlvar> for details.
+
+The do-or-die equivalents are set up simply by calling Fatal's
+C<import> routine, passing it the names of the functions to be
+replaced.  You may wrap both user-defined functions and overridable
+CORE operators (except C<exec>, C<system> which cannot be expressed
+via prototypes) in this way.
+
+If the symbol C<:void> appears in the import list, then functions
+named later in that import list raise an exception only when
+these are called in void context--that is, when their return
+values are ignored.  For example
+
+	use Fatal qw/:void open close/;
+
+	# properly checked, so no exception raised on error
+	if(open(FH, "< /bogotic") {
+		warn "bogo file, dude: $!";
+	}
+
+	# not checked, so error raises an exception
+	close FH;
+
+=head1 AUTHOR
+
+Lionel.Cons@cern.ch
+
+prototype updates by Ilya Zakharevich ilya@math.ohio-state.edu
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/Fcntl.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Fcntl.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Fcntl.pm	(revision 14265)
@@ -0,0 +1,222 @@
+package Fcntl;
+
+=head1 NAME
+
+Fcntl - load the C Fcntl.h defines
+
+=head1 SYNOPSIS
+
+    use Fcntl;
+    use Fcntl qw(:DEFAULT :flock);
+
+=head1 DESCRIPTION
+
+This module is just a translation of the C F<fnctl.h> file.
+Unlike the old mechanism of requiring a translated F<fnctl.ph>
+file, this uses the B<h2xs> program (see the Perl source distribution)
+and your native C compiler.  This means that it has a 
+far more likely chance of getting the numbers right.
+
+=head1 NOTE
+
+Only C<#define> symbols get translated; you must still correctly
+pack up your own arguments to pass as args for locking functions, etc.
+
+=head1 EXPORTED SYMBOLS
+
+By default your system's F_* and O_* constants (eg, F_DUPFD and
+O_CREAT) and the FD_CLOEXEC constant are exported into your namespace.
+
+You can request that the flock() constants (LOCK_SH, LOCK_EX, LOCK_NB
+and LOCK_UN) be provided by using the tag C<:flock>.  See L<Exporter>.
+
+You can request that the old constants (FAPPEND, FASYNC, FCREAT,
+FDEFER, FEXCL, FNDELAY, FNONBLOCK, FSYNC, FTRUNC) be provided for
+compatibility reasons by using the tag C<:Fcompat>.  For new
+applications the newer versions of these constants are suggested
+(O_APPEND, O_ASYNC, O_CREAT, O_DEFER, O_EXCL, O_NDELAY, O_NONBLOCK,
+O_SYNC, O_TRUNC).
+
+For ease of use also the SEEK_* constants (for seek() and sysseek(),
+e.g. SEEK_END) and the S_I* constants (for chmod() and stat()) are
+available for import.  They can be imported either separately or using
+the tags C<:seek> and C<:mode>.
+
+Please refer to your native fcntl(2), open(2), fseek(3), lseek(2)
+(equal to Perl's seek() and sysseek(), respectively), and chmod(2)
+documentation to see what constants are implemented in your system.
+
+See L<perlopentut> to learn about the uses of the O_* constants
+with sysopen().
+
+See L<perlfunc/seek> and L<perlfunc/sysseek> about the SEEK_* constants.
+
+See L<perlfunc/stat> about the S_I* constants.
+
+=cut
+
+our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $AUTOLOAD);
+
+require Exporter;
+use XSLoader ();
+@ISA = qw(Exporter);
+$VERSION = "1.03";
+# Items to export into callers namespace by default
+# (move infrequently used names to @EXPORT_OK below)
+@EXPORT =
+  qw(
+	FD_CLOEXEC
+	F_ALLOCSP
+	F_ALLOCSP64
+	F_COMPAT
+	F_DUP2FD
+	F_DUPFD
+	F_EXLCK
+	F_FREESP
+	F_FREESP64
+	F_FSYNC
+	F_FSYNC64
+	F_GETFD
+	F_GETFL
+	F_GETLK
+	F_GETLK64
+	F_GETOWN
+	F_NODNY
+	F_POSIX
+	F_RDACC
+	F_RDDNY
+	F_RDLCK
+	F_RWACC
+	F_RWDNY
+	F_SETFD
+	F_SETFL
+	F_SETLK
+	F_SETLK64
+	F_SETLKW
+	F_SETLKW64
+	F_SETOWN
+	F_SHARE
+	F_SHLCK
+	F_UNLCK
+	F_UNSHARE
+	F_WRACC
+	F_WRDNY
+	F_WRLCK
+	O_ACCMODE
+	O_ALIAS
+	O_APPEND
+	O_ASYNC
+	O_BINARY
+	O_CREAT
+	O_DEFER
+	O_DIRECT
+	O_DIRECTORY
+	O_DSYNC
+	O_EXCL
+	O_EXLOCK
+	O_LARGEFILE
+	O_NDELAY
+	O_NOCTTY
+	O_NOFOLLOW
+	O_NOINHERIT
+	O_NONBLOCK
+	O_RANDOM
+	O_RAW
+	O_RDONLY
+	O_RDWR
+	O_RSRC
+	O_RSYNC
+	O_SEQUENTIAL
+	O_SHLOCK
+	O_SYNC
+	O_TEMPORARY
+	O_TEXT
+	O_TRUNC
+	O_WRONLY
+     );
+
+# Other items we are prepared to export if requested
+@EXPORT_OK = qw(
+	FAPPEND
+	FASYNC
+	FCREAT
+	FDEFER
+	FDSYNC
+	FEXCL
+	FLARGEFILE
+	FNDELAY
+	FNONBLOCK
+	FRSYNC
+	FSYNC
+	FTRUNC
+	LOCK_EX
+	LOCK_NB
+	LOCK_SH
+	LOCK_UN
+	S_ISUID S_ISGID S_ISVTX S_ISTXT
+	_S_IFMT S_IFREG S_IFDIR S_IFLNK
+	S_IFSOCK S_IFBLK S_IFCHR S_IFIFO S_IFWHT S_ENFMT
+	S_IRUSR S_IWUSR S_IXUSR S_IRWXU
+	S_IRGRP S_IWGRP S_IXGRP S_IRWXG
+	S_IROTH S_IWOTH S_IXOTH S_IRWXO
+	S_IREAD S_IWRITE S_IEXEC
+	&S_ISREG &S_ISDIR &S_ISLNK &S_ISSOCK &S_ISBLK &S_ISCHR &S_ISFIFO
+	&S_ISWHT &S_ISENFMT &S_IFMT &S_IMODE
+	SEEK_SET
+	SEEK_CUR
+	SEEK_END
+);
+# Named groups of exports
+%EXPORT_TAGS = (
+    'flock'   => [qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN)],
+    'Fcompat' => [qw(FAPPEND FASYNC FCREAT FDEFER FDSYNC FEXCL FLARGEFILE
+		     FNDELAY FNONBLOCK FRSYNC FSYNC FTRUNC)],
+    'seek'    => [qw(SEEK_SET SEEK_CUR SEEK_END)],
+    'mode'    => [qw(S_ISUID S_ISGID S_ISVTX S_ISTXT
+		     _S_IFMT S_IFREG S_IFDIR S_IFLNK
+		     S_IFSOCK S_IFBLK S_IFCHR S_IFIFO S_IFWHT S_ENFMT
+		     S_IRUSR S_IWUSR S_IXUSR S_IRWXU
+		     S_IRGRP S_IWGRP S_IXGRP S_IRWXG
+		     S_IROTH S_IWOTH S_IXOTH S_IRWXO
+		     S_IREAD S_IWRITE S_IEXEC
+		     S_ISREG S_ISDIR S_ISLNK S_ISSOCK
+		     S_ISBLK S_ISCHR S_ISFIFO
+		     S_ISWHT S_ISENFMT		
+		     S_IFMT S_IMODE
+                  )],
+);
+
+sub S_IFMT  { @_ ? ( $_[0] & _S_IFMT() ) : _S_IFMT()  }
+sub S_IMODE { $_[0] & 07777 }
+
+sub S_ISREG    { ( $_[0] & _S_IFMT() ) == S_IFREG()   }
+sub S_ISDIR    { ( $_[0] & _S_IFMT() ) == S_IFDIR()   }
+sub S_ISLNK    { ( $_[0] & _S_IFMT() ) == S_IFLNK()   }
+sub S_ISSOCK   { ( $_[0] & _S_IFMT() ) == S_IFSOCK()  }
+sub S_ISBLK    { ( $_[0] & _S_IFMT() ) == S_IFBLK()   }
+sub S_ISCHR    { ( $_[0] & _S_IFMT() ) == S_IFCHR()   }
+sub S_ISFIFO   { ( $_[0] & _S_IFMT() ) == S_IFIFO()   }
+sub S_ISWHT    { ( $_[0] & _S_IFMT() ) == S_IFWHT()   }
+sub S_ISENFMT  { ( $_[0] & _S_IFMT() ) == S_IFENFMT() }
+
+sub AUTOLOAD {
+    (my $constname = $AUTOLOAD) =~ s/.*:://;
+    my $val = constant($constname, 0);
+    if ($! != 0) {
+	if ($! =~ /Invalid/ || $!{EINVAL}) {
+	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
+	    goto &AutoLoader::AUTOLOAD;
+	}
+	else {
+	    my ($pack,$file,$line) = caller;
+	    die "Your vendor has not defined Fcntl macro $constname, used at $file line $line.
+";
+	}
+    }
+    *$AUTOLOAD = sub { $val };
+    goto &$AUTOLOAD;
+}
+
+XSLoader::load 'Fcntl', $VERSION;
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Basename.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Basename.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Basename.pm	(revision 14265)
@@ -0,0 +1,283 @@
+package File::Basename;
+
+=head1 NAME
+
+fileparse - split a pathname into pieces
+
+basename - extract just the filename from a path
+
+dirname - extract just the directory from a path
+
+=head1 SYNOPSIS
+
+    use File::Basename;
+
+    ($name,$path,$suffix) = fileparse($fullname,@suffixlist)
+    fileparse_set_fstype($os_string);
+    $basename = basename($fullname,@suffixlist);
+    $dirname = dirname($fullname);
+
+    ($name,$path,$suffix) = fileparse("lib/File/Basename.pm","\.pm");
+    fileparse_set_fstype("VMS");
+    $basename = basename("lib/File/Basename.pm",".pm");
+    $dirname = dirname("lib/File/Basename.pm");
+
+=head1 DESCRIPTION
+
+These routines allow you to parse file specifications into useful
+pieces using the syntax of different operating systems.
+
+=over 4
+
+=item fileparse_set_fstype
+
+You select the syntax via the routine fileparse_set_fstype().
+
+If the argument passed to it contains one of the substrings
+"VMS", "MSDOS", "MacOS", "AmigaOS" or "MSWin32", the file specification 
+syntax of that operating system is used in future calls to 
+fileparse(), basename(), and dirname().  If it contains none of
+these substrings, Unix syntax is used.  This pattern matching is
+case-insensitive.  If you've selected VMS syntax, and the file
+specification you pass to one of these routines contains a "/",
+they assume you are using Unix emulation and apply the Unix syntax
+rules instead, for that function call only.
+
+If the argument passed to it contains one of the substrings "VMS",
+"MSDOS", "MacOS", "AmigaOS", "os2", "MSWin32" or "RISCOS", then the pattern
+matching for suffix removal is performed without regard for case,
+since those systems are not case-sensitive when opening existing files
+(though some of them preserve case on file creation).
+
+If you haven't called fileparse_set_fstype(), the syntax is chosen
+by examining the builtin variable C<$^O> according to these rules.
+
+=item fileparse
+
+The fileparse() routine divides a file specification into three
+parts: a leading B<path>, a file B<name>, and a B<suffix>.  The
+B<path> contains everything up to and including the last directory
+separator in the input file specification.  The remainder of the input
+file specification is then divided into B<name> and B<suffix> based on
+the optional patterns you specify in C<@suffixlist>.  Each element of
+this list is interpreted as a regular expression, and is matched
+against the end of B<name>.  If this succeeds, the matching portion of
+B<name> is removed and prepended to B<suffix>.  By proper use of
+C<@suffixlist>, you can remove file types or versions for examination.
+
+You are guaranteed that if you concatenate B<path>, B<name>, and
+B<suffix> together in that order, the result will denote the same
+file as the input file specification.
+
+=back
+
+=head1 EXAMPLES
+
+Using Unix file syntax:
+
+    ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7',
+				    '\.book\d+');
+
+would yield
+
+    $base eq 'draft'
+    $path eq '/virgil/aeneid/',
+    $type eq '.book7'
+
+Similarly, using VMS syntax:
+
+    ($name,$dir,$type) = fileparse('Doc_Root:[Help]Rhetoric.Rnh',
+				   '\..*');
+
+would yield
+
+    $name eq 'Rhetoric'
+    $dir  eq 'Doc_Root:[Help]'
+    $type eq '.Rnh'
+
+=over
+
+=item C<basename>
+
+The basename() routine returns the first element of the list produced
+by calling fileparse() with the same arguments, except that it always
+quotes metacharacters in the given suffixes.  It is provided for
+programmer compatibility with the Unix shell command basename(1).
+
+=item C<dirname>
+
+The dirname() routine returns the directory portion of the input file
+specification.  When using VMS or MacOS syntax, this is identical to the
+second element of the list produced by calling fileparse() with the same
+input file specification.  (Under VMS, if there is no directory information
+in the input file specification, then the current default device and
+directory are returned.)  When using Unix or MSDOS syntax, the return
+value conforms to the behavior of the Unix shell command dirname(1).  This
+is usually the same as the behavior of fileparse(), but differs in some
+cases.  For example, for the input file specification F<lib/>, fileparse()
+considers the directory name to be F<lib/>, while dirname() considers the
+directory name to be F<.>).
+
+=back
+
+=cut
+
+
+## use strict;
+# A bit of juggling to insure that C<use re 'taint';> always works, since
+# File::Basename is used during the Perl build, when the re extension may
+# not be available.
+BEGIN {
+  unless (eval { require re; })
+    { eval ' sub re::import { $^H |= 0x00100000; } ' }
+  import re 'taint';
+}
+
+
+
+use 5.005_64;
+our(@ISA, @EXPORT, $VERSION, $Fileparse_fstype, $Fileparse_igncase);
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
+$VERSION = "2.6";
+
+
+#   fileparse_set_fstype() - specify OS-based rules used in future
+#                            calls to routines in this package
+#
+#   Currently recognized values: VMS, MSDOS, MacOS, AmigaOS, os2, RISCOS
+#       Any other name uses Unix-style rules and is case-sensitive
+
+sub fileparse_set_fstype {
+  my @old = ($Fileparse_fstype, $Fileparse_igncase);
+  if (@_) {
+    $Fileparse_fstype = $_[0];
+    $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32|MSDOS)/i);
+  }
+  wantarray ? @old : $old[0];
+}
+
+#   fileparse() - parse file specification
+#
+#   Version 2.4  27-Sep-1996  Charles Bailey  bailey@genetics.upenn.edu
+
+
+sub fileparse {
+  my($fullname,@suffices) = @_;
+  my($fstype,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
+  my($dirpath,$tail,$suffix,$basename);
+  my($taint) = substr($fullname,0,0);  # Is $fullname tainted?
+
+  if ($fstype =~ /^VMS/i) {
+    if ($fullname =~ m#/#) { $fstype = '' }  # We're doing Unix emulation
+    else {
+      ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/s);
+      $dirpath ||= '';  # should always be defined
+    }
+  }
+  if ($fstype =~ /^MS(DOS|Win32)|epoc/i) {
+    ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s);
+    $dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/;
+  }
+  elsif ($fstype =~ /^MacOS/si) {
+    ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s);
+  }
+  elsif ($fstype =~ /^AmigaOS/i) {
+    ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/s);
+    $dirpath = './' unless $dirpath;
+  }
+  elsif ($fstype !~ /^VMS/i) {  # default to Unix
+    ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#s);
+    if ($^O eq 'VMS' and $fullname =~ m:^(/[^/]+/000000(/|$))(.*):) {
+      # dev:[000000] is top of VMS tree, similar to Unix '/'
+      # so strip it off and treat the rest as "normal"
+      my $devspec  = $1;
+      my $remainder = $3;
+      ($dirpath,$basename) = ($remainder =~ m#^(.*/)?(.*)#s);
+      $dirpath = $devspec.$dirpath;
+    }
+    $dirpath = './' unless $dirpath;
+  }
+
+  if (@suffices) {
+    $tail = '';
+    foreach $suffix (@suffices) {
+      my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
+      if ($basename =~ s/$pat//s) {
+        $taint .= substr($suffix,0,0);
+        $tail = $1 . $tail;
+      }
+    }
+  }
+
+  $tail .= $taint if defined $tail; # avoid warning if $tail == undef
+  wantarray ? ($basename . $taint, $dirpath . $taint, $tail)
+            : $basename . $taint;
+}
+
+
+#   basename() - returns first element of list returned by fileparse()
+
+sub basename {
+  my($name) = shift;
+  (fileparse($name, map("\Q$_\E",@_)))[0];
+}
+
+
+#    dirname() - returns device and directory portion of file specification
+#        Behavior matches that of Unix dirname(1) exactly for Unix and MSDOS
+#        filespecs except for names ending with a separator, e.g., "/xx/yy/".
+#        This differs from the second element of the list returned
+#        by fileparse() in that the trailing '/' (Unix) or '\' (MSDOS) (and
+#        the last directory name if the filespec ends in a '/' or '\'), is lost.
+
+sub dirname {
+    my($basename,$dirname) = fileparse($_[0]);
+    my($fstype) = $Fileparse_fstype;
+
+    if ($fstype =~ /VMS/i) { 
+        if ($_[0] =~ m#/#) { $fstype = '' }
+        else { return $dirname || $ENV{DEFAULT} }
+    }
+    if ($fstype =~ /MacOS/i) {
+	if( !length($basename) && $dirname !~ /^[^:]+:\z/) {
+	    $dirname =~ s/([^:]):\z/$1/s;
+	    ($basename,$dirname) = fileparse $dirname;
+	}
+	$dirname .= ":" unless $dirname =~ /:\z/;
+    }
+    elsif ($fstype =~ /MSDOS/i) { 
+        $dirname =~ s/([^:])[\\\/]*\z/$1/;
+        unless( length($basename) ) {
+	    ($basename,$dirname) = fileparse $dirname;
+	    $dirname =~ s/([^:])[\\\/]*\z/$1/;
+	}
+    }
+    elsif ($fstype =~ /MSWin32/i) { 
+        $dirname =~ s/([^:])[\\\/]*\z/$1/;
+        unless( length($basename) ) {
+	    ($basename,$dirname) = fileparse $dirname;
+	    $dirname =~ s/([^:])[\\\/]*\z/$1/;
+	}
+    }
+    elsif ($fstype =~ /AmigaOS/i) {
+        if ( $dirname =~ /:\z/) { return $dirname }
+        chop $dirname;
+        $dirname =~ s#[^:/]+\z## unless length($basename);
+    }
+    else {
+        $dirname =~ s:(.)/*\z:$1:s;
+        unless( length($basename) ) {
+	    local($File::Basename::Fileparse_fstype) = $fstype;
+	    ($basename,$dirname) = fileparse $dirname;
+	    $dirname =~ s:(.)/*\z:$1:s;
+	}
+    }
+
+    $dirname;
+}
+
+fileparse_set_fstype $^O;
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/File/CheckTree.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/CheckTree.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/CheckTree.pm	(revision 14265)
@@ -0,0 +1,151 @@
+package File::CheckTree;
+require 5.000;
+require Exporter;
+
+=head1 NAME
+
+validate - run many filetest checks on a tree
+
+=head1 SYNOPSIS
+
+    use File::CheckTree;
+
+    $warnings += validate( q{
+	/vmunix                 -e || die
+	/boot                   -e || die
+	/bin                    cd
+	    csh                 -ex
+	    csh                 !-ug
+	    sh                  -ex
+	    sh                  !-ug
+	/usr                    -d || warn "What happened to $file?\n"
+    });
+
+=head1 DESCRIPTION
+
+The validate() routine takes a single multiline string consisting of
+lines containing a filename plus a file test to try on it.  (The
+file test may also be a "cd", causing subsequent relative filenames
+to be interpreted relative to that directory.)  After the file test
+you may put C<|| die> to make it a fatal error if the file test fails.
+The default is C<|| warn>.  The file test may optionally have a "!' prepended
+to test for the opposite condition.  If you do a cd and then list some
+relative filenames, you may want to indent them slightly for readability.
+If you supply your own die() or warn() message, you can use $file to
+interpolate the filename.
+
+Filetests may be bunched:  "-rwx" tests for all of C<-r>, C<-w>, and C<-x>.
+Only the first failed test of the bunch will produce a warning.
+
+The routine returns the number of warnings issued.
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(validate);
+
+# $RCSfile$$Revision$$Date$
+
+# The validate routine takes a single multiline string consisting of
+# lines containing a filename plus a file test to try on it.  (The
+# file test may also be a 'cd', causing subsequent relative filenames
+# to be interpreted relative to that directory.)  After the file test
+# you may put '|| die' to make it a fatal error if the file test fails.
+# The default is '|| warn'.  The file test may optionally have a ! prepended
+# to test for the opposite condition.  If you do a cd and then list some
+# relative filenames, you may want to indent them slightly for readability.
+# If you supply your own "die" or "warn" message, you can use $file to
+# interpolate the filename.
+
+# Filetests may be bunched:  -rwx tests for all of -r, -w and -x.
+# Only the first failed test of the bunch will produce a warning.
+
+# The routine returns the number of warnings issued.
+
+# Usage:
+#	use File::CheckTree;
+#	$warnings += validate('
+#	/vmunix			-e || die
+#	/boot			-e || die
+#	/bin			cd
+#	    csh			-ex
+#	    csh			!-ug
+#	    sh			-ex
+#	    sh			!-ug
+#	/usr			-d || warn "What happened to $file?\n"
+#	');
+
+sub validate {
+    local($file,$test,$warnings,$oldwarnings);
+    foreach $check (split(/\n/,$_[0])) {
+	next if $check =~ /^#/;
+	next if $check =~ /^$/;
+	($file,$test) = split(' ',$check,2);
+	if ($test =~ s/^(!?-)(\w{2,}\b)/$1Z/) {
+	    $testlist = $2;
+	    @testlist = split(//,$testlist);
+	}
+	else {
+	    @testlist = ('Z');
+	}
+	$oldwarnings = $warnings;
+	foreach $one (@testlist) {
+	    $this = $test;
+	    $this =~ s/(-\w\b)/$1 \$file/g;
+	    $this =~ s/-Z/-$one/;
+	    $this .= ' || warn' unless $this =~ /\|\|/;
+	    $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || valmess('$2','$1')/;
+	    $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g;
+	    eval $this;
+	    last if $warnings > $oldwarnings;
+	}
+    }
+    $warnings;
+}
+
+sub valmess {
+    local($disposition,$this) = @_;
+    $file = $cwd . '/' . $file unless $file =~ m|^/|s;
+    if ($this =~ /^(!?)-(\w)\s+\$file\s*$/) {
+	$neg = $1;
+	$tmp = $2;
+	$tmp eq 'r' && ($mess = "$file is not readable by uid $>.");
+	$tmp eq 'w' && ($mess = "$file is not writable by uid $>.");
+	$tmp eq 'x' && ($mess = "$file is not executable by uid $>.");
+	$tmp eq 'o' && ($mess = "$file is not owned by uid $>.");
+	$tmp eq 'R' && ($mess = "$file is not readable by you.");
+	$tmp eq 'W' && ($mess = "$file is not writable by you.");
+	$tmp eq 'X' && ($mess = "$file is not executable by you.");
+	$tmp eq 'O' && ($mess = "$file is not owned by you.");
+	$tmp eq 'e' && ($mess = "$file does not exist.");
+	$tmp eq 'z' && ($mess = "$file does not have zero size.");
+	$tmp eq 's' && ($mess = "$file does not have non-zero size.");
+	$tmp eq 'f' && ($mess = "$file is not a plain file.");
+	$tmp eq 'd' && ($mess = "$file is not a directory.");
+	$tmp eq 'l' && ($mess = "$file is not a symbolic link.");
+	$tmp eq 'p' && ($mess = "$file is not a named pipe (FIFO).");
+	$tmp eq 'S' && ($mess = "$file is not a socket.");
+	$tmp eq 'b' && ($mess = "$file is not a block special file.");
+	$tmp eq 'c' && ($mess = "$file is not a character special file.");
+	$tmp eq 'u' && ($mess = "$file does not have the setuid bit set.");
+	$tmp eq 'g' && ($mess = "$file does not have the setgid bit set.");
+	$tmp eq 'k' && ($mess = "$file does not have the sticky bit set.");
+	$tmp eq 'T' && ($mess = "$file is not a text file.");
+	$tmp eq 'B' && ($mess = "$file is not a binary file.");
+	if ($neg eq '!') {
+	    $mess =~ s/ is not / should not be / ||
+	    $mess =~ s/ does not / should not / ||
+	    $mess =~ s/ not / /;
+	}
+    }
+    else {
+	$this =~ s/\$file/'$file'/g;
+	$mess = "Can't do $this.\n";
+    }
+    die "$mess\n" if $disposition eq 'die';
+    warn "$mess\n";
+    ++$warnings;
+}
+
+1;
+
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Compare.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Compare.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Compare.pm	(revision 14265)
@@ -0,0 +1,182 @@
+package File::Compare;
+
+use 5.005_64;
+use strict;
+our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Too_Big);
+
+require Exporter;
+use Carp;
+
+$VERSION = '1.1002';
+@ISA = qw(Exporter);
+@EXPORT = qw(compare);
+@EXPORT_OK = qw(cmp compare_text);
+
+$Too_Big = 1024 * 1024 * 2;
+
+sub VERSION {
+    # Version of File::Compare
+    return $File::Compare::VERSION;
+}
+
+sub compare {
+    croak("Usage: compare( file1, file2 [, buffersize]) ")
+      unless(@_ == 2 || @_ == 3);
+
+    my ($from,$to,$size) = @_;
+    my $text_mode = defined($size) && (ref($size) eq 'CODE' || $size < 0);
+
+    my ($fromsize,$closefrom,$closeto);
+    local (*FROM, *TO);
+
+    croak("from undefined") unless (defined $from);
+    croak("to undefined") unless (defined $to);
+
+    if (ref($from) && 
+        (UNIVERSAL::isa($from,'GLOB') || UNIVERSAL::isa($from,'IO::Handle'))) {
+	*FROM = *$from;
+    } elsif (ref(\$from) eq 'GLOB') {
+	*FROM = $from;
+    } else {
+	open(FROM,"<$from") or goto fail_open1;
+	unless ($text_mode) {
+	    binmode FROM;
+	    $fromsize = -s FROM;
+	}
+	$closefrom = 1;
+    }
+
+    if (ref($to) &&
+        (UNIVERSAL::isa($to,'GLOB') || UNIVERSAL::isa($to,'IO::Handle'))) {
+	*TO = *$to;
+    } elsif (ref(\$to) eq 'GLOB') {
+	*TO = $to;
+    } else {
+	open(TO,"<$to") or goto fail_open2;
+	binmode TO unless $text_mode;
+	$closeto = 1;
+    }
+
+    if (!$text_mode && $closefrom && $closeto) {
+	# If both are opened files we know they differ if their size differ
+	goto fail_inner if $fromsize != -s TO;
+    }
+
+    if ($text_mode) {
+	local $/ = "\n";
+	my ($fline,$tline);
+	while (defined($fline = <FROM>)) {
+	    goto fail_inner unless defined($tline = <TO>);
+	    if (ref $size) {
+		# $size contains ref to comparison function
+		goto fail_inner if &$size($fline, $tline);
+	    } else {
+		goto fail_inner if $fline ne $tline;
+	    }
+	}
+	goto fail_inner if defined($tline = <TO>);
+    }
+    else {
+	unless (defined($size) && $size > 0) {
+	    $size = $fromsize || -s TO || 0;
+	    $size = 1024 if $size < 512;
+	    $size = $Too_Big if $size > $Too_Big;
+	}
+
+	my ($fr,$tr,$fbuf,$tbuf);
+	$fbuf = $tbuf = '';
+	while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) {
+	    unless (defined($tr = read(TO,$tbuf,$fr)) && $tbuf eq $fbuf) {
+		goto fail_inner;
+	    }
+	}
+	goto fail_inner if defined($tr = read(TO,$tbuf,$size)) && $tr > 0;
+    }
+
+    close(TO) || goto fail_open2 if $closeto;
+    close(FROM) || goto fail_open1 if $closefrom;
+
+    return 0;
+    
+  # All of these contortions try to preserve error messages...
+  fail_inner:
+    close(TO) || goto fail_open2 if $closeto;
+    close(FROM) || goto fail_open1 if $closefrom;
+
+    return 1;
+
+  fail_open2:
+    if ($closefrom) {
+	my $status = $!;
+	$! = 0;
+	close FROM;
+	$! = $status unless $!;
+    }
+  fail_open1:
+    return -1;
+}
+
+sub cmp;
+*cmp = \&compare;
+
+sub compare_text {
+    my ($from,$to,$cmp) = @_;
+    croak("Usage: compare_text( file1, file2 [, cmp-function])")
+	unless @_ == 2 || @_ == 3;
+    croak("Third arg to compare_text() function must be a code reference")
+	if @_ == 3 && ref($cmp) ne 'CODE';
+
+    # Using a negative buffer size puts compare into text_mode too
+    $cmp = -1 unless defined $cmp;
+    compare($from, $to, $cmp);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Compare - Compare files or filehandles
+
+=head1 SYNOPSIS
+
+  	use File::Compare;
+
+	if (compare("file1","file2") == 0) {
+	    print "They're equal\n";
+	}
+
+=head1 DESCRIPTION
+
+The File::Compare::compare function compares the contents of two
+sources, each of which can be a file or a file handle.  It is exported
+from File::Compare by default.
+
+File::Compare::cmp is a synonym for File::Compare::compare.  It is
+exported from File::Compare only by request.
+
+File::Compare::compare_text does a line by line comparison of the two
+files. It stops as soon as a difference is detected. compare_text()
+accepts an optional third argument: This must be a CODE reference to
+a line comparison function, which returns 0 when both lines are considered
+equal. For example:
+
+    compare_text($file1, $file2)
+
+is basically equivalent to
+
+    compare_text($file1, $file2, sub {$_[0] ne $_[1]} )
+
+=head1 RETURN
+
+File::Compare::compare return 0 if the files are equal, 1 if the
+files are unequal, or -1 if an error was encountered.
+
+=head1 AUTHOR
+
+File::Compare was written by Nick Ing-Simmons.
+Its original documentation was written by Chip Salzenberg.
+
+=cut
+
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Copy.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Copy.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Copy.pm	(revision 14265)
@@ -0,0 +1,378 @@
+# File/Copy.pm. Written in 1994 by Aaron Sherman <ajs@ajs.com>. This
+# source code has been placed in the public domain by the author.
+# Please be kind and preserve the documentation.
+#
+# Additions copyright 1996 by Charles Bailey.  Permission is granted
+# to distribute the revised code under the same terms as Perl itself.
+
+package File::Copy;
+
+use 5.005_64;
+use strict;
+use Carp;
+our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
+sub copy;
+sub syscopy;
+sub cp;
+sub mv;
+
+# Note that this module implements only *part* of the API defined by
+# the File/Copy.pm module of the File-Tools-2.0 package.  However, that
+# package has not yet been updated to work with Perl 5.004, and so it
+# would be a Bad Thing for the CPAN module to grab it and replace this
+# module.  Therefore, we set this module's version higher than 2.0.
+$VERSION = '2.03';
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(copy move);
+@EXPORT_OK = qw(cp mv);
+
+$Too_Big = 1024 * 1024 * 2;
+
+sub _catname { #  Will be replaced by File::Spec when it arrives
+    my($from, $to) = @_;
+    if (not defined &basename) {
+	require File::Basename;
+	import  File::Basename 'basename';
+    }
+    if ($^O eq 'VMS')  { $to = VMS::Filespec::vmspath($to) . basename($from); }
+    elsif ($^O eq 'MacOS') { $to =~ s/^([^:]+)$/:$1/; $to .= ':' . basename($from); }
+    elsif ($to =~ m|\\|)   { $to .= '\\' . basename($from); }
+    else                   { $to .= '/' . basename($from); }
+}
+
+sub copy {
+    croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
+      unless(@_ == 2 || @_ == 3);
+
+    my $from = shift;
+    my $to = shift;
+
+    my $from_a_handle = (ref($from)
+			 ? (ref($from) eq 'GLOB'
+			    || UNIVERSAL::isa($from, 'GLOB')
+                            || UNIVERSAL::isa($from, 'IO::Handle'))
+			 : (ref(\$from) eq 'GLOB'));
+    my $to_a_handle =   (ref($to)
+			 ? (ref($to) eq 'GLOB'
+			    || UNIVERSAL::isa($to, 'GLOB')
+                            || UNIVERSAL::isa($to, 'IO::Handle'))
+			 : (ref(\$to) eq 'GLOB'));
+
+    if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
+	$to = _catname($from, $to);
+    }
+
+    if (defined &syscopy && !$Syscopy_is_copy
+	&& !$to_a_handle
+	&& !($from_a_handle && $^O eq 'os2' )	# OS/2 cannot handle handles
+	&& !($from_a_handle && $^O eq 'mpeix')	# and neither can MPE/iX.
+	&& !($from_a_handle && $^O eq 'MSWin32')
+	&& !($from_a_handle && $^O eq 'MacOS')
+       )
+    {
+	return syscopy($from, $to);
+    }
+
+    my $closefrom = 0;
+    my $closeto = 0;
+    my ($size, $status, $r, $buf);
+    local(*FROM, *TO);
+    local($\) = '';
+
+    if ($from_a_handle) {
+	*FROM = *$from{FILEHANDLE};
+    } else {
+	$from = _protect($from) if $from =~ /^\s/s;
+	open(FROM, "< $from\0") or goto fail_open1;
+	binmode FROM or die "($!,$^E)";
+	$closefrom = 1;
+    }
+
+    if ($to_a_handle) {
+	*TO = *$to{FILEHANDLE};
+    } else {
+	$to = _protect($to) if $to =~ /^\s/s;
+	open(TO,"> $to\0") or goto fail_open2;
+	binmode TO or die "($!,$^E)";
+	$closeto = 1;
+    }
+
+    if (@_) {
+	$size = shift(@_) + 0;
+	croak("Bad buffer size for copy: $size\n") unless ($size > 0);
+    } else {
+	$size = -s FROM;
+	$size = 1024 if ($size < 512);
+	$size = $Too_Big if ($size > $Too_Big);
+    }
+
+    $! = 0;
+    for (;;) {
+	my ($r, $w, $t);
+	defined($r = sysread(FROM, $buf, $size))
+	    or goto fail_inner;
+	last unless $r;
+	for ($w = 0; $w < $r; $w += $t) {
+	    $t = syswrite(TO, $buf, $r - $w, $w)
+		or goto fail_inner;
+	}
+    }
+
+    close(TO) || goto fail_open2 if $closeto;
+    close(FROM) || goto fail_open1 if $closefrom;
+
+    # Use this idiom to avoid uninitialized value warning.
+    return 1;
+
+    # All of these contortions try to preserve error messages...
+  fail_inner:
+    if ($closeto) {
+	$status = $!;
+	$! = 0;
+	close TO;
+	$! = $status unless $!;
+    }
+  fail_open2:
+    if ($closefrom) {
+	$status = $!;
+	$! = 0;
+	close FROM;
+	$! = $status unless $!;
+    }
+  fail_open1:
+    return 0;
+}
+
+sub move {
+    my($from,$to) = @_;
+    my($copied,$fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
+
+    if (-d $to && ! -d $from) {
+	$to = _catname($from, $to);
+    }
+
+    ($tosz1,$tomt1) = (stat($to))[7,9];
+    $fromsz = -s $from;
+    if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) {
+      # will not rename with overwrite
+      unlink $to;
+    }
+    return 1 if rename $from, $to;
+
+    ($sts,$ossts) = ($! + 0, $^E + 0);
+    # Did rename return an error even though it succeeded, because $to
+    # is on a remote NFS file system, and NFS lost the server's ack?
+    return 1 if defined($fromsz) && !-e $from &&           # $from disappeared
+                (($tosz2,$tomt2) = (stat($to))[7,9]) &&    # $to's there
+                ($tosz1 != $tosz2 or $tomt1 != $tomt2) &&  #   and changed
+                $tosz2 == $fromsz;                         # it's all there
+
+    ($tosz1,$tomt1) = (stat($to))[7,9];  # just in case rename did something
+    return 1 if ($copied = copy($from,$to)) && unlink($from);
+
+    ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
+    unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
+    ($!,$^E) = ($sts,$ossts);
+    return 0;
+}
+
+*cp = \&copy;
+*mv = \&move;
+
+
+if ($^O eq 'MacOS') {
+    *_protect = sub { MacPerl::MakeFSSpec($_[0]) };
+} else {
+    *_protect = sub { "./$_[0]" };
+}
+
+# &syscopy is an XSUB under OS/2
+unless (defined &syscopy) {
+    if ($^O eq 'VMS') {
+	*syscopy = \&rmscopy;
+    } elsif ($^O eq 'mpeix') {
+	*syscopy = sub {
+	    return 0 unless @_ == 2;
+	    # Use the MPE cp program in order to
+	    # preserve MPE file attributes.
+	    return system('/bin/cp', '-f', $_[0], $_[1]) == 0;
+	};
+    } elsif ($^O eq 'MSWin32') {
+	*syscopy = sub {
+	    return 0 unless @_ == 2;
+	    return Win32::CopyFile(@_, 1);
+	};
+    } elsif ($^O eq 'MacOS') {
+	require Mac::MoreFiles;
+	*syscopy = sub {
+	    my($from, $to) = @_;
+	    my($dir, $toname);
+
+	    return 0 unless -e $from;
+
+	    if ($to =~ /(.*:)([^:]+):?$/) {
+		($dir, $toname) = ($1, $2);
+	    } else {
+		($dir, $toname) = (":", $to);
+	    }
+
+	    unlink($to);
+	    Mac::MoreFiles::FSpFileCopy($from, $dir, $toname, 1);
+	};
+    } else {
+	$Syscopy_is_copy = 1;
+	*syscopy = \&copy;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Copy - Copy files or filehandles
+
+=head1 SYNOPSIS
+
+  	use File::Copy;
+
+	copy("file1","file2");
+  	copy("Copy.pm",\*STDOUT);'
+	move("/dev1/fileA","/dev2/fileB");
+
+  	use POSIX;
+	use File::Copy cp;
+
+	$n = FileHandle->new("/a/file","r");
+	cp($n,"x");'
+
+=head1 DESCRIPTION
+
+The File::Copy module provides two basic functions, C<copy> and
+C<move>, which are useful for getting the contents of a file from
+one place to another.
+
+=over 4
+
+=item *
+
+The C<copy> function takes two
+parameters: a file to copy from and a file to copy to. Either
+argument may be a string, a FileHandle reference or a FileHandle
+glob. Obviously, if the first argument is a filehandle of some
+sort, it will be read from, and if it is a file I<name> it will
+be opened for reading. Likewise, the second argument will be
+written to (and created if need be).
+
+B<Note that passing in
+files as handles instead of names may lead to loss of information
+on some operating systems; it is recommended that you use file
+names whenever possible.>  Files are opened in binary mode where
+applicable.  To get a consistent behaviour when copying from a
+filehandle to a file, use C<binmode> on the filehandle.
+
+An optional third parameter can be used to specify the buffer
+size used for copying. This is the number of bytes from the
+first file, that wil be held in memory at any given time, before
+being written to the second file. The default buffer size depends
+upon the file, but will generally be the whole file (up to 2Mb), or
+1k for filehandles that do not reference files (eg. sockets).
+
+You may use the syntax C<use File::Copy "cp"> to get at the
+"cp" alias for this function. The syntax is I<exactly> the same.
+
+=item *
+
+The C<move> function also takes two parameters: the current name
+and the intended name of the file to be moved.  If the destination
+already exists and is a directory, and the source is not a
+directory, then the source file will be renamed into the directory
+specified by the destination.
+
+If possible, move() will simply rename the file.  Otherwise, it copies
+the file to the new location and deletes the original.  If an error occurs
+during this copy-and-delete process, you may be left with a (possibly partial)
+copy of the file under the destination name.
+
+You may use the "mv" alias for this function in the same way that
+you may use the "cp" alias for C<copy>.
+
+=back
+
+File::Copy also provides the C<syscopy> routine, which copies the
+file specified in the first parameter to the file specified in the
+second parameter, preserving OS-specific attributes and file
+structure.  For Unix systems, this is equivalent to the simple
+C<copy> routine.  For VMS systems, this calls the C<rmscopy>
+routine (see below).  For OS/2 systems, this calls the C<syscopy>
+XSUB directly. For Win32 systems, this calls C<Win32::CopyFile>.
+
+=head2 Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)
+
+If both arguments to C<copy> are not file handles,
+then C<copy> will perform a "system copy" of
+the input file to a new output file, in order to preserve file
+attributes, indexed file structure, I<etc.>  The buffer size
+parameter is ignored.  If either argument to C<copy> is a
+handle to an opened file, then data is copied using Perl
+operators, and no effort is made to preserve file attributes
+or record structure.
+
+The system copy routine may also be called directly under VMS and OS/2
+as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
+is the routine that does the actual work for syscopy).
+
+=over 4
+
+=item rmscopy($from,$to[,$date_flag])
+
+The first and second arguments may be strings, typeglobs, typeglob
+references, or objects inheriting from IO::Handle;
+they are used in all cases to obtain the
+I<filespec> of the input and output files, respectively.  The
+name and type of the input file are used as defaults for the
+output file, if necessary.
+
+A new version of the output file is always created, which
+inherits the structure and RMS attributes of the input file,
+except for owner and protections (and possibly timestamps;
+see below).  All data from the input file is copied to the
+output file; if either of the first two parameters to C<rmscopy>
+is a file handle, its position is unchanged.  (Note that this
+means a file handle pointing to the output file will be
+associated with an old version of that file after C<rmscopy>
+returns, not the newly created version.)
+
+The third parameter is an integer flag, which tells C<rmscopy>
+how to handle timestamps.  If it is E<lt> 0, none of the input file's
+timestamps are propagated to the output file.  If it is E<gt> 0, then
+it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
+timestamps other than the revision date are propagated; if bit 1
+is set, the revision date is propagated.  If the third parameter
+to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
+if the name or type of the output file was explicitly specified,
+then no timestamps are propagated, but if they were taken implicitly
+from the input filespec, then all timestamps other than the
+revision date are propagated.  If this parameter is not supplied,
+it defaults to 0.
+
+Like C<copy>, C<rmscopy> returns 1 on success.  If an error occurs,
+it sets C<$!>, deletes the output file, and returns 0.
+
+=back
+
+=head1 RETURN
+
+All functions return 1 on success, 0 on failure.
+$! will be set if an error was encountered.
+
+=head1 AUTHOR
+
+File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
+and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996.
+
+=cut
+
Index: /for-distributions/trunk/bin/windows/perl/lib/File/DosGlob.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/DosGlob.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/DosGlob.pm	(revision 14265)
@@ -0,0 +1,254 @@
+#!perl -w
+
+#
+# Documentation at the __END__
+#
+
+package File::DosGlob;
+
+sub doglob {
+    my $cond = shift;
+    my @retval = ();
+    #print "doglob: ", join('|', @_), "\n";
+  OUTER:
+    for my $arg (@_) {
+        local $_ = $arg;
+	my @matched = ();
+	my @globdirs = ();
+	my $head = '.';
+	my $sepchr = '/';
+	next OUTER unless defined $_ and $_ ne '';
+	# if arg is within quotes strip em and do no globbing
+	if (/^"(.*)"\z/s) {
+	    $_ = $1;
+	    if ($cond eq 'd') { push(@retval, $_) if -d $_ }
+	    else              { push(@retval, $_) if -e $_ }
+	    next OUTER;
+	}
+	# wildcards with a drive prefix such as h:*.pm must be changed
+	# to h:./*.pm to expand correctly
+	if (m|^([A-Za-z]:)[^/\\]|s) {
+	    substr($_,0,2) = $1 . "./";
+	}
+	if (m|^(.*)([\\/])([^\\/]*)\z|s) {
+	    my $tail;
+	    ($head, $sepchr, $tail) = ($1,$2,$3);
+	    #print "div: |$head|$sepchr|$tail|\n";
+	    push (@retval, $_), next OUTER if $tail eq '';
+	    if ($head =~ /[*?]/) {
+		@globdirs = doglob('d', $head);
+		push(@retval, doglob($cond, map {"$_$sepchr$tail"} @globdirs)),
+		    next OUTER if @globdirs;
+	    }
+	    $head .= $sepchr if $head eq '' or $head =~ /^[A-Za-z]:\z/s;
+	    $_ = $tail;
+	}
+	#
+	# If file component has no wildcards, we can avoid opendir
+	unless (/[*?]/) {
+	    $head = '' if $head eq '.';
+	    $head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr;
+	    $head .= $_;
+	    if ($cond eq 'd') { push(@retval,$head) if -d $head }
+	    else              { push(@retval,$head) if -e $head }
+	    next OUTER;
+	}
+	opendir(D, $head) or next OUTER;
+	my @leaves = readdir D;
+	closedir D;
+	$head = '' if $head eq '.';
+	$head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr;
+
+	# escape regex metachars but not glob chars
+	s:([].+^\-\${}[|]):\\$1:g;
+	# and convert DOS-style wildcards to regex
+	s/\*/.*/g;
+	s/\?/.?/g;
+
+	#print "regex: '$_', head: '$head'\n";
+	my $matchsub = eval 'sub { $_[0] =~ m|^' . $_ . '\\z|ios }';
+	warn($@), next OUTER if $@;
+      INNER:
+	for my $e (@leaves) {
+	    next INNER if $e eq '.' or $e eq '..';
+	    next INNER if $cond eq 'd' and ! -d "$head$e";
+	    push(@matched, "$head$e"), next INNER if &$matchsub($e);
+	    #
+	    # [DOS compatibility special case]
+	    # Failed, add a trailing dot and try again, but only
+	    # if name does not have a dot in it *and* pattern
+	    # has a dot *and* name is shorter than 9 chars.
+	    #
+	    if (index($e,'.') == -1 and length($e) < 9
+	        and index($_,'\\.') != -1) {
+		push(@matched, "$head$e"), next INNER if &$matchsub("$e.");
+	    }
+	}
+	push @retval, @matched if @matched;
+    }
+    return @retval;
+}
+
+#
+# this can be used to override CORE::glob in a specific
+# package by saying C<use File::DosGlob 'glob';> in that
+# namespace.
+#
+
+# context (keyed by second cxix arg provided by core)
+my %iter;
+my %entries;
+
+sub glob {
+    my $pat = shift;
+    my $cxix = shift;
+    my @pat;
+
+    # glob without args defaults to $_
+    $pat = $_ unless defined $pat;
+
+    # extract patterns
+    if ($pat =~ /\s/) {
+	require Text::ParseWords;
+	@pat = Text::ParseWords::parse_line('\s+',0,$pat);
+    }
+    else {
+	push @pat, $pat;
+    }
+
+    # assume global context if not provided one
+    $cxix = '_G_' unless defined $cxix;
+    $iter{$cxix} = 0 unless exists $iter{$cxix};
+
+    # if we're just beginning, do it all first
+    if ($iter{$cxix} == 0) {
+	$entries{$cxix} = [doglob(1,@pat)];
+    }
+
+    # chuck it all out, quick or slow
+    if (wantarray) {
+	delete $iter{$cxix};
+	return @{delete $entries{$cxix}};
+    }
+    else {
+	if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
+	    return shift @{$entries{$cxix}};
+	}
+	else {
+	    # return undef for EOL
+	    delete $iter{$cxix};
+	    delete $entries{$cxix};
+	    return undef;
+	}
+    }
+}
+
+sub import {
+    my $pkg = shift;
+    return unless @_;
+    my $sym = shift;
+    my $callpkg = ($sym =~ s/^GLOBAL_//s ? 'CORE::GLOBAL' : caller(0));
+    *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob';
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::DosGlob - DOS like globbing and then some
+
+=head1 SYNOPSIS
+
+    require 5.004;
+
+    # override CORE::glob in current package
+    use File::DosGlob 'glob';
+
+    # override CORE::glob in ALL packages (use with extreme caution!)
+    use File::DosGlob 'GLOBAL_glob';
+
+    @perlfiles = glob  "..\\pe?l/*.p?";
+    print <..\\pe?l/*.p?>;
+
+    # from the command line (overrides only in main::)
+    > perl -MFile::DosGlob=glob -e "print <../pe*/*p?>"
+
+=head1 DESCRIPTION
+
+A module that implements DOS-like globbing with a few enhancements.
+It is largely compatible with perlglob.exe (the M$ setargv.obj
+version) in all but one respect--it understands wildcards in
+directory components.
+
+For example, C<<..\\l*b\\file/*glob.p?>> will work as expected (in
+that it will find something like '..\lib\File/DosGlob.pm' alright).
+Note that all path components are case-insensitive, and that
+backslashes and forward slashes are both accepted, and preserved.
+You may have to double the backslashes if you are putting them in
+literally, due to double-quotish parsing of the pattern by perl.
+
+Spaces in the argument delimit distinct patterns, so
+C<glob('*.exe *.dll')> globs all filenames that end in C<.exe>
+or C<.dll>.  If you want to put in literal spaces in the glob
+pattern, you can escape them with either double quotes, or backslashes.
+e.g. C<glob('c:/"Program Files"/*/*.dll')>, or
+C<glob('c:/Program\ Files/*/*.dll')>.  The argument is tokenized using
+C<Text::ParseWords::parse_line()>, so see L<Text::ParseWords> for details
+of the quoting rules used.
+
+Extending it to csh patterns is left as an exercise to the reader.
+
+=head1 EXPORTS (by request only)
+
+glob()
+
+=head1 BUGS
+
+Should probably be built into the core, and needs to stop
+pandering to DOS habits.  Needs a dose of optimizium too.
+
+=head1 AUTHOR
+
+Gurusamy Sarathy <gsar@activestate.com>
+
+=head1 HISTORY
+
+=over 4
+
+=item *
+
+Support for globally overriding glob() (GSAR 3-JUN-98)
+
+=item *
+
+Scalar context, independent iterator context fixes (GSAR 15-SEP-97)
+
+=item *
+
+A few dir-vs-file optimizations result in glob importation being
+10 times faster than using perlglob.exe, and using perlglob.bat is
+only twice as slow as perlglob.exe (GSAR 28-MAY-97)
+
+=item *
+
+Several cleanups prompted by lack of compatible perlglob.exe
+under Borland (GSAR 27-MAY-97)
+
+=item *
+
+Initial version (GSAR 20-FEB-97)
+
+=back
+
+=head1 SEE ALSO
+
+perl
+
+perlglob.bat
+
+Text::ParseWords
+
+=cut
+
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Find.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Find.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Find.pm	(revision 14265)
@@ -0,0 +1,773 @@
+package File::Find;
+use 5.005_64;
+require Exporter;
+require Cwd;
+
+=head1 NAME
+
+find - traverse a file tree
+
+finddepth - traverse a directory structure depth-first
+
+=head1 SYNOPSIS
+
+    use File::Find;
+    find(\&wanted, '/foo', '/bar');
+    sub wanted { ... }
+
+    use File::Find;
+    finddepth(\&wanted, '/foo', '/bar');
+    sub wanted { ... }
+
+    use File::Find;
+    find({ wanted => \&process, follow => 1 }, '.');
+
+=head1 DESCRIPTION
+
+The first argument to find() is either a hash reference describing the
+operations to be performed for each file, or a code reference.
+
+Here are the possible keys for the hash:
+
+=over 3
+
+=item C<wanted>
+
+The value should be a code reference.  This code reference is called
+I<the wanted() function> below.
+
+=item C<bydepth>
+
+Reports the name of a directory only AFTER all its entries
+have been reported.  Entry point finddepth() is a shortcut for
+specifying C<{ bydepth => 1 }> in the first argument of find().
+
+=item C<preprocess>
+
+The value should be a code reference.  This code reference is used to
+preprocess a directory; it is called after readdir() but before the loop that
+calls the wanted() function.  It is called with a list of strings and is
+expected to return a list of strings.  The code can be used to sort the
+strings alphabetically, numerically, or to filter out directory entries based
+on their name alone.
+
+=item C<postprocess>
+
+The value should be a code reference.  It is invoked just before leaving the
+current directory.  It is called in void context with no arguments.  The name
+of the current directory is in $File::Find::dir.  This hook is handy for
+summarizing a directory, such as calculating its disk usage.
+
+=item C<follow>
+
+Causes symbolic links to be followed. Since directory trees with symbolic
+links (followed) may contain files more than once and may even have
+cycles, a hash has to be built up with an entry for each file.
+This might be expensive both in space and time for a large
+directory tree. See I<follow_fast> and I<follow_skip> below.
+If either I<follow> or I<follow_fast> is in effect:
+
+=over 6
+
+=item *
+
+It is guaranteed that an I<lstat> has been called before the user's
+I<wanted()> function is called. This enables fast file checks involving S< _>.
+
+=item *
+
+There is a variable C<$File::Find::fullname> which holds the absolute
+pathname of the file with all symbolic links resolved
+
+=back
+
+=item C<follow_fast>
+
+This is similar to I<follow> except that it may report some files more
+than once.  It does detect cycles, however.  Since only symbolic links
+have to be hashed, this is much cheaper both in space and time.  If
+processing a file more than once (by the user's I<wanted()> function)
+is worse than just taking time, the option I<follow> should be used.
+
+=item C<follow_skip>
+
+C<follow_skip==1>, which is the default, causes all files which are
+neither directories nor symbolic links to be ignored if they are about
+to be processed a second time. If a directory or a symbolic link 
+are about to be processed a second time, File::Find dies.
+C<follow_skip==0> causes File::Find to die if any file is about to be
+processed a second time.
+C<follow_skip==2> causes File::Find to ignore any duplicate files and
+dirctories but to proceed normally otherwise.
+
+
+=item C<no_chdir>
+
+Does not C<chdir()> to each directory as it recurses. The wanted()
+function will need to be aware of this, of course. In this case,
+C<$_> will be the same as C<$File::Find::name>.
+
+=item C<untaint>
+
+If find is used in taint-mode (-T command line switch or if EUID != UID
+or if EGID != GID) then internally directory names have to be untainted
+before they can be cd'ed to. Therefore they are checked against a regular
+expression I<untaint_pattern>.  Note that all names passed to the
+user's I<wanted()> function are still tainted. 
+
+=item C<untaint_pattern>
+
+See above. This should be set using the C<qr> quoting operator.
+The default is set to  C<qr|^([-+@\w./]+)$|>. 
+Note that the parantheses are vital.
+
+=item C<untaint_skip>
+
+If set, directories (subtrees) which fail the I<untaint_pattern>
+are skipped. The default is to 'die' in such a case.
+
+=back
+
+The wanted() function does whatever verifications you want.
+C<$File::Find::dir> contains the current directory name, and C<$_> the
+current filename within that directory.  C<$File::Find::name> contains
+the complete pathname to the file. You are chdir()'d to
+C<$File::Find::dir> when the function is called, unless C<no_chdir>
+was specified.  When <follow> or <follow_fast> are in effect, there is
+also a C<$File::Find::fullname>.  The function may set
+C<$File::Find::prune> to prune the tree unless C<bydepth> was
+specified.  Unless C<follow> or C<follow_fast> is specified, for
+compatibility reasons (find.pl, find2perl) there are in addition the
+following globals available: C<$File::Find::topdir>,
+C<$File::Find::topdev>, C<$File::Find::topino>,
+C<$File::Find::topmode> and C<$File::Find::topnlink>.
+
+This library is useful for the C<find2perl> tool, which when fed,
+
+    find2perl / -name .nfs\* -mtime +7 \
+        -exec rm -f {} \; -o -fstype nfs -prune
+
+produces something like:
+
+    sub wanted {
+        /^\.nfs.*\z/s &&
+        (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
+        int(-M _) > 7 &&
+        unlink($_)
+        ||
+        ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
+        $dev < 0 &&
+        ($File::Find::prune = 1);
+    }
+
+Set the variable C<$File::Find::dont_use_nlink> if you're using AFS,
+since AFS cheats.
+
+
+Here's another interesting wanted function.  It will find all symlinks
+that don't resolve:
+
+    sub wanted {
+         -l && !-e && print "bogus link: $File::Find::name\n";
+    }
+
+See also the script C<pfind> on CPAN for a nice application of this
+module.
+
+=head1 CAVEAT
+
+Be aware that the option to follow symbolic links can be dangerous.
+Depending on the structure of the directory tree (including symbolic
+links to directories) you might traverse a given (physical) directory
+more than once (only if C<follow_fast> is in effect). 
+Furthermore, deleting or changing files in a symbolically linked directory
+might cause very unpleasant surprises, since you delete or change files
+in an unknown directory.
+
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(find finddepth);
+
+
+use strict;
+my $Is_VMS;
+
+require File::Basename;
+
+my %SLnkSeen;
+my ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
+    $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
+    $pre_process, $post_process);
+
+sub contract_name {
+    my ($cdir,$fn) = @_;
+
+    return substr($cdir,0,rindex($cdir,'/')) if $fn eq '.';
+
+    $cdir = substr($cdir,0,rindex($cdir,'/')+1);
+
+    $fn =~ s|^\./||;
+
+    my $abs_name= $cdir . $fn;
+
+    if (substr($fn,0,3) eq '../') {
+	do 1 while ($abs_name=~ s|/(?>[^/]+)/\.\./|/|);
+    }
+
+    return $abs_name;
+}
+
+
+sub PathCombine($$) {
+    my ($Base,$Name) = @_;
+    my $AbsName;
+
+    if (substr($Name,0,1) eq '/') {
+	$AbsName= $Name;
+    }
+    else {
+	$AbsName= contract_name($Base,$Name);
+    }
+
+    # (simple) check for recursion
+    my $newlen= length($AbsName);
+    if ($newlen <= length($Base)) {
+	if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
+	    && $AbsName eq substr($Base,0,$newlen))
+	{
+	    return undef;
+	}
+    }
+    return $AbsName;
+}
+
+sub Follow_SymLink($) {
+    my ($AbsName) = @_;
+
+    my ($NewName,$DEV, $INO);
+    ($DEV, $INO)= lstat $AbsName;
+
+    while (-l _) {
+	if ($SLnkSeen{$DEV, $INO}++) {
+	    if ($follow_skip < 2) {
+		die "$AbsName is encountered a second time";
+	    }
+	    else {
+		return undef;
+	    }
+	}
+	$NewName= PathCombine($AbsName, readlink($AbsName));
+	unless(defined $NewName) {
+	    if ($follow_skip < 2) {
+		die "$AbsName is a recursive symbolic link";
+	    }
+	    else {
+		return undef;
+	    }
+	}
+	else {
+	    $AbsName= $NewName;
+	}
+	($DEV, $INO) = lstat($AbsName);
+	return undef unless defined $DEV;  #  dangling symbolic link
+    }
+
+    if ($full_check && $SLnkSeen{$DEV, $INO}++) {
+	if ($follow_skip < 1) {
+	    die "$AbsName encountered a second time";
+	}
+	else {
+	    return undef;
+	}
+    }
+
+    return $AbsName;
+}
+
+our($dir, $name, $fullname, $prune);
+sub _find_dir_symlnk($$$);
+sub _find_dir($$$);
+
+sub _find_opt {
+    my $wanted = shift;
+    die "invalid top directory" unless defined $_[0];
+
+    my $cwd           = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::cwd();
+    my $cwd_untainted = $cwd;
+    $wanted_callback  = $wanted->{wanted};
+    $bydepth          = $wanted->{bydepth};
+    $pre_process      = $wanted->{preprocess};
+    $post_process     = $wanted->{postprocess};
+    $no_chdir         = $wanted->{no_chdir};
+    $full_check       = $wanted->{follow};
+    $follow           = $full_check || $wanted->{follow_fast};
+    $follow_skip      = $wanted->{follow_skip};
+    $untaint          = $wanted->{untaint};
+    $untaint_pat      = $wanted->{untaint_pattern};
+    $untaint_skip     = $wanted->{untaint_skip};
+
+    # for compatability reasons (find.pl, find2perl)
+    our ($topdir, $topdev, $topino, $topmode, $topnlink);
+
+    # a symbolic link to a directory doesn't increase the link count
+    $avoid_nlink      = $follow || $File::Find::dont_use_nlink;
+    
+    if ( $untaint ) {
+	$cwd_untainted= $1 if $cwd_untainted =~ m|$untaint_pat|;
+	die "insecure cwd in find(depth)"  unless defined($cwd_untainted);
+    }
+    
+    my ($abs_dir, $Is_Dir);
+
+    Proc_Top_Item:
+    foreach my $TOP (@_) {
+        my $top_item = $TOP;
+        $top_item =~ s|/\z|| unless $top_item eq '/';
+        $Is_Dir= 0;
+        
+        ($topdev,$topino,$topmode,$topnlink) = stat $top_item;
+
+        if ($follow) {
+            if (substr($top_item,0,1) eq '/') {
+                $abs_dir = $top_item;
+            }
+	    elsif ($top_item eq '.') {
+		$abs_dir = $cwd;
+	    }
+            else {  # care about any  ../
+		$abs_dir = contract_name("$cwd/",$top_item); 
+            }
+            $abs_dir= Follow_SymLink($abs_dir);
+            unless (defined $abs_dir) {
+		warn "$top_item is a dangling symbolic link\n";
+		next Proc_Top_Item;
+            }
+            if (-d _) {
+		_find_dir_symlnk($wanted, $abs_dir, $top_item);
+		$Is_Dir= 1;
+            }
+        }
+	else { # no follow
+            $topdir = $top_item;
+            unless (defined $topnlink) {
+                warn "Can't stat $top_item: $!\n";
+                next Proc_Top_Item;
+            }
+            if (-d _) {
+		$top_item =~ s/\.dir\z// if $Is_VMS;
+		_find_dir($wanted, $top_item, $topnlink);
+		$Is_Dir= 1;
+            }
+	    else {
+		$abs_dir= $top_item;
+            }
+        }
+
+        unless ($Is_Dir) {
+	    unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
+		($dir,$_) = ('./', $top_item);
+	    }
+
+            $abs_dir = $dir;
+            if ($untaint) {
+		my $abs_dir_save = $abs_dir;
+		$abs_dir = $1 if $abs_dir =~ m|$untaint_pat|;
+		unless (defined $abs_dir) {
+		    if ($untaint_skip == 0) {
+			die "directory $abs_dir_save is still tainted";
+		    }
+		    else {
+			next Proc_Top_Item;
+		    }
+		}
+            }
+
+            unless ($no_chdir or chdir $abs_dir) {
+                warn "Couldn't chdir $abs_dir: $!\n";
+                next Proc_Top_Item;
+            }
+
+            $name = $abs_dir . $_;
+
+            { &$wanted_callback }; # protect against wild "next"
+
+        }
+
+        $no_chdir or chdir $cwd_untainted;
+    }
+}
+
+# API:
+#  $wanted
+#  $p_dir :  "parent directory"
+#  $nlink :  what came back from the stat
+# preconditions:
+#  chdir (if not no_chdir) to dir
+
+sub _find_dir($$$) {
+    my ($wanted, $p_dir, $nlink) = @_;
+    my ($CdLvl,$Level) = (0,0);
+    my @Stack;
+    my @filenames;
+    my ($subcount,$sub_nlink);
+    my $SE= [];
+    my $dir_name= $p_dir;
+    my $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
+    my $dir_rel= '.';      # directory name relative to current directory
+
+    local ($dir, $name, $prune, *DIR);
+     
+    unless ($no_chdir or $p_dir eq '.') {
+	my $udir = $p_dir;
+	if ($untaint) {
+	    $udir = $1 if $p_dir =~ m|$untaint_pat|;
+	    unless (defined $udir) {
+		if ($untaint_skip == 0) {
+		    die "directory $p_dir is still tainted";
+		}
+		else {
+		    return;
+		}
+	    }
+	}
+	unless (chdir $udir) {
+	    warn "Can't cd to $udir: $!\n";
+	    return;
+	}
+    }
+    
+    push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
+
+    while (defined $SE) {
+	unless ($bydepth) {
+            $dir= $p_dir;
+            $name= $dir_name;
+            $_= ($no_chdir ? $dir_name : $dir_rel );
+	    # prune may happen here
+            $prune= 0;
+            { &$wanted_callback }; 	# protect against wild "next"
+            next if $prune;
+	}
+      
+	# change to that directory
+	unless ($no_chdir or $dir_rel eq '.') {
+	    my $udir= $dir_rel;
+	    if ($untaint) {
+		$udir = $1 if $dir_rel =~ m|$untaint_pat|;
+		unless (defined $udir) {
+		    if ($untaint_skip == 0) {
+			die "directory ("
+			    . ($p_dir ne '/' ? $p_dir : '')
+			    . "/) $dir_rel is still tainted";
+		    }
+		}
+	    }
+	    unless (chdir $udir) {
+		warn "Can't cd to ("
+		    . ($p_dir ne '/' ? $p_dir : '')
+		    . "/) $udir : $!\n";
+		next;
+	    }
+	    $CdLvl++;
+	}
+
+	$dir= $dir_name;
+
+	# Get the list of files in the current directory.
+	unless (opendir DIR, ($no_chdir ? $dir_name : '.')) {
+	    warn "Can't opendir($dir_name): $!\n";
+	    next;
+	}
+	@filenames = readdir DIR;
+	closedir(DIR);
+	@filenames = &$pre_process(@filenames) if $pre_process;
+	push @Stack,[$CdLvl,$dir_name,"",-2]   if $post_process;
+
+	if ($nlink == 2 && !$avoid_nlink) {
+	    # This dir has no subdirectories.
+	    for my $FN (@filenames) {
+		next if $FN =~ /^\.{1,2}\z/;
+		
+		$name = $dir_pref . $FN;
+		$_ = ($no_chdir ? $name : $FN);
+		{ &$wanted_callback }; # protect against wild "next"
+	    }
+
+	}
+	else {
+	    # This dir has subdirectories.
+	    $subcount = $nlink - 2;
+
+	    for my $FN (@filenames) {
+		next if $FN =~ /^\.{1,2}\z/;
+		if ($subcount > 0 || $avoid_nlink) {
+		    # Seen all the subdirs?
+		    # check for directoriness.
+		    # stat is faster for a file in the current directory
+		    $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
+
+		    if (-d _) {
+			--$subcount;
+			$FN =~ s/\.dir\z// if $Is_VMS;
+			push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
+		    }
+		    else {
+			$name = $dir_pref . $FN;
+			$_= ($no_chdir ? $name : $FN);
+			{ &$wanted_callback }; # protect against wild "next"
+		    }
+		}
+		else {
+		    $name = $dir_pref . $FN;
+		    $_= ($no_chdir ? $name : $FN);
+		    { &$wanted_callback }; # protect against wild "next"
+		}
+	    }
+	}
+    }
+    continue {
+	while ( defined ($SE = pop @Stack) ) {
+	    ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
+	    if ($CdLvl > $Level && !$no_chdir) {
+                my $tmp = join('/',('..') x ($CdLvl-$Level));
+                die "Can't cd to $dir_name" . $tmp
+                    unless chdir ($tmp);
+		$CdLvl = $Level;
+	    }
+	    $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
+	    $dir_pref = "$dir_name/";
+	    if ( $nlink == -2 ) {
+		$name = $dir = $p_dir;
+		$_ = ".";
+		&$post_process;		# End-of-directory processing
+            } elsif ( $nlink < 0 ) {  # must be finddepth, report dirname now
+                $name = $dir_name;
+                if ( substr($name,-2) eq '/.' ) {
+                  $name =~ s|/\.$||;
+                }
+                $dir = $p_dir;
+                $_ = ($no_chdir ? $dir_name : $dir_rel );
+                if ( substr($_,-2) eq '/.' ) {
+                  s|/\.$||;
+                }
+                { &$wanted_callback }; # protect against wild "next"
+            } else {
+                push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
+                last;
+            }
+	}
+    }
+}
+
+
+# API:
+#  $wanted
+#  $dir_loc : absolute location of a dir
+#  $p_dir   : "parent directory"
+# preconditions:
+#  chdir (if not no_chdir) to dir
+
+sub _find_dir_symlnk($$$) {
+    my ($wanted, $dir_loc, $p_dir) = @_;
+    my @Stack;
+    my @filenames;
+    my $new_loc;
+    my $pdir_loc = $dir_loc;
+    my $SE = [];
+    my $dir_name = $p_dir;
+    my $dir_pref = ( $p_dir   eq '/' ? '/' : "$p_dir/" );
+    my $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
+    my $dir_rel = '.';		# directory name relative to current directory
+    my $byd_flag;               # flag for pending stack entry if $bydepth
+
+    local ($dir, $name, $fullname, $prune, *DIR);
+    
+    unless ($no_chdir or $p_dir eq '.') {
+	my $udir = $dir_loc;
+	if ($untaint) {
+	    $udir = $1 if $dir_loc =~ m|$untaint_pat|;
+	    unless (defined $udir) {
+		if ($untaint_skip == 0) {
+		    die "directory $dir_loc is still tainted";
+		}
+		else {
+		    return;
+		}
+	    }
+	}
+	unless (chdir $udir) {
+	    warn "Can't cd to $udir: $!\n";
+	    return;
+	}
+    }
+
+    push @Stack,[$dir_loc,$pdir_loc,$p_dir,$dir_rel,-1]  if  $bydepth;
+
+    while (defined $SE) {
+
+	unless ($bydepth) {
+	    # change to parent directory
+	    unless ($no_chdir) {
+		my $udir = $pdir_loc;
+		if ($untaint) {
+		    $udir = $1 if $pdir_loc =~ m|$untaint_pat|;
+		}
+		unless (chdir $udir) {
+		    warn "Can't cd to $udir: $!\n";
+		    next;
+		}
+	    }
+	    $dir= $p_dir;
+            $name= $dir_name;
+            $_= ($no_chdir ? $dir_name : $dir_rel );
+            $fullname= $dir_loc;
+	    # prune may happen here
+            $prune= 0;
+	    lstat($_); # make sure  file tests with '_' work
+            { &$wanted_callback }; # protect against wild "next"
+            next if  $prune;
+	}
+
+	# change to that directory
+	unless ($no_chdir or $dir_rel eq '.') {
+	    my $udir = $dir_loc;
+	    if ($untaint) {
+		$udir = $1 if $dir_loc =~ m|$untaint_pat|;
+		unless (defined $udir ) {
+		    if ($untaint_skip == 0) {
+			die "directory $dir_loc is still tainted";
+		    }
+		    else {
+			next;
+		    }
+		}
+	    }
+	    unless (chdir $udir) {
+		warn "Can't cd to $udir: $!\n";
+		next;
+	    }
+	}
+
+	$dir = $dir_name;
+
+	# Get the list of files in the current directory.
+	unless (opendir DIR, ($no_chdir ? $dir_loc : '.')) {
+	    warn "Can't opendir($dir_loc): $!\n";
+	    next;
+	}
+	@filenames = readdir DIR;
+	closedir(DIR);
+
+	for my $FN (@filenames) {
+	    next if $FN =~ /^\.{1,2}\z/;
+
+	    # follow symbolic links / do an lstat
+	    $new_loc = Follow_SymLink($loc_pref.$FN);
+
+	    # ignore if invalid symlink
+	    next unless defined $new_loc;
+     
+	    if (-d _) {
+		push @Stack,[$new_loc,$dir_loc,$dir_name,$FN,1];
+	    }
+	    else {
+		$fullname = $new_loc;
+		$name = $dir_pref . $FN;
+		$_ = ($no_chdir ? $name : $FN);
+		{ &$wanted_callback }; # protect against wild "next"
+	    }
+	}
+
+    }
+    continue {
+	while (defined($SE = pop @Stack)) {
+	    ($dir_loc, $pdir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
+	    $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
+	    $dir_pref = "$dir_name/";
+	    $loc_pref = "$dir_loc/";
+            if ( $byd_flag < 0 ) {  # must be finddepth, report dirname now
+	        unless ($no_chdir or $dir_rel eq '.') {
+	            my $udir = $pdir_loc;
+	            if ($untaint) {
+		        $udir = $1 if $dir_loc =~ m|$untaint_pat|;
+	            }
+	            unless (chdir $udir) {
+		        warn "Can't cd to $udir: $!\n";
+		        next;
+	            }
+	        }
+	        $fullname = $dir_loc;
+	        $name = $dir_name;
+                if ( substr($name,-2) eq '/.' ) {
+                  $name =~ s|/\.$||;
+                }
+                $dir = $p_dir;
+	        $_ = ($no_chdir ? $dir_name : $dir_rel);
+                if ( substr($_,-2) eq '/.' ) {
+                  s|/\.$||;
+                }
+
+		lstat($_); # make sure  file tests with '_' work
+	        { &$wanted_callback }; # protect against wild "next"
+            } else {
+                push @Stack,[$dir_loc, $pdir_loc, $p_dir, $dir_rel,-1]  if  $bydepth;
+                last;
+            }
+	}
+    }
+}
+
+
+sub wrap_wanted {
+    my $wanted = shift;
+    if ( ref($wanted) eq 'HASH' ) {
+	if ( $wanted->{follow} || $wanted->{follow_fast}) {
+	    $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
+	}
+	if ( $wanted->{untaint} ) {
+	    $wanted->{untaint_pattern} = qr|^([-+@\w./]+)$|  
+		unless defined $wanted->{untaint_pattern};
+	    $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
+	}
+	return $wanted;
+    }
+    else {
+	return { wanted => $wanted };
+    }
+}
+
+sub find {
+    my $wanted = shift;
+    _find_opt(wrap_wanted($wanted), @_);
+    %SLnkSeen= ();  # free memory
+}
+
+sub finddepth {
+    my $wanted = wrap_wanted(shift);
+    $wanted->{bydepth} = 1;
+    _find_opt($wanted, @_);
+    %SLnkSeen= ();  # free memory
+}
+
+# These are hard-coded for now, but may move to hint files.
+if ($^O eq 'VMS') {
+    $Is_VMS = 1;
+    $File::Find::dont_use_nlink = 1;
+}
+
+$File::Find::dont_use_nlink = 1
+    if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
+       $^O eq 'cygwin' || $^O eq 'epoc';
+
+# Set dont_use_nlink in your hint file if your system's stat doesn't
+# report the number of links in a directory as an indication
+# of the number of files.
+# See, e.g. hints/machten.sh for MachTen 2.2.
+unless ($File::Find::dont_use_nlink) {
+    require Config;
+    $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Glob.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Glob.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Glob.pm	(revision 14265)
@@ -0,0 +1,438 @@
+package File::Glob;
+
+use strict;
+use Carp;
+our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS,
+    $AUTOLOAD, $DEFAULT_FLAGS);
+
+require Exporter;
+use XSLoader ();
+require AutoLoader;
+
+@ISA = qw(Exporter AutoLoader);
+
+# NOTE: The glob() export is only here for compatibility with 5.6.0.
+# csh_glob() should not be used directly, unless you know what you're doing.
+
+@EXPORT_OK   = qw(
+    csh_glob
+    bsd_glob
+    glob
+    GLOB_ABEND
+    GLOB_ALPHASORT
+    GLOB_ALTDIRFUNC
+    GLOB_BRACE
+    GLOB_CSH
+    GLOB_ERR
+    GLOB_ERROR
+    GLOB_MARK
+    GLOB_NOCASE
+    GLOB_NOCHECK
+    GLOB_NOMAGIC
+    GLOB_NOSORT
+    GLOB_NOSPACE
+    GLOB_QUOTE
+    GLOB_TILDE
+);
+
+%EXPORT_TAGS = (
+    'glob' => [ qw(
+        GLOB_ABEND
+	GLOB_ALPHASORT
+        GLOB_ALTDIRFUNC
+        GLOB_BRACE
+        GLOB_CSH
+        GLOB_ERR
+        GLOB_ERROR
+        GLOB_MARK
+        GLOB_NOCASE
+        GLOB_NOCHECK
+        GLOB_NOMAGIC
+        GLOB_NOSORT
+        GLOB_NOSPACE
+        GLOB_QUOTE
+        GLOB_TILDE
+        glob
+        bsd_glob
+    ) ],
+);
+
+$VERSION = '0.991';
+
+sub import {
+    my $i = 1;
+    while ($i < @_) {
+	if ($_[$i] =~ /^:(case|nocase|globally)$/) {
+	    splice(@_, $i, 1);
+	    $DEFAULT_FLAGS &= ~GLOB_NOCASE() if $1 eq 'case';
+	    $DEFAULT_FLAGS |= GLOB_NOCASE() if $1 eq 'nocase';
+	    if ($1 eq 'globally') {
+		no warnings;
+		*CORE::GLOBAL::glob = \&File::Glob::csh_glob;
+	    }
+	    next;
+	}
+	++$i;
+    }
+    goto &Exporter::import;
+}
+
+sub AUTOLOAD {
+    # This AUTOLOAD is used to 'autoload' constants from the constant()
+    # XS function.  If a constant is not found then control is passed
+    # to the AUTOLOAD in AutoLoader.
+
+    my $constname;
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+    my $val = constant($constname, @_ ? $_[0] : 0);
+    if ($! != 0) {
+	if ($! =~ /Invalid/) {
+	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
+	    goto &AutoLoader::AUTOLOAD;
+	}
+	else {
+		croak "Your vendor has not defined File::Glob macro $constname";
+	}
+    }
+    eval "sub $AUTOLOAD { $val }";
+    goto &$AUTOLOAD;
+}
+
+XSLoader::load 'File::Glob', $VERSION;
+
+# Preloaded methods go here.
+
+sub GLOB_ERROR {
+    return constant('GLOB_ERROR', 0);
+}
+
+sub GLOB_CSH () {
+    GLOB_BRACE()
+	| GLOB_NOMAGIC()
+	| GLOB_QUOTE()
+	| GLOB_TILDE()
+	| GLOB_ALPHASORT()
+}
+
+$DEFAULT_FLAGS = GLOB_CSH();
+if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
+    $DEFAULT_FLAGS |= GLOB_NOCASE();
+}
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+sub bsd_glob {
+    my ($pat,$flags) = @_;
+    $flags = $DEFAULT_FLAGS if @_ < 2;
+    return doglob($pat,$flags);
+}
+
+# File::Glob::glob() is deprecated because its prototype is different from
+# CORE::glob() (use bsd_glob() instead)
+sub glob {
+    goto &bsd_glob;
+}
+
+## borrowed heavily from gsar's File::DosGlob
+my %iter;
+my %entries;
+
+sub csh_glob {
+    my $pat = shift;
+    my $cxix = shift;
+    my @pat;
+
+    # glob without args defaults to $_
+    $pat = $_ unless defined $pat;
+
+    # extract patterns
+    $pat =~ s/^\s+//;	# Protect against empty elements in
+    $pat =~ s/\s+$//;	# things like < *.c> and <*.c >.
+			# These alone shouldn't trigger ParseWords.
+    if ($pat =~ /\s/) {
+        # XXX this is needed for compatibility with the csh
+	# implementation in Perl.  Need to support a flag
+	# to disable this behavior.
+	require Text::ParseWords;
+	@pat = Text::ParseWords::parse_line('\s+',0,$pat);
+    }
+
+    # assume global context if not provided one
+    $cxix = '_G_' unless defined $cxix;
+    $iter{$cxix} = 0 unless exists $iter{$cxix};
+
+    # if we're just beginning, do it all first
+    if ($iter{$cxix} == 0) {
+	if (@pat) {
+	    $entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pat ];
+	}
+	else {
+	    $entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ];
+	}
+    }
+
+    # chuck it all out, quick or slow
+    if (wantarray) {
+        delete $iter{$cxix};
+        return @{delete $entries{$cxix}};
+    }
+    else {
+        if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
+            return shift @{$entries{$cxix}};
+        }
+        else {
+            # return undef for EOL
+            delete $iter{$cxix};
+            delete $entries{$cxix};
+            return undef;
+        }
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+File::Glob - Perl extension for BSD glob routine
+
+=head1 SYNOPSIS
+
+  use File::Glob ':glob';
+  @list = bsd_glob('*.[ch]');
+  $homedir = bsd_glob('~gnat', GLOB_TILDE | GLOB_ERR);
+  if (GLOB_ERROR) {
+    # an error occurred reading $homedir
+  }
+
+  ## override the core glob (CORE::glob() does this automatically
+  ## by default anyway, since v5.6.0)
+  use File::Glob ':globally';
+  my @sources = <*.{c,h,y}>
+
+  ## override the core glob, forcing case sensitivity
+  use File::Glob qw(:globally :case);
+  my @sources = <*.{c,h,y}>
+
+  ## override the core glob forcing case insensitivity
+  use File::Glob qw(:globally :nocase);
+  my @sources = <*.{c,h,y}>
+
+=head1 DESCRIPTION
+
+File::Glob::bsd_glob() implements the FreeBSD glob(3) routine, which is
+a superset of the POSIX glob() (described in IEEE Std 1003.2 "POSIX.2").
+bsd_glob() takes a mandatory C<pattern> argument, and an optional
+C<flags> argument, and returns a list of filenames matching the
+pattern, with interpretation of the pattern modified by the C<flags>
+variable.
+
+Since v5.6.0, Perl's CORE::glob() is implemented in terms of bsd_glob().
+Note that they don't share the same prototype--CORE::glob() only accepts
+a single argument.  Due to historical reasons, CORE::glob() will also
+split its argument on whitespace, treating it as multiple patterns,
+whereas bsd_glob() considers them as one pattern.
+
+The POSIX defined flags for bsd_glob() are:
+
+=over 4
+
+=item C<GLOB_ERR>
+
+Force bsd_glob() to return an error when it encounters a directory it
+cannot open or read.  Ordinarily bsd_glob() continues to find matches.
+
+=item C<GLOB_MARK>
+
+Each pathname that is a directory that matches the pattern has a slash
+appended.
+
+=item C<GLOB_NOCASE>
+
+By default, file names are assumed to be case sensitive; this flag
+makes bsd_glob() treat case differences as not significant.
+
+=item C<GLOB_NOCHECK>
+
+If the pattern does not match any pathname, then bsd_glob() returns a list
+consisting of only the pattern.  If C<GLOB_QUOTE> is set, its effect
+is present in the pattern returned.
+
+=item C<GLOB_NOSORT>
+
+By default, the pathnames are sorted in ascending ASCII order; this
+flag prevents that sorting (speeding up bsd_glob()).
+
+=back
+
+The FreeBSD extensions to the POSIX standard are the following flags:
+
+=over 4
+
+=item C<GLOB_BRACE>
+
+Pre-process the string to expand C<{pat,pat,...}> strings like csh(1).
+The pattern '{}' is left unexpanded for historical reasons (and csh(1)
+does the same thing to ease typing of find(1) patterns).
+
+=item C<GLOB_NOMAGIC>
+
+Same as C<GLOB_NOCHECK> but it only returns the pattern if it does not
+contain any of the special characters "*", "?" or "[".  C<NOMAGIC> is
+provided to simplify implementing the historic csh(1) globbing
+behaviour and should probably not be used anywhere else.
+
+=item C<GLOB_QUOTE>
+
+Use the backslash ('\') character for quoting: every occurrence of a
+backslash followed by a character in the pattern is replaced by that
+character, avoiding any special interpretation of the character.
+(But see below for exceptions on DOSISH systems).
+
+=item C<GLOB_TILDE>
+
+Expand patterns that start with '~' to user name home directories.
+
+=item C<GLOB_CSH>
+
+For convenience, C<GLOB_CSH> is a synonym for
+C<GLOB_BRACE | GLOB_NOMAGIC | GLOB_QUOTE | GLOB_TILDE | GLOB_ALPHASORT>.
+
+=back
+
+The POSIX provided C<GLOB_APPEND>, C<GLOB_DOOFFS>, and the FreeBSD
+extensions C<GLOB_ALTDIRFUNC>, and C<GLOB_MAGCHAR> flags have not been
+implemented in the Perl version because they involve more complex
+interaction with the underlying C structures.
+
+The following flag has been added in the Perl implementation for
+compatibility with common flavors of csh:
+
+=over 4
+
+=item C<GLOB_ALPHASORT>
+
+If C<GLOB_NOSORT> is not in effect, sort filenames is alphabetical
+order (case does not matter) rather than in ASCII order.
+
+=back
+
+=head1 DIAGNOSTICS
+
+bsd_glob() returns a list of matching paths, possibly zero length.  If an
+error occurred, &File::Glob::GLOB_ERROR will be non-zero and C<$!> will be
+set.  &File::Glob::GLOB_ERROR is guaranteed to be zero if no error occurred,
+or one of the following values otherwise:
+
+=over 4
+
+=item C<GLOB_NOSPACE>
+
+An attempt to allocate memory failed.
+
+=item C<GLOB_ABEND>
+
+The glob was stopped because an error was encountered.
+
+=back
+
+In the case where bsd_glob() has found some matching paths, but is
+interrupted by an error, it will return a list of filenames B<and>
+set &File::Glob::ERROR.
+
+Note that bsd_glob() deviates from POSIX and FreeBSD glob(3) behaviour
+by not considering C<ENOENT> and C<ENOTDIR> as errors - bsd_glob() will
+continue processing despite those errors, unless the C<GLOB_ERR> flag is
+set.
+
+Be aware that all filenames returned from File::Glob are tainted.
+
+=head1 NOTES
+
+=over 4
+
+=item *
+
+If you want to use multiple patterns, e.g. C<bsd_glob "a* b*">, you should
+probably throw them in a set as in C<bsd_glob "{a*,b*}">.  This is because
+the argument to bsd_glob() isn't subjected to parsing by the C shell.
+Remember that you can use a backslash to escape things.
+
+=item *
+
+On DOSISH systems, backslash is a valid directory separator character.
+In this case, use of backslash as a quoting character (via GLOB_QUOTE)
+interferes with the use of backslash as a directory separator. The
+best (simplest, most portable) solution is to use forward slashes for
+directory separators, and backslashes for quoting. However, this does
+not match "normal practice" on these systems. As a concession to user
+expectation, therefore, backslashes (under GLOB_QUOTE) only quote the
+glob metacharacters '[', ']', '{', '}', '-', '~', and backslash itself.
+All other backslashes are passed through unchanged.
+
+=item *
+
+Win32 users should use the real slash.  If you really want to use
+backslashes, consider using Sarathy's File::DosGlob, which comes with
+the standard Perl distribution.
+
+=item *
+
+Mac OS (Classic) users should note a few differences. Since
+Mac OS is not Unix, when the glob code encounters a tilde glob (e.g.
+~user/foo) and the C<GLOB_TILDE> flag is used, it simply returns that
+pattern without doing any expansion.
+
+Glob on Mac OS is case-insensitive by default (if you don't use any
+flags). If you specify any flags at all and still want glob
+to be case-insensitive, you must include C<GLOB_NOCASE> in the flags.
+
+The path separator is ':' (aka colon), not '/' (aka slash). Mac OS users
+should be careful about specifying relative pathnames. While a full path
+always begins with a volume name, a relative pathname should always
+begin with a ':'.  If specifying a volume name only, a trailing ':' is
+required.
+
+=back
+
+=head1 AUTHOR
+
+The Perl interface was written by Nathan Torkington E<lt>gnat@frii.comE<gt>,
+and is released under the artistic license.  Further modifications were
+made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt>, Gurusamy Sarathy
+E<lt>gsar@activestate.comE<gt>, and Thomas Wegner
+E<lt>wegner_thomas@yahoo.comE<gt>.  The C glob code has the
+following copyright:
+
+    Copyright (c) 1989, 1993 The Regents of the University of California.
+    All rights reserved.
+
+    This code is derived from software contributed to Berkeley by
+    Guido van Rossum.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+    3. Neither the name of the University nor the names of its contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+    ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+    IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+    ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+    FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+    OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+    SUCH DAMAGE.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Path.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Path.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Path.pm	(revision 14265)
@@ -0,0 +1,251 @@
+package File::Path;
+
+=head1 NAME
+
+File::Path - create or remove directory trees
+
+=head1 SYNOPSIS
+
+    use File::Path;
+
+    mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
+    rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
+
+=head1 DESCRIPTION
+
+The C<mkpath> function provides a convenient way to create directories, even
+if your C<mkdir> kernel call won't create more than one level of directory at
+a time.  C<mkpath> takes three arguments:
+
+=over 4
+
+=item *
+
+the name of the path to create, or a reference
+to a list of paths to create,
+
+=item *
+
+a boolean value, which if TRUE will cause C<mkpath>
+to print the name of each directory as it is created
+(defaults to FALSE), and
+
+=item *
+
+the numeric mode to use when creating the directories
+(defaults to 0777)
+
+=back
+
+It returns a list of all directories (including intermediates, determined
+using the Unix '/' separator) created.
+
+Similarly, the C<rmtree> function provides a convenient way to delete a
+subtree from the directory structure, much like the Unix command C<rm -r>.
+C<rmtree> takes three arguments:
+
+=over 4
+
+=item *
+
+the root of the subtree to delete, or a reference to
+a list of roots.  All of the files and directories
+below each root, as well as the roots themselves,
+will be deleted.
+
+=item *
+
+a boolean value, which if TRUE will cause C<rmtree> to
+print a message each time it examines a file, giving the
+name of the file, and indicating whether it's using C<rmdir>
+or C<unlink> to remove it, or that it's skipping it.
+(defaults to FALSE)
+
+=item *
+
+a boolean value, which if TRUE will cause C<rmtree> to
+skip any files to which you do not have delete access
+(if running under VMS) or write access (if running
+under another OS).  This will change in the future when
+a criterion for 'delete permission' under OSs other
+than VMS is settled.  (defaults to FALSE)
+
+=back
+
+It returns the number of files successfully deleted.  Symlinks are
+simply deleted and not followed.
+
+B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
+in the face of failure or interruption.  Files and directories which
+were not deleted may be left with permissions reset to allow world
+read and write access.  Note also that the occurrence of errors in
+rmtree can be determined I<only> by trapping diagnostic messages
+using C<$SIG{__WARN__}>; it is not apparent from the return value.
+Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0>
+in situations where security is an issue.
+
+=head1 AUTHORS
+
+Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
+Charles Bailey <F<bailey@newman.upenn.edu>>
+
+=cut
+
+use 5.005_64;
+use Carp;
+use File::Basename ();
+use Exporter ();
+use strict;
+
+our $VERSION = "1.0404";
+our @ISA = qw( Exporter );
+our @EXPORT = qw( mkpath rmtree );
+
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MacOS = $^O eq 'MacOS';
+
+# These OSes complain if you want to remove a file that you have no
+# write permission to:
+my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' ||
+		       $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc');
+
+sub mkpath {
+    my($paths, $verbose, $mode) = @_;
+    # $paths   -- either a path string or ref to list of paths
+    # $verbose -- optional print "mkdir $path" for each directory created
+    # $mode    -- optional permissions, defaults to 0777
+    local($")=$Is_MacOS ? ":" : "/";
+    $mode = 0777 unless defined($mode);
+    $paths = [$paths] unless ref $paths;
+    my(@created,$path);
+    foreach $path (@$paths) {
+	$path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT 
+	# Logic wants Unix paths, so go with the flow.
+	if ($Is_VMS) {
+	    next if $path eq '/';
+	    $path = VMS::Filespec::unixify($path);
+	    if ($path =~ m:^(/[^/]+)/?\z:) {
+	        $path = $1.'/000000';
+	    }
+	}
+	next if -d $path;
+	my $parent = File::Basename::dirname($path);
+	unless (-d $parent or $path eq $parent) {
+	    push(@created,mkpath($parent, $verbose, $mode));
+ 	}
+	print "mkdir $path\n" if $verbose;
+	unless (mkdir($path,$mode)) {
+	    my $e = $!;
+	    # allow for another process to have created it meanwhile
+	    croak "mkdir $path: $e" unless -d $path;
+	}
+	push(@created, $path);
+    }
+    @created;
+}
+
+sub rmtree {
+    my($roots, $verbose, $safe) = @_;
+    my(@files);
+    my($count) = 0;
+    $verbose ||= 0;
+    $safe ||= 0;
+
+    if ( defined($roots) && length($roots) ) {
+      $roots = [$roots] unless ref $roots;
+    }
+    else {
+      carp "No root path(s) specified\n";
+      return 0;
+    }
+
+    my($root);
+    foreach $root (@{$roots}) {
+    	if ($Is_MacOS) {
+	    $root = ":$root" if $root !~ /:/;
+	    $root =~ s#([^:])\z#$1:#;
+	} else {
+	    $root =~ s#/\z##;
+	}
+	(undef, undef, my $rp) = lstat $root or next;
+	$rp &= 07777;	# don't forget setuid, setgid, sticky bits
+	if ( -d _ ) {
+	    # notabene: 0777 is for making readable in the first place,
+	    # it's also intended to change it to writable in case we have
+	    # to recurse in which case we are better than rm -rf for 
+	    # subtrees with strange permissions
+	    chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+	      or carp "Can't make directory $root read+writeable: $!"
+		unless $safe;
+
+	    if (opendir my $d, $root) {
+		@files = readdir $d;
+		closedir $d;
+	    }
+	    else {
+	        carp "Can't read $root: $!";
+		@files = ();
+	    }
+
+	    # Deleting large numbers of files from VMS Files-11 filesystems
+	    # is faster if done in reverse ASCIIbetical order 
+	    @files = reverse @files if $Is_VMS;
+	    ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
+	    if ($Is_MacOS) {
+		@files = map("$root$_", @files);
+	    } else {
+		@files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
+	    }
+	    $count += rmtree(\@files,$verbose,$safe);
+	    if ($safe &&
+		($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
+		print "skipped $root\n" if $verbose;
+		next;
+	    }
+	    chmod 0777, $root
+	      or carp "Can't make directory $root writeable: $!"
+		if $force_writeable;
+	    print "rmdir $root\n" if $verbose;
+	    if (rmdir $root) {
+		++$count;
+	    }
+	    else {
+		carp "Can't remove directory $root: $!";
+		chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+		    or carp("and can't restore permissions to "
+		            . sprintf("0%o",$rp) . "\n");
+	    }
+	}
+	else { 
+	    if ($safe &&
+		($Is_VMS ? !&VMS::Filespec::candelete($root)
+		         : !(-l $root || -w $root)))
+	    {
+		print "skipped $root\n" if $verbose;
+		next;
+	    }
+	    chmod 0666, $root
+	      or carp "Can't make file $root writeable: $!"
+		if $force_writeable;
+	    print "unlink $root\n" if $verbose;
+	    # delete all versions under VMS
+	    for (;;) {
+		unless (unlink $root) {
+		    carp "Can't unlink file $root: $!";
+		    if ($force_writeable) {
+			chmod $rp, $root
+			    or carp("and can't restore permissions to "
+			            . sprintf("0%o",$rp) . "\n");
+		    }
+		    last;
+		}
+		++$count;
+		last unless $Is_VMS && lstat $root;
+	    }
+	}
+    }
+
+    $count;
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Spec.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Spec.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Spec.pm	(revision 14265)
@@ -0,0 +1,93 @@
+package File::Spec;
+
+use strict;
+use vars qw(@ISA $VERSION);
+
+$VERSION = 0.82 ;
+
+my %module = (MacOS   => 'Mac',
+	      MSWin32 => 'Win32',
+	      os2     => 'OS2',
+	      VMS     => 'VMS',
+	      epoc    => 'Epoc');
+
+my $module = $module{$^O} || 'Unix';
+require "File/Spec/$module.pm";
+@ISA = ("File::Spec::$module");
+
+1;
+__END__
+
+=head1 NAME
+
+File::Spec - portably perform operations on file names
+
+=head1 SYNOPSIS
+
+	use File::Spec;
+
+	$x=File::Spec->catfile('a', 'b', 'c');
+
+which returns 'a/b/c' under Unix. Or:
+
+	use File::Spec::Functions;
+
+	$x = catfile('a', 'b', 'c');
+
+=head1 DESCRIPTION
+
+This module is designed to support operations commonly performed on file
+specifications (usually called "file names", but not to be confused with the
+contents of a file, or Perl's file handles), such as concatenating several
+directory and file names into a single path, or determining whether a path
+is rooted. It is based on code directly taken from MakeMaker 5.17, code
+written by Andreas KE<ouml>nig, Andy Dougherty, Charles Bailey, Ilya
+Zakharevich, Paul Schinder, and others.
+
+Since these functions are different for most operating systems, each set of
+OS specific routines is available in a separate module, including:
+
+	File::Spec::Unix
+	File::Spec::Mac
+	File::Spec::OS2
+	File::Spec::Win32
+	File::Spec::VMS
+
+The module appropriate for the current OS is automatically loaded by
+File::Spec. Since some modules (like VMS) make use of facilities available
+only under that OS, it may not be possible to load all modules under all
+operating systems.
+
+Since File::Spec is object oriented, subroutines should not called directly,
+as in:
+
+	File::Spec::catfile('a','b');
+
+but rather as class methods:
+
+	File::Spec->catfile('a','b');
+
+For simple uses, L<File::Spec::Functions> provides convenient functional
+forms of these methods.
+
+For a list of available methods, please consult L<File::Spec::Unix>,
+which contains the entire set, and which is inherited by the modules for
+other platforms. For further information, please see L<File::Spec::Mac>,
+L<File::Spec::OS2>, L<File::Spec::Win32>, or L<File::Spec::VMS>.
+
+=head1 SEE ALSO
+
+File::Spec::Unix, File::Spec::Mac, File::Spec::OS2, File::Spec::Win32,
+File::Spec::VMS, File::Spec::Functions, ExtUtils::MakeMaker
+
+=head1 AUTHORS
+
+Kenneth Albanowski <F<kjahds@kjahds.com>>, Andy Dougherty
+<F<doughera@lafcol.lafayette.edu>>, Andreas KE<ouml>nig
+<F<A.Koenig@franz.ww.TU-Berlin.DE>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>. VMS
+support by Charles Bailey <F<bailey@newman.upenn.edu>>.  OS/2 support by
+Ilya Zakharevich <F<ilya@math.ohio-state.edu>>. Mac support by Paul Schinder
+<F<schinder@pobox.com>>.  abs2rel() and rel2abs() written by
+Shigio Yamaguchi <F<shigio@tamacom.com>>, modified by Barrie Slaymaker
+<F<barries@slaysys.com>>.  splitpath(), splitdir(), catpath() and catdir()
+by Barrie Slaymaker.
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Epoc.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Epoc.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Epoc.pm	(revision 14265)
@@ -0,0 +1,378 @@
+package File::Spec::Epoc;
+
+use strict;
+use Cwd;
+use vars qw(@ISA);
+require File::Spec::Unix;
+@ISA = qw(File::Spec::Unix);
+
+=head1 NAME
+
+File::Spec::Epoc - methods for Epoc file specs
+
+=head1 SYNOPSIS
+
+ require File::Spec::Epoc; # Done internally by File::Spec if needed
+
+=head1 DESCRIPTION
+
+See File::Spec::Unix for a documentation of the methods provided
+there. This package overrides the implementation of these methods, not
+the semantics.
+
+This package is still work in progress ;-)
+o.flebbe@gmx.de
+
+
+=over
+
+=item devnull
+
+Returns a string representation of the null device.
+
+=cut
+
+sub devnull {
+    return "nul:";
+}
+
+=item tmpdir
+
+Returns a string representation of a temporay directory:
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    return "C:/System/temp";
+}
+
+sub case_tolerant {
+    return 1;
+}
+
+sub file_name_is_absolute {
+    my ($self,$file) = @_;
+    return scalar($file =~ m{^([a-z?]:)?[\\/]}is);
+}
+
+=item path
+
+Takes no argument, returns the environment variable PATH as an array. Since
+there is no search path supported, it returns undef, sorry.
+
+=cut
+sub path {
+    return undef;
+}
+
+=item canonpath
+
+No physical check on the filesystem, but a logical cleanup of a
+path. On UNIX eliminated successive slashes and successive "/.".
+
+=cut
+
+sub canonpath {
+    my ($self,$path) = @_;
+    $path =~ s/^([a-z]:)/\u$1/s;
+
+    $path =~ s|/+|/|g unless($^O eq 'cygwin');     # xx////xx  -> xx/xx
+    $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
+    $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
+    $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
+    $path =~ s|/\z|| unless $path eq "/";          # xx/       -> xx
+    return $path;
+}
+
+=item splitpath
+
+    ($volume,$directories,$file) = File::Spec->splitpath( $path );
+    ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+Splits a path in to volume, directory, and filename portions. Assumes that 
+the last file is a path unless the path ends in '\\', '\\.', '\\..'
+or $no_file is true.  On Win32 this means that $no_file true makes this return 
+( $volume, $path, undef ).
+
+Separators accepted are \ and /.
+
+The results can be passed to L</catpath> to get back a path equivalent to
+(usually identical to) the original path.
+
+=cut
+
+sub splitpath {
+    my ($self,$path, $nofile) = @_;
+    my ($volume,$directory,$file) = ('','','');
+    if ( $nofile ) {
+        $path =~ 
+            m{^( (?:[a-zA-Z?]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) 
+                 (.*)
+             }xs;
+        $volume    = $1;
+        $directory = $2;
+    }
+    else {
+        $path =~ 
+            m{^ ( (?: [a-zA-Z?]: |
+                      (?:\\\\|//)[^\\/]+[\\/][^\\/]+
+                  )?
+                )
+                ( (?:.*[\\\\/](?:\.\.?\z)?)? )
+                (.*)
+             }xs;
+        $volume    = $1;
+        $directory = $2;
+        $file      = $3;
+    }
+
+    return ($volume,$directory,$file);
+}
+
+
+=item splitdir
+
+The opposite of L</catdir()>.
+
+    @dirs = File::Spec->splitdir( $directories );
+
+$directories must be only the directory portion of the path on systems 
+that have the concept of a volume or that have path syntax that differentiates
+files from directories.
+
+Unlike just splitting the directories on the separator, leading empty and 
+trailing directory entries can be returned, because these are significant
+on some OSs. So,
+
+    File::Spec->splitdir( "/a/b/c" );
+
+Yields:
+
+    ( '', 'a', 'b', '', 'c', '' )
+
+=cut
+
+sub splitdir {
+    my ($self,$directories) = @_ ;
+    #
+    # split() likes to forget about trailing null fields, so here we
+    # check to be sure that there will not be any before handling the
+    # simple case.
+    #
+    if ( $directories !~ m|[\\/]\z| ) {
+        return split( m|[\\/]|, $directories );
+    }
+    else {
+        #
+        # since there was a trailing separator, add a file name to the end, 
+        # then do the split, then replace it with ''.
+        #
+        my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
+        $directories[ $#directories ]= '' ;
+        return @directories ;
+    }
+}
+
+
+=item catpath
+
+Takes volume, directory and file portions and returns an entire path. Under
+Unix, $volume is ignored, and this is just like catfile(). On other OSs,
+the $volume become significant.
+
+=cut
+
+sub catpath {
+    my ($self,$volume,$directory,$file) = @_;
+
+    # If it's UNC, make sure the glue separator is there, reusing
+    # whatever separator is first in the $volume
+    $volume .= $1
+        if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\z@s &&
+             $directory =~ m@^[^\\/]@s
+           ) ;
+
+    $volume .= $directory ;
+
+    # If the volume is not just A:, make sure the glue separator is 
+    # there, reusing whatever separator is first in the $volume if possible.
+    if ( $volume !~ m@^[a-zA-Z]:\z@s &&
+         $volume =~ m@[^\\/]\z@      &&
+         $file   =~ m@[^\\/]@
+       ) {
+        $volume =~ m@([\\/])@ ;
+        my $sep = $1 ? $1 : '\\' ;
+        $volume .= $sep ;
+    }
+
+    $volume .= $file ;
+
+    return $volume ;
+}
+
+
+=item abs2rel
+
+Takes a destination path and an optional base path returns a relative path
+from the base path to the destination path:
+
+    $rel_path = File::Spec->abs2rel( $destination ) ;
+    $rel_path = File::Spec->abs2rel( $destination, $base ) ;
+
+If $base is not present or '', then L</cwd()> is used. If $base is relative, 
+then it is converted to absolute form using L</rel2abs()>. This means that it
+is taken to be relative to L<cwd()>.
+
+On systems with the concept of a volume, this assumes that both paths 
+are on the $destination volume, and ignores the $base volume.
+
+On systems that have a grammar that indicates filenames, this ignores the 
+$base filename as well. Otherwise all path components are assumed to be
+directories.
+
+If $path is relative, it is converted to absolute form using L</rel2abs()>.
+This means that it is taken to be relative to L</cwd()>.
+
+Based on code written by Shigio Yamaguchi.
+
+No checks against the filesystem are made. 
+
+=cut
+
+sub abs2rel {
+    my($self,$path,$base) = @_;
+
+    # Clean up $path
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+        $path = $self->rel2abs( $path ) ;
+    }
+    else {
+        $path = $self->canonpath( $path ) ;
+    }
+
+    # Figure out the effective $base and clean it up.
+    if ( ! $self->file_name_is_absolute( $base ) ) {
+        $base = $self->rel2abs( $base ) ;
+    }
+    elsif ( !defined( $base ) || $base eq '' ) {
+        $base = cwd() ;
+    }
+    else {
+        $base = $self->canonpath( $base ) ;
+    }
+
+    # Split up paths
+    my ( $path_volume, $path_directories, $path_file ) =
+        $self->splitpath( $path, 1 ) ;
+
+    my ( undef, $base_directories, undef ) =
+        $self->splitpath( $base, 1 ) ;
+
+    # Now, remove all leading components that are the same
+    my @pathchunks = $self->splitdir( $path_directories );
+    my @basechunks = $self->splitdir( $base_directories );
+
+    while ( @pathchunks && 
+            @basechunks && 
+            lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 
+          ) {
+        shift @pathchunks ;
+        shift @basechunks ;
+    }
+
+    # No need to catdir, we know these are well formed.
+    $path_directories = CORE::join( '\\', @pathchunks );
+    $base_directories = CORE::join( '\\', @basechunks );
+
+    # $base_directories now contains the directories the resulting relative
+    # path must ascend out of before it can descend to $path_directory.  So, 
+    # replace all names with $parentDir
+
+    #FA Need to replace between backslashes...
+    $base_directories =~ s|[^\\]+|..|g ;
+
+    # Glue the two together, using a separator if necessary, and preventing an
+    # empty result.
+
+    #FA Must check that new directories are not empty.
+    if ( $path_directories ne '' && $base_directories ne '' ) {
+        $path_directories = "$base_directories\\$path_directories" ;
+    } else {
+        $path_directories = "$base_directories$path_directories" ;
+    }
+
+    # It makes no sense to add a relative path to a UNC volume
+    $path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ;
+
+    return $self->canonpath( 
+        $self->catpath($path_volume, $path_directories, $path_file ) 
+    ) ;
+}
+
+=item rel2abs
+
+Converts a relative path to an absolute path. 
+
+    $abs_path = File::Spec->rel2abs( $destination ) ;
+    $abs_path = File::Spec->rel2abs( $destination, $base ) ;
+
+If $base is not present or '', then L<cwd()> is used. If $base is relative, 
+then it is converted to absolute form using L</rel2abs()>. This means that it
+is taken to be relative to L</cwd()>.
+
+Assumes that both paths are on the $base volume, and ignores the 
+$destination volume. 
+
+On systems that have a grammar that indicates filenames, this ignores the 
+$base filename as well. Otherwise all path components are assumed to be
+directories.
+
+If $path is absolute, it is cleaned up and returned using L</canonpath()>.
+
+Based on code written by Shigio Yamaguchi.
+
+No checks against the filesystem are made. 
+
+=cut
+
+sub rel2abs($;$;) {
+    my ($self,$path,$base ) = @_;
+
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+
+        if ( !defined( $base ) || $base eq '' ) {
+            $base = cwd() ;
+        }
+        elsif ( ! $self->file_name_is_absolute( $base ) ) {
+            $base = $self->rel2abs( $base ) ;
+        }
+        else {
+            $base = $self->canonpath( $base ) ;
+        }
+
+        my ( undef, $path_directories, $path_file ) =
+            $self->splitpath( $path, 1 ) ;
+
+        my ( $base_volume, $base_directories, undef ) =
+            $self->splitpath( $base, 1 ) ;
+
+        $path = $self->catpath( 
+            $base_volume, 
+            $self->catdir( $base_directories, $path_directories ), 
+            $path_file
+        ) ;
+    }
+
+    return $self->canonpath( $path ) ;
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<File::Spec>
+
+=cut
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Functions.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Functions.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Functions.pm	(revision 14265)
@@ -0,0 +1,97 @@
+package File::Spec::Functions;
+
+use File::Spec;
+use strict;
+
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
+
+$VERSION = '1.1';
+
+require Exporter;
+
+@ISA = qw(Exporter);
+
+@EXPORT = qw(
+	canonpath
+	catdir
+	catfile
+	curdir
+	rootdir
+	updir
+	no_upwards
+	file_name_is_absolute
+	path
+);
+
+@EXPORT_OK = qw(
+	devnull
+	tmpdir
+	splitpath
+	splitdir
+	catpath
+	abs2rel
+	rel2abs
+);
+
+%EXPORT_TAGS = ( ALL => [ @EXPORT_OK, @EXPORT ] );
+
+foreach my $meth (@EXPORT, @EXPORT_OK) {
+    my $sub = File::Spec->can($meth);
+    no strict 'refs';
+    *{$meth} = sub {&$sub('File::Spec', @_)};
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+File::Spec::Functions - portably perform operations on file names
+
+=head1 SYNOPSIS
+
+	use File::Spec::Functions;
+	$x = catfile('a','b');
+
+=head1 DESCRIPTION
+
+This module exports convenience functions for all of the class methods
+provided by File::Spec.
+
+For a reference of available functions, please consult L<File::Spec::Unix>,
+which contains the entire set, and which is inherited by the modules for
+other platforms. For further information, please see L<File::Spec::Mac>,
+L<File::Spec::OS2>, L<File::Spec::Win32>, or L<File::Spec::VMS>.
+
+=head2 Exports
+
+The following functions are exported by default.
+
+	canonpath
+	catdir
+	catfile
+	curdir
+	rootdir
+	updir
+	no_upwards
+	file_name_is_absolute
+	path
+
+
+The following functions are exported only by request.
+
+	devnull
+	tmpdir
+	splitpath
+	splitdir
+	catpath
+	abs2rel
+	rel2abs
+
+All the functions may be imported using the C<:ALL> tag.
+
+=head1 SEE ALSO
+
+File::Spec, File::Spec::Unix, File::Spec::Mac, File::Spec::OS2,
+File::Spec::Win32, File::Spec::VMS, ExtUtils::MakeMaker
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Mac.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Mac.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Mac.pm	(revision 14265)
@@ -0,0 +1,394 @@
+package File::Spec::Mac;
+
+use strict;
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '1.2';
+
+@ISA = qw(File::Spec::Unix);
+
+=head1 NAME
+
+File::Spec::Mac - File::Spec for MacOS
+
+=head1 SYNOPSIS
+
+ require File::Spec::Mac; # Done internally by File::Spec if needed
+
+=head1 DESCRIPTION
+
+Methods for manipulating file specifications.
+
+=head1 METHODS
+
+=over 2
+
+=item canonpath
+
+On MacOS, there's nothing to be done.  Returns what it's given.
+
+=cut
+
+sub canonpath {
+    my ($self,$path) = @_;
+    return $path;
+}
+
+=item catdir
+
+Concatenate two or more directory names to form a complete path ending with 
+a directory.  Put a trailing : on the end of the complete path if there 
+isn't one, because that's what's done in MacPerl's environment.
+
+The fundamental requirement of this routine is that
+
+	  File::Spec->catdir(split(":",$path)) eq $path
+
+But because of the nature of Macintosh paths, some additional 
+possibilities are allowed to make using this routine give reasonable results 
+for some common situations.  Here are the rules that are used.  Each 
+argument has its trailing ":" removed.  Each argument, except the first,
+has its leading ":" removed.  They are then joined together by a ":".
+
+So
+
+	  File::Spec->catdir("a","b") = "a:b:"
+	  File::Spec->catdir("a:",":b") = "a:b:"
+	  File::Spec->catdir("a:","b") = "a:b:"
+	  File::Spec->catdir("a",":b") = "a:b"
+	  File::Spec->catdir("a","","b") = "a::b"
+
+etc.
+
+To get a relative path (one beginning with :), begin the first argument with :
+or put a "" as the first argument.
+
+If you don't want to worry about these rules, never allow a ":" on the ends 
+of any of the arguments except at the beginning of the first.
+
+Under MacPerl, there is an additional ambiguity.  Does the user intend that
+
+	  File::Spec->catfile("LWP","Protocol","http.pm")
+
+be relative or absolute?  There's no way of telling except by checking for the
+existence of LWP: or :LWP, and even there he may mean a dismounted volume or
+a relative path in a different directory (like in @INC).   So those checks
+aren't done here. This routine will treat this as absolute.
+
+=cut
+
+sub catdir {
+    shift;
+    my @args = @_;
+    my $result = shift @args;
+    $result =~ s/:\Z(?!\n)//;
+    foreach (@args) {
+	s/:\Z(?!\n)//;
+	s/^://s;
+	$result .= ":$_";
+    }
+    return "$result:";
+}
+
+=item catfile
+
+Concatenate one or more directory names and a filename to form a
+complete path ending with a filename.  Since this uses catdir, the
+same caveats apply.  Note that the leading : is removed from the filename,
+so that 
+
+	  File::Spec->catfile($ENV{HOME},"file");
+
+and
+
+	  File::Spec->catfile($ENV{HOME},":file");
+
+give the same answer, as one might expect.
+
+=cut
+
+sub catfile {
+    my $self = shift;
+    my $file = pop @_;
+    return $file unless @_;
+    my $dir = $self->catdir(@_);
+    $file =~ s/^://s;
+    return $dir.$file;
+}
+
+=item curdir
+
+Returns a string representing the current directory.
+
+=cut
+
+sub curdir {
+    return ":";
+}
+
+=item devnull
+
+Returns a string representing the null device.
+
+=cut
+
+sub devnull {
+    return "Dev:Null";
+}
+
+=item rootdir
+
+Returns a string representing the root directory.  Under MacPerl,
+returns the name of the startup volume, since that's the closest in
+concept, although other volumes aren't rooted there.
+
+=cut
+
+sub rootdir {
+#
+#  There's no real root directory on MacOS.  The name of the startup
+#  volume is returned, since that's the closest in concept.
+#
+    require Mac::Files;
+    my $system =  Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
+					 &Mac::Files::kSystemFolderType);
+    $system =~ s/:.*\Z(?!\n)/:/s;
+    return $system;
+}
+
+=item tmpdir
+
+Returns a string representation of the first existing directory
+from the following list or '' if none exist:
+
+    $ENV{TMPDIR}
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    $tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR};
+    $tmpdir = '' unless defined $tmpdir;
+    return $tmpdir;
+}
+
+=item updir
+
+Returns a string representing the parent directory.
+
+=cut
+
+sub updir {
+    return "::";
+}
+
+=item file_name_is_absolute
+
+Takes as argument a path and returns true, if it is an absolute path.  In 
+the case where a name can be either relative or absolute (for example, a 
+folder named "HD" in the current working directory on a drive named "HD"), 
+relative wins.  Use ":" in the appropriate place in the path if you want to
+distinguish unambiguously.
+
+As a special case, the file name '' is always considered to be absolute.
+
+=cut
+
+sub file_name_is_absolute {
+    my ($self,$file) = @_;
+    if ($file =~ /:/) {
+	return ($file !~ m/^:/s);
+    } elsif ( $file eq '' ) {
+        return 1 ;
+    } else {
+	return (! -e ":$file");
+    }
+}
+
+=item path
+
+Returns the null list for the MacPerl application, since the concept is 
+usually meaningless under MacOS. But if you're using the MacPerl tool under 
+MPW, it gives back $ENV{Commands} suitably split, as is done in 
+:lib:ExtUtils:MM_Mac.pm.
+
+=cut
+
+sub path {
+#
+#  The concept is meaningless under the MacPerl application.
+#  Under MPW, it has a meaning.
+#
+    return unless exists $ENV{Commands};
+    return split(/,/, $ENV{Commands});
+}
+
+=item splitpath
+
+=cut
+
+sub splitpath {
+    my ($self,$path, $nofile) = @_;
+
+    my ($volume,$directory,$file) = ('','','');
+
+    if ( $nofile ) {
+        ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|\Z(?!\n)))?)(.*)@s;
+    }
+    else {
+        $path =~ 
+            m@^( (?: [^:]+: )? ) 
+                ( (?: .*: )? )
+                ( .* )
+             @xs;
+        $volume    = $1;
+        $directory = $2;
+        $file      = $3;
+    }
+
+    # Make sure non-empty volumes and directories end in ':'
+    $volume    .= ':' if $volume    =~ m@[^:]\Z(?!\n)@ ;
+    $directory .= ':' if $directory =~ m@[^:]\Z(?!\n)@ ;
+    return ($volume,$directory,$file);
+}
+
+
+=item splitdir
+
+=cut
+
+sub splitdir {
+    my ($self,$directories) = @_ ;
+    #
+    # split() likes to forget about trailing null fields, so here we
+    # check to be sure that there will not be any before handling the
+    # simple case.
+    #
+    if ( $directories !~ m@:\Z(?!\n)@ ) {
+        return split( m@:@, $directories );
+    }
+    else {
+        #
+        # since there was a trailing separator, add a file name to the end, 
+        # then do the split, then replace it with ''.
+        #
+        my( @directories )= split( m@:@, "${directories}dummy" ) ;
+        $directories[ $#directories ]= '' ;
+        return @directories ;
+    }
+}
+
+
+=item catpath
+
+=cut
+
+sub catpath {
+    my $self = shift ;
+
+    my $result = shift ;
+    $result =~ s@^([^/])@/$1@s ;
+
+    my $segment ;
+    for $segment ( @_ ) {
+        if ( $result =~ m@[^/]\Z(?!\n)@ && $segment =~ m@^[^/]@s ) {
+            $result .= "/$segment" ;
+        }
+        elsif ( $result =~ m@/\Z(?!\n)@ && $segment =~ m@^/@s ) {
+            $result  =~ s@/+\Z(?!\n)@/@;
+            $segment =~ s@^/+@@s;
+            $result  .= "$segment" ;
+        }
+        else {
+            $result  .= $segment ;
+        }
+    }
+
+    return $result ;
+}
+
+=item abs2rel
+
+See L<File::Spec::Unix/abs2rel> for general documentation.
+
+Unlike C<File::Spec::Unix->abs2rel()>, this function will make
+checks against the local filesystem if necessary.  See
+L</file_name_is_absolute> for details.
+
+=cut
+
+sub abs2rel {
+    my($self,$path,$base) = @_;
+
+    # Clean up $path
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+        $path = $self->rel2abs( $path ) ;
+    }
+
+    # Figure out the effective $base and clean it up.
+    if ( !defined( $base ) || $base eq '' ) {
+        $base = cwd() ;
+    }
+    elsif ( ! $self->file_name_is_absolute( $base ) ) {
+        $base = $self->rel2abs( $base ) ;
+    }
+
+    # Now, remove all leading components that are the same
+    my @pathchunks = $self->splitdir( $path );
+    my @basechunks = $self->splitdir( $base );
+
+    while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
+        shift @pathchunks ;
+        shift @basechunks ;
+    }
+
+    $path = join( ':', @pathchunks );
+
+    # @basechunks now contains the number of directories to climb out of.
+    $base = ':' x @basechunks ;
+
+    return "$base:$path" ;
+}
+
+=item rel2abs
+
+See L<File::Spec::Unix/rel2abs> for general documentation.
+
+Unlike C<File::Spec::Unix->rel2abs()>, this function will make
+checks against the local filesystem if necessary.  See
+L</file_name_is_absolute> for details.
+
+=cut
+
+sub rel2abs {
+    my ($self,$path,$base ) = @_;
+
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+        if ( !defined( $base ) || $base eq '' ) {
+            $base = cwd() ;
+        }
+        elsif ( ! $self->file_name_is_absolute( $base ) ) {
+            $base = $self->rel2abs( $base ) ;
+        }
+        else {
+            $base = $self->canonpath( $base ) ;
+        }
+
+        $path = $self->canonpath("$base$path") ;
+    }
+
+    return $path ;
+}
+
+
+=back
+
+=head1 SEE ALSO
+
+L<File::Spec>
+
+=cut
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Spec/OS2.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Spec/OS2.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Spec/OS2.pm	(revision 14265)
@@ -0,0 +1,62 @@
+package File::Spec::OS2;
+
+use strict;
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '1.1';
+
+@ISA = qw(File::Spec::Unix);
+
+sub devnull {
+    return "/dev/nul";
+}
+
+sub case_tolerant {
+    return 1;
+}
+
+sub file_name_is_absolute {
+    my ($self,$file) = @_;
+    return scalar($file =~ m{^([a-z]:)?[\\/]}is);
+}
+
+sub path {
+    my $path = $ENV{PATH};
+    $path =~ s:\\:/:g;
+    my @path = split(';',$path);
+    foreach (@path) { $_ = '.' if $_ eq '' }
+    return @path;
+}
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    my $self = shift;
+    foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)) {
+	next unless defined && -d;
+	$tmpdir = $_;
+	last;
+    }
+    $tmpdir = '' unless defined $tmpdir;
+    $tmpdir =~ s:\\:/:g;
+    $tmpdir = $self->canonpath($tmpdir);
+    return $tmpdir;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+File::Spec::OS2 - methods for OS/2 file specs
+
+=head1 SYNOPSIS
+
+ require File::Spec::OS2; # Done internally by File::Spec if needed
+
+=head1 DESCRIPTION
+
+See File::Spec::Unix for a documentation of the methods provided
+there. This package overrides the implementation of these methods, not
+the semantics.
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Unix.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Unix.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Unix.pm	(revision 14265)
@@ -0,0 +1,458 @@
+package File::Spec::Unix;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '1.2';
+
+use Cwd;
+
+=head1 NAME
+
+File::Spec::Unix - methods used by File::Spec
+
+=head1 SYNOPSIS
+
+ require File::Spec::Unix; # Done automatically by File::Spec
+
+=head1 DESCRIPTION
+
+Methods for manipulating file specifications.
+
+=head1 METHODS
+
+=over 2
+
+=item canonpath
+
+No physical check on the filesystem, but a logical cleanup of a
+path. On UNIX eliminated successive slashes and successive "/.".
+
+    $cpath = File::Spec->canonpath( $path ) ;
+
+=cut
+
+sub canonpath {
+    my ($self,$path) = @_;
+    $path =~ s|/+|/|g unless($^O eq 'cygwin');     # xx////xx  -> xx/xx
+    $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
+    $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
+    $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
+    $path =~ s|/\Z(?!\n)|| unless $path eq "/";          # xx/       -> xx
+    return $path;
+}
+
+=item catdir
+
+Concatenate two or more directory names to form a complete path ending
+with a directory. But remove the trailing slash from the resulting
+string, because it doesn't look good, isn't necessary and confuses
+OS2. Of course, if this is the root directory, don't cut off the
+trailing slash :-)
+
+=cut
+
+sub catdir {
+    my $self = shift;
+    my @args = @_;
+    foreach (@args) {
+	# append a slash to each argument unless it has one there
+	$_ .= "/" if $_ eq '' || substr($_,-1) ne "/";
+    }
+    return $self->canonpath(join('', @args));
+}
+
+=item catfile
+
+Concatenate one or more directory names and a filename to form a
+complete path ending with a filename
+
+=cut
+
+sub catfile {
+    my $self = shift;
+    my $file = pop @_;
+    return $file unless @_;
+    my $dir = $self->catdir(@_);
+    $dir .= "/" unless substr($dir,-1) eq "/";
+    return $dir.$file;
+}
+
+=item curdir
+
+Returns a string representation of the current directory.  "." on UNIX.
+
+=cut
+
+sub curdir {
+    return ".";
+}
+
+=item devnull
+
+Returns a string representation of the null device. "/dev/null" on UNIX.
+
+=cut
+
+sub devnull {
+    return "/dev/null";
+}
+
+=item rootdir
+
+Returns a string representation of the root directory.  "/" on UNIX.
+
+=cut
+
+sub rootdir {
+    return "/";
+}
+
+=item tmpdir
+
+Returns a string representation of the first writable directory
+from the following list or "" if none are writable:
+
+    $ENV{TMPDIR}
+    /tmp
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    foreach ($ENV{TMPDIR}, "/tmp") {
+	next unless defined && -d && -w _;
+	$tmpdir = $_;
+	last;
+    }
+    $tmpdir = '' unless defined $tmpdir;
+    return $tmpdir;
+}
+
+=item updir
+
+Returns a string representation of the parent directory.  ".." on UNIX.
+
+=cut
+
+sub updir {
+    return "..";
+}
+
+=item no_upwards
+
+Given a list of file names, strip out those that refer to a parent
+directory. (Does not strip symlinks, only '.', '..', and equivalents.)
+
+=cut
+
+sub no_upwards {
+    my $self = shift;
+    return grep(!/^\.{1,2}\Z(?!\n)/s, @_);
+}
+
+=item case_tolerant
+
+Returns a true or false value indicating, respectively, that alphabetic
+is not or is significant when comparing file specifications.
+
+=cut
+
+sub case_tolerant {
+    return 0;
+}
+
+=item file_name_is_absolute
+
+Takes as argument a path and returns true if it is an absolute path.
+
+This does not consult the local filesystem on Unix, Win32, or OS/2.  It
+does sometimes on MacOS (see L<File::Spec::MacOS/file_name_is_absolute>).
+It does consult the working environment for VMS (see
+L<File::Spec::VMS/file_name_is_absolute>).
+
+=cut
+
+sub file_name_is_absolute {
+    my ($self,$file) = @_;
+    return scalar($file =~ m:^/:s);
+}
+
+=item path
+
+Takes no argument, returns the environment variable PATH as an array.
+
+=cut
+
+sub path {
+    my @path = split(':', $ENV{PATH});
+    foreach (@path) { $_ = '.' if $_ eq '' }
+    return @path;
+}
+
+=item join
+
+join is the same as catfile.
+
+=cut
+
+sub join {
+    my $self = shift;
+    return $self->catfile(@_);
+}
+
+=item splitpath
+
+    ($volume,$directories,$file) = File::Spec->splitpath( $path );
+    ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+Splits a path in to volume, directory, and filename portions. On systems
+with no concept of volume, returns undef for volume. 
+
+For systems with no syntax differentiating filenames from directories, 
+assumes that the last file is a path unless $no_file is true or a 
+trailing separator or /. or /.. is present. On Unix this means that $no_file
+true makes this return ( '', $path, '' ).
+
+The directory portion may or may not be returned with a trailing '/'.
+
+The results can be passed to L</catpath()> to get back a path equivalent to
+(usually identical to) the original path.
+
+=cut
+
+sub splitpath {
+    my ($self,$path, $nofile) = @_;
+
+    my ($volume,$directory,$file) = ('','','');
+
+    if ( $nofile ) {
+        $directory = $path;
+    }
+    else {
+        $path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs;
+        $directory = $1;
+        $file      = $2;
+    }
+
+    return ($volume,$directory,$file);
+}
+
+
+=item splitdir
+
+The opposite of L</catdir()>.
+
+    @dirs = File::Spec->splitdir( $directories );
+
+$directories must be only the directory portion of the path on systems 
+that have the concept of a volume or that have path syntax that differentiates
+files from directories.
+
+Unlike just splitting the directories on the separator, empty
+directory names (C<''>) can be returned, because these are significant
+on some OSs (e.g. MacOS).
+
+On Unix,
+
+    File::Spec->splitdir( "/a/b//c/" );
+
+Yields:
+
+    ( '', 'a', 'b', '', 'c', '' )
+
+=cut
+
+sub splitdir {
+    my ($self,$directories) = @_ ;
+    #
+    # split() likes to forget about trailing null fields, so here we
+    # check to be sure that there will not be any before handling the
+    # simple case.
+    #
+    if ( $directories !~ m|/\Z(?!\n)| ) {
+        return split( m|/|, $directories );
+    }
+    else {
+        #
+        # since there was a trailing separator, add a file name to the end, 
+        # then do the split, then replace it with ''.
+        #
+        my( @directories )= split( m|/|, "${directories}dummy" ) ;
+        $directories[ $#directories ]= '' ;
+        return @directories ;
+    }
+}
+
+
+=item catpath
+
+Takes volume, directory and file portions and returns an entire path. Under
+Unix, $volume is ignored, and directory and file are catenated.  A '/' is
+inserted if need be.  On other OSs, $volume is significant.
+
+=cut
+
+sub catpath {
+    my ($self,$volume,$directory,$file) = @_;
+
+    if ( $directory ne ''                && 
+         $file ne ''                     && 
+         substr( $directory, -1 ) ne '/' && 
+         substr( $file, 0, 1 ) ne '/' 
+    ) {
+        $directory .= "/$file" ;
+    }
+    else {
+        $directory .= $file ;
+    }
+
+    return $directory ;
+}
+
+=item abs2rel
+
+Takes a destination path and an optional base path returns a relative path
+from the base path to the destination path:
+
+    $rel_path = File::Spec->abs2rel( $path ) ;
+    $rel_path = File::Spec->abs2rel( $path, $base ) ;
+
+If $base is not present or '', then L<cwd()> is used. If $base is relative, 
+then it is converted to absolute form using L</rel2abs()>. This means that it
+is taken to be relative to L<cwd()>.
+
+On systems with the concept of a volume, this assumes that both paths 
+are on the $destination volume, and ignores the $base volume. 
+
+On systems that have a grammar that indicates filenames, this ignores the 
+$base filename as well. Otherwise all path components are assumed to be
+directories.
+
+If $path is relative, it is converted to absolute form using L</rel2abs()>.
+This means that it is taken to be relative to L<cwd()>.
+
+No checks against the filesystem are made on most systems.  On MacOS,
+the filesystem may be consulted (see
+L<File::Spec::MacOS/file_name_is_absolute>).  On VMS, there is
+interaction with the working environment, as logicals and
+macros are expanded.
+
+Based on code written by Shigio Yamaguchi.
+
+=cut
+
+sub abs2rel {
+    my($self,$path,$base) = @_;
+
+    # Clean up $path
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+        $path = $self->rel2abs( $path ) ;
+    }
+    else {
+        $path = $self->canonpath( $path ) ;
+    }
+
+    # Figure out the effective $base and clean it up.
+    if ( !defined( $base ) || $base eq '' ) {
+        $base = cwd() ;
+    }
+    elsif ( ! $self->file_name_is_absolute( $base ) ) {
+        $base = $self->rel2abs( $base ) ;
+    }
+    else {
+        $base = $self->canonpath( $base ) ;
+    }
+
+    # Now, remove all leading components that are the same
+    my @pathchunks = $self->splitdir( $path);
+    my @basechunks = $self->splitdir( $base);
+
+    while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
+        shift @pathchunks ;
+        shift @basechunks ;
+    }
+
+    $path = CORE::join( '/', @pathchunks );
+    $base = CORE::join( '/', @basechunks );
+
+    # $base now contains the directories the resulting relative path 
+    # must ascend out of before it can descend to $path_directory.  So, 
+    # replace all names with $parentDir
+    $base =~ s|[^/]+|..|g ;
+
+    # Glue the two together, using a separator if necessary, and preventing an
+    # empty result.
+    if ( $path ne '' && $base ne '' ) {
+        $path = "$base/$path" ;
+    } else {
+        $path = "$base$path" ;
+    }
+
+    return $self->canonpath( $path ) ;
+}
+
+=item rel2abs
+
+Converts a relative path to an absolute path. 
+
+    $abs_path = File::Spec->rel2abs( $path ) ;
+    $abs_path = File::Spec->rel2abs( $path, $base ) ;
+
+If $base is not present or '', then L<cwd()> is used. If $base is relative, 
+then it is converted to absolute form using L</rel2abs()>. This means that it
+is taken to be relative to L<cwd()>.
+
+On systems with the concept of a volume, this assumes that both paths 
+are on the $base volume, and ignores the $path volume. 
+
+On systems that have a grammar that indicates filenames, this ignores the 
+$base filename as well. Otherwise all path components are assumed to be
+directories.
+
+If $path is absolute, it is cleaned up and returned using L</canonpath()>.
+
+No checks against the filesystem are made on most systems.  On MacOS,
+the filesystem may be consulted (see
+L<File::Spec::MacOS/file_name_is_absolute>).  On VMS, there is
+interaction with the working environment, as logicals and
+macros are expanded.
+
+Based on code written by Shigio Yamaguchi.
+
+=cut
+
+sub rel2abs {
+    my ($self,$path,$base ) = @_;
+
+    # Clean up $path
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+        # Figure out the effective $base and clean it up.
+        if ( !defined( $base ) || $base eq '' ) {
+            $base = cwd() ;
+        }
+        elsif ( ! $self->file_name_is_absolute( $base ) ) {
+            $base = $self->rel2abs( $base ) ;
+        }
+        else {
+            $base = $self->canonpath( $base ) ;
+        }
+
+        # Glom them together
+        $path = $self->catdir( $base, $path ) ;
+    }
+
+    return $self->canonpath( $path ) ;
+}
+
+
+=back
+
+=head1 SEE ALSO
+
+L<File::Spec>
+
+=cut
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Spec/VMS.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Spec/VMS.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Spec/VMS.pm	(revision 14265)
@@ -0,0 +1,505 @@
+package File::Spec::VMS;
+
+use strict;
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '1.1';
+
+@ISA = qw(File::Spec::Unix);
+
+use Cwd;
+use File::Basename;
+use VMS::Filespec;
+
+=head1 NAME
+
+File::Spec::VMS - methods for VMS file specs
+
+=head1 SYNOPSIS
+
+ require File::Spec::VMS; # Done internally by File::Spec if needed
+
+=head1 DESCRIPTION
+
+See File::Spec::Unix for a documentation of the methods provided
+there. This package overrides the implementation of these methods, not
+the semantics.
+
+=over
+
+=item eliminate_macros
+
+Expands MM[KS]/Make macros in a text string, using the contents of
+identically named elements of C<%$self>, and returns the result
+as a file specification in Unix syntax.
+
+=cut
+
+sub eliminate_macros {
+    my($self,$path) = @_;
+    return '' unless $path;
+    $self = {} unless ref $self;
+
+    if ($path =~ /\s/) {
+      return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
+    }
+
+    my($npath) = unixify($path);
+    my($complex) = 0;
+    my($head,$macro,$tail);
+
+    # perform m##g in scalar context so it acts as an iterator
+    while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { 
+        if ($self->{$2}) {
+            ($head,$macro,$tail) = ($1,$2,$3);
+            if (ref $self->{$macro}) {
+                if (ref $self->{$macro} eq 'ARRAY') {
+                    $macro = join ' ', @{$self->{$macro}};
+                }
+                else {
+                    print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
+                          "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
+                    $macro = "\cB$macro\cB";
+                    $complex = 1;
+                }
+            }
+            else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
+            $npath = "$head$macro$tail";
+        }
+    }
+    if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
+    $npath;
+}
+
+=item fixpath
+
+Catchall routine to clean up problem MM[SK]/Make macros.  Expands macros
+in any directory specification, in order to avoid juxtaposing two
+VMS-syntax directories when MM[SK] is run.  Also expands expressions which
+are all macro, so that we can tell how long the expansion is, and avoid
+overrunning DCL's command buffer when MM[KS] is running.
+
+If optional second argument has a TRUE value, then the return string is
+a VMS-syntax directory specification, if it is FALSE, the return string
+is a VMS-syntax file specification, and if it is not specified, fixpath()
+checks to see whether it matches the name of a directory in the current
+default directory, and returns a directory or file specification accordingly.
+
+=cut
+
+sub fixpath {
+    my($self,$path,$force_path) = @_;
+    return '' unless $path;
+    $self = bless {} unless ref $self;
+    my($fixedpath,$prefix,$name);
+
+    if ($path =~ /\s/) {
+      return join ' ',
+             map { $self->fixpath($_,$force_path) }
+	     split /\s+/, $path;
+    }
+
+    if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { 
+        if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
+            $fixedpath = vmspath($self->eliminate_macros($path));
+        }
+        else {
+            $fixedpath = vmsify($self->eliminate_macros($path));
+        }
+    }
+    elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
+        my($vmspre) = $self->eliminate_macros("\$($prefix)");
+        # is it a dir or just a name?
+        $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
+        $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
+        $fixedpath = vmspath($fixedpath) if $force_path;
+    }
+    else {
+        $fixedpath = $path;
+        $fixedpath = vmspath($fixedpath) if $force_path;
+    }
+    # No hints, so we try to guess
+    if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
+        $fixedpath = vmspath($fixedpath) if -d $fixedpath;
+    }
+
+    # Trim off root dirname if it's had other dirs inserted in front of it.
+    $fixedpath =~ s/\.000000([\]>])/$1/;
+    # Special case for VMS absolute directory specs: these will have had device
+    # prepended during trip through Unix syntax in eliminate_macros(), since
+    # Unix syntax has no way to express "absolute from the top of this device's
+    # directory tree".
+    if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
+    $fixedpath;
+}
+
+=back
+
+=head2 Methods always loaded
+
+=over
+
+=item canonpath (override)
+
+Removes redundant portions of file specifications according to VMS syntax.
+
+=cut
+
+sub canonpath {
+    my($self,$path) = @_;
+
+    if ($path =~ m|/|) { # Fake Unix
+      my $pathify = $path =~ m|/\Z(?!\n)|;
+      $path = $self->SUPER::canonpath($path);
+      if ($pathify) { return vmspath($path); }
+      else          { return vmsify($path);  }
+    }
+    else {
+      $path =~ s-\]\[--g;  $path =~ s/><//g;            # foo.][bar       ==> foo.bar
+      $path =~ s/([\[<])000000\./$1/;                   # [000000.foo     ==> foo
+      1 while $path =~ s{([\[<-])\.-}{$1-};             # [.-.-           ==> [--
+      $path =~ s/\.[^\[<\.]+\.-([\]\>])/$1/;            # bar.foo.-]      ==> bar]
+      $path =~ s/([\[<])(-+)/$1 . "\cx" x length($2)/e; # encode leading '-'s
+      $path =~ s/([\[<\.])([^\[<\.\cx]+)\.-\.?/$1/g;    # bar.-.foo       ==> foo
+      $path =~ s/([\[<])(\cx+)/$1 . '-' x length($2)/e; # then decode
+      return $path;
+    }
+}
+
+=item catdir
+
+Concatenates a list of file specifications, and returns the result as a
+VMS-syntax directory specification.  No check is made for "impossible"
+cases (e.g. elements other than the first being absolute filespecs).
+
+=cut
+
+sub catdir {
+    my ($self,@dirs) = @_;
+    my $dir = pop @dirs;
+    @dirs = grep($_,@dirs);
+    my $rslt;
+    if (@dirs) {
+	my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
+	my ($spath,$sdir) = ($path,$dir);
+	$spath =~ s/\.dir\Z(?!\n)//; $sdir =~ s/\.dir\Z(?!\n)//; 
+	$sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\Z(?!\n)/s;
+	$rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
+
+	# Special case for VMS absolute directory specs: these will have had device
+	# prepended during trip through Unix syntax in eliminate_macros(), since
+	# Unix syntax has no way to express "absolute from the top of this device's
+	# directory tree".
+	if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; }
+    }
+    else {
+	if    (not defined $dir or not length $dir) { $rslt = ''; }
+	elsif ($dir =~ /^\$\([^\)]+\)\Z(?!\n)/s)          { $rslt = $dir; }
+	else                                        { $rslt = vmspath($dir); }
+    }
+    return $self->canonpath($rslt);
+}
+
+=item catfile
+
+Concatenates a list of file specifications, and returns the result as a
+VMS-syntax file specification.
+
+=cut
+
+sub catfile {
+    my ($self,@files) = @_;
+    my $file = pop @files;
+    @files = grep($_,@files);
+    my $rslt;
+    if (@files) {
+	my $path = (@files == 1 ? $files[0] : $self->catdir(@files));
+	my $spath = $path;
+	$spath =~ s/\.dir\Z(?!\n)//;
+	if ($spath =~ /^[^\)\]\/:>]+\)\Z(?!\n)/s && basename($file) eq $file) {
+	    $rslt = "$spath$file";
+	}
+	else {
+	    $rslt = $self->eliminate_macros($spath);
+	    $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
+	}
+    }
+    else { $rslt = (defined($file) && length($file)) ? vmsify($file) : ''; }
+    return $self->canonpath($rslt);
+}
+
+
+=item curdir (override)
+
+Returns a string representation of the current directory: '[]'
+
+=cut
+
+sub curdir {
+    return '[]';
+}
+
+=item devnull (override)
+
+Returns a string representation of the null device: '_NLA0:'
+
+=cut
+
+sub devnull {
+    return "_NLA0:";
+}
+
+=item rootdir (override)
+
+Returns a string representation of the root directory: 'SYS$DISK:[000000]'
+
+=cut
+
+sub rootdir {
+    return 'SYS$DISK:[000000]';
+}
+
+=item tmpdir (override)
+
+Returns a string representation of the first writable directory
+from the following list or '' if none are writable:
+
+    sys$scratch:
+    $ENV{TMPDIR}
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    foreach ('sys$scratch:', $ENV{TMPDIR}) {
+	next unless defined && -d && -w _;
+	$tmpdir = $_;
+	last;
+    }
+    $tmpdir = '' unless defined $tmpdir;
+    return $tmpdir;
+}
+
+=item updir (override)
+
+Returns a string representation of the parent directory: '[-]'
+
+=cut
+
+sub updir {
+    return '[-]';
+}
+
+=item case_tolerant (override)
+
+VMS file specification syntax is case-tolerant.
+
+=cut
+
+sub case_tolerant {
+    return 1;
+}
+
+=item path (override)
+
+Translate logical name DCL$PATH as a searchlist, rather than trying
+to C<split> string value of C<$ENV{'PATH'}>.
+
+=cut
+
+sub path {
+    my (@dirs,$dir,$i);
+    while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
+    return @dirs;
+}
+
+=item file_name_is_absolute (override)
+
+Checks for VMS directory spec as well as Unix separators.
+
+=cut
+
+sub file_name_is_absolute {
+    my ($self,$file) = @_;
+    # If it's a logical name, expand it.
+    $file = $ENV{$file} while $file =~ /^[\w\$\-]+\Z(?!\n)/s && $ENV{$file};
+    return scalar($file =~ m!^/!s             ||
+		  $file =~ m![<\[][^.\-\]>]!  ||
+		  $file =~ /:[^<\[]/);
+}
+
+=item splitpath (override)
+
+Splits using VMS syntax.
+
+=cut
+
+sub splitpath {
+    my($self,$path) = @_;
+    my($dev,$dir,$file) = ('','','');
+
+    vmsify($path) =~ /(.+:)?([\[<].*[\]>])?(.*)/s;
+    return ($1 || '',$2 || '',$3);
+}
+
+=item splitdir (override)
+
+Split dirspec using VMS syntax.
+
+=cut
+
+sub splitdir {
+    my($self,$dirspec) = @_;
+    $dirspec =~ s/\]\[//g;  $dirspec =~ s/\-\-/-.-/g;
+    $dirspec = "[$dirspec]" unless $dirspec =~ /[\[<]/; # make legal
+    my(@dirs) = split('\.', vmspath($dirspec));
+    $dirs[0] =~ s/^[\[<]//s;  $dirs[-1] =~ s/[\]>]\Z(?!\n)//s;
+    @dirs;
+}
+
+
+=item catpath (override)
+
+Construct a complete filespec using VMS syntax
+
+=cut
+
+sub catpath {
+    my($self,$dev,$dir,$file) = @_;
+    if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; }
+    else { $dev .= ':' unless $dev eq '' or $dev =~ /:\Z(?!\n)/; }
+    if (length($dev) or length($dir)) {
+      $dir = "[$dir]" unless $dir =~ /[\[<\/]/;
+      $dir = vmspath($dir);
+    }
+    "$dev$dir$file";
+}
+
+=item abs2rel (override)
+
+Use VMS syntax when converting filespecs.
+
+=cut
+
+sub abs2rel {
+    my $self = shift;
+
+    return vmspath(File::Spec::Unix::abs2rel( $self, @_ ))
+        if ( join( '', @_ ) =~ m{/} ) ;
+
+    my($path,$base) = @_;
+
+    # Note: we use '/' to glue things together here, then let canonpath()
+    # clean them up at the end.
+
+    # Clean up $path
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+        $path = $self->rel2abs( $path ) ;
+    }
+    else {
+        $path = $self->canonpath( $path ) ;
+    }
+
+    # Figure out the effective $base and clean it up.
+    if ( !defined( $base ) || $base eq '' ) {
+        $base = cwd() ;
+    }
+    elsif ( ! $self->file_name_is_absolute( $base ) ) {
+        $base = $self->rel2abs( $base ) ;
+    }
+    else {
+        $base = $self->canonpath( $base ) ;
+    }
+
+    # Split up paths
+    my ( $path_directories, $path_file ) =
+        ($self->splitpath( $path, 1 ))[1,2] ;
+
+    $path_directories = $1
+        if $path_directories =~ /^\[(.*)\]\Z(?!\n)/s ;
+
+    my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
+
+    $base_directories = $1
+        if $base_directories =~ /^\[(.*)\]\Z(?!\n)/s ;
+
+    # Now, remove all leading components that are the same
+    my @pathchunks = $self->splitdir( $path_directories );
+    my @basechunks = $self->splitdir( $base_directories );
+
+    while ( @pathchunks && 
+            @basechunks && 
+            lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 
+          ) {
+        shift @pathchunks ;
+        shift @basechunks ;
+    }
+
+    # @basechunks now contains the directories to climb out of,
+    # @pathchunks now has the directories to descend in to.
+    $path_directories = '-.' x @basechunks . join( '.', @pathchunks ) ;
+    $path_directories =~ s{\.\Z(?!\n)}{} ;
+    return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ;
+}
+
+
+=item rel2abs (override)
+
+Use VMS syntax when converting filespecs.
+
+=cut
+
+sub rel2abs {
+    my $self = shift ;
+    return vmspath(File::Spec::Unix::rel2abs( $self, @_ ))
+        if ( join( '', @_ ) =~ m{/} ) ;
+
+    my ($path,$base ) = @_;
+    # Clean up and split up $path
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+        # Figure out the effective $base and clean it up.
+        if ( !defined( $base ) || $base eq '' ) {
+            $base = cwd() ;
+        }
+        elsif ( ! $self->file_name_is_absolute( $base ) ) {
+            $base = $self->rel2abs( $base ) ;
+        }
+        else {
+            $base = $self->canonpath( $base ) ;
+        }
+
+        # Split up paths
+        my ( $path_directories, $path_file ) =
+            ($self->splitpath( $path ))[1,2] ;
+
+        my ( $base_volume, $base_directories ) =
+            $self->splitpath( $base ) ;
+
+        $path_directories = '' if $path_directories eq '[]' ||
+                                  $path_directories eq '<>';
+        my $sep = '' ;
+        $sep = '.'
+            if ( $base_directories =~ m{[^.\]>]\Z(?!\n)} &&
+                 $path_directories =~ m{^[^.\[<]}s
+            ) ;
+        $base_directories = "$base_directories$sep$path_directories";
+        $base_directories =~ s{\.?[\]>][\[<]\.?}{.};
+
+        $path = $self->catpath( $base_volume, $base_directories, $path_file );
+   }
+
+    return $self->canonpath( $path ) ;
+}
+
+
+=back
+
+=head1 SEE ALSO
+
+L<File::Spec>
+
+=cut
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Win32.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Win32.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Spec/Win32.pm	(revision 14265)
@@ -0,0 +1,355 @@
+package File::Spec::Win32;
+
+use strict;
+use Cwd;
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '1.2';
+
+@ISA = qw(File::Spec::Unix);
+
+=head1 NAME
+
+File::Spec::Win32 - methods for Win32 file specs
+
+=head1 SYNOPSIS
+
+ require File::Spec::Win32; # Done internally by File::Spec if needed
+
+=head1 DESCRIPTION
+
+See File::Spec::Unix for a documentation of the methods provided
+there. This package overrides the implementation of these methods, not
+the semantics.
+
+=over
+
+=item devnull
+
+Returns a string representation of the null device.
+
+=cut
+
+sub devnull {
+    return "nul";
+}
+
+=item tmpdir
+
+Returns a string representation of the first existing directory
+from the following list:
+
+    $ENV{TMPDIR}
+    $ENV{TEMP}
+    $ENV{TMP}
+    C:/temp
+    /tmp
+    /
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    my $self = shift;
+    foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(C:/temp /tmp /)) {
+	next unless defined && -d;
+	$tmpdir = $_;
+	last;
+    }
+    $tmpdir = '' unless defined $tmpdir;
+    $tmpdir = $self->canonpath($tmpdir);
+    return $tmpdir;
+}
+
+sub case_tolerant {
+    return 1;
+}
+
+sub file_name_is_absolute {
+    my ($self,$file) = @_;
+    return scalar($file =~ m{^([a-z]:)?[\\/]}is);
+}
+
+=item catfile
+
+Concatenate one or more directory names and a filename to form a
+complete path ending with a filename
+
+=cut
+
+sub catfile {
+    my $self = shift;
+    my $file = pop @_;
+    return $file unless @_;
+    my $dir = $self->catdir(@_);
+    $dir .= "\\" unless substr($dir,-1) eq "\\";
+    return $dir.$file;
+}
+
+sub path {
+    my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
+    my @path = split(';',$path);
+    foreach (@path) { $_ = '.' if $_ eq '' }
+    return @path;
+}
+
+=item canonpath
+
+No physical check on the filesystem, but a logical cleanup of a
+path. On UNIX eliminated successive slashes and successive "/.".
+
+=cut
+
+sub canonpath {
+    my ($self,$path) = @_;
+    $path =~ s/^([a-z]:)/\u$1/s;
+    $path =~ s|/|\\|g;
+    $path =~ s|([^\\])\\+|$1\\|g;                  # xx////xx  -> xx/xx
+    $path =~ s|(\\\.)+\\|\\|g;                     # xx/././xx -> xx/xx
+    $path =~ s|^(\.\\)+||s unless $path eq ".\\";  # ./xx      -> xx
+    $path =~ s|\\\Z(?!\n)||
+             unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s;   # xx/       -> xx
+    return $path;
+}
+
+=item splitpath
+
+    ($volume,$directories,$file) = File::Spec->splitpath( $path );
+    ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+Splits a path in to volume, directory, and filename portions. Assumes that 
+the last file is a path unless the path ends in '\\', '\\.', '\\..'
+or $no_file is true.  On Win32 this means that $no_file true makes this return 
+( $volume, $path, undef ).
+
+Separators accepted are \ and /.
+
+Volumes can be drive letters or UNC sharenames (\\server\share).
+
+The results can be passed to L</catpath> to get back a path equivalent to
+(usually identical to) the original path.
+
+=cut
+
+sub splitpath {
+    my ($self,$path, $nofile) = @_;
+    my ($volume,$directory,$file) = ('','','');
+    if ( $nofile ) {
+        $path =~ 
+            m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) 
+                 (.*)
+             }xs;
+        $volume    = $1;
+        $directory = $2;
+    }
+    else {
+        $path =~ 
+            m{^ ( (?: [a-zA-Z]: |
+                      (?:\\\\|//)[^\\/]+[\\/][^\\/]+
+                  )?
+                )
+                ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
+                (.*)
+             }xs;
+        $volume    = $1;
+        $directory = $2;
+        $file      = $3;
+    }
+
+    return ($volume,$directory,$file);
+}
+
+
+=item splitdir
+
+The opposite of L</catdir()>.
+
+    @dirs = File::Spec->splitdir( $directories );
+
+$directories must be only the directory portion of the path on systems 
+that have the concept of a volume or that have path syntax that differentiates
+files from directories.
+
+Unlike just splitting the directories on the separator, leading empty and 
+trailing directory entries can be returned, because these are significant
+on some OSs. So,
+
+    File::Spec->splitdir( "/a/b/c" );
+
+Yields:
+
+    ( '', 'a', 'b', '', 'c', '' )
+
+=cut
+
+sub splitdir {
+    my ($self,$directories) = @_ ;
+    #
+    # split() likes to forget about trailing null fields, so here we
+    # check to be sure that there will not be any before handling the
+    # simple case.
+    #
+    if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
+        return split( m|[\\/]|, $directories );
+    }
+    else {
+        #
+        # since there was a trailing separator, add a file name to the end, 
+        # then do the split, then replace it with ''.
+        #
+        my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
+        $directories[ $#directories ]= '' ;
+        return @directories ;
+    }
+}
+
+
+=item catpath
+
+Takes volume, directory and file portions and returns an entire path. Under
+Unix, $volume is ignored, and this is just like catfile(). On other OSs,
+the $volume become significant.
+
+=cut
+
+sub catpath {
+    my ($self,$volume,$directory,$file) = @_;
+
+    # If it's UNC, make sure the glue separator is there, reusing
+    # whatever separator is first in the $volume
+    $volume .= $1
+        if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
+             $directory =~ m@^[^\\/]@s
+           ) ;
+
+    $volume .= $directory ;
+
+    # If the volume is not just A:, make sure the glue separator is 
+    # there, reusing whatever separator is first in the $volume if possible.
+    if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
+         $volume =~ m@[^\\/]\Z(?!\n)@      &&
+         $file   =~ m@[^\\/]@
+       ) {
+        $volume =~ m@([\\/])@ ;
+        my $sep = $1 ? $1 : '\\' ;
+        $volume .= $sep ;
+    }
+
+    $volume .= $file ;
+
+    return $volume ;
+}
+
+
+sub abs2rel {
+    my($self,$path,$base) = @_;
+
+    # Clean up $path
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+        $path = $self->rel2abs( $path ) ;
+    }
+    else {
+        $path = $self->canonpath( $path ) ;
+    }
+
+    # Figure out the effective $base and clean it up.
+    if ( ! $self->file_name_is_absolute( $base ) ) {
+        $base = $self->rel2abs( $base ) ;
+    }
+    elsif ( !defined( $base ) || $base eq '' ) {
+        $base = cwd() ;
+    }
+    else {
+        $base = $self->canonpath( $base ) ;
+    }
+
+    # Split up paths
+    my ( $path_volume, $path_directories, $path_file ) =
+        $self->splitpath( $path, 1 ) ;
+
+    my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
+
+    # Now, remove all leading components that are the same
+    my @pathchunks = $self->splitdir( $path_directories );
+    my @basechunks = $self->splitdir( $base_directories );
+
+    while ( @pathchunks && 
+            @basechunks && 
+            lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 
+          ) {
+        shift @pathchunks ;
+        shift @basechunks ;
+    }
+
+    # No need to catdir, we know these are well formed.
+    $path_directories = CORE::join( '\\', @pathchunks );
+    $base_directories = CORE::join( '\\', @basechunks );
+
+    # $base_directories now contains the directories the resulting relative
+    # path must ascend out of before it can descend to $path_directory.  So, 
+    # replace all names with $parentDir
+
+    #FA Need to replace between backslashes...
+    $base_directories =~ s|[^\\]+|..|g ;
+
+    # Glue the two together, using a separator if necessary, and preventing an
+    # empty result.
+
+    #FA Must check that new directories are not empty.
+    if ( $path_directories ne '' && $base_directories ne '' ) {
+        $path_directories = "$base_directories\\$path_directories" ;
+    } else {
+        $path_directories = "$base_directories$path_directories" ;
+    }
+
+    # It makes no sense to add a relative path to a UNC volume
+    $path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ;
+
+    return $self->canonpath( 
+        $self->catpath($path_volume, $path_directories, $path_file ) 
+    ) ;
+}
+
+
+sub rel2abs {
+    my ($self,$path,$base ) = @_;
+
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+
+        if ( !defined( $base ) || $base eq '' ) {
+            $base = cwd() ;
+        }
+        elsif ( ! $self->file_name_is_absolute( $base ) ) {
+            $base = $self->rel2abs( $base ) ;
+        }
+        else {
+            $base = $self->canonpath( $base ) ;
+        }
+
+        my ( $path_directories, $path_file ) =
+            ($self->splitpath( $path, 1 ))[1,2] ;
+
+        my ( $base_volume, $base_directories ) =
+            $self->splitpath( $base, 1 ) ;
+
+        $path = $self->catpath( 
+            $base_volume, 
+            $self->catdir( $base_directories, $path_directories ), 
+            $path_file
+        ) ;
+    }
+
+    return $self->canonpath( $path ) ;
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<File::Spec>
+
+=cut
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/File/Temp.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/Temp.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/Temp.pm	(revision 14265)
@@ -0,0 +1,1863 @@
+package File::Temp;
+
+=head1 NAME
+
+File::Temp - return name and handle of a temporary file safely
+
+=begin __INTERNALS
+
+=head1 PORTABILITY
+
+This module is designed to be portable across operating systems
+and it currently supports Unix, VMS, DOS, OS/2 and Windows. When
+porting to a new OS there are generally three main issues
+that have to be solved:
+
+=over 4
+
+=item *
+
+Can the OS unlink an open file? If it can not then the
+C<_can_unlink_opened_file> method should be modified.
+
+=item *
+
+Are the return values from C<stat> reliable? By default all the
+return values from C<stat> are compared when unlinking a temporary
+file using the filename and the handle. Operating systems other than
+unix do not always have valid entries in all fields. If C<unlink0> fails
+then the C<stat> comparison should be modified accordingly.
+
+=item *
+
+Security. Systems that can not support a test for the sticky bit
+on a directory can not use the MEDIUM and HIGH security tests.
+The C<_can_do_level> method should be modified accordingly.
+
+=back
+
+=end __INTERNALS
+
+=head1 SYNOPSIS
+
+  use File::Temp qw/ tempfile tempdir /; 
+
+  $dir = tempdir( CLEANUP => 1 );
+  ($fh, $filename) = tempfile( DIR => $dir );
+
+  ($fh, $filename) = tempfile( $template, DIR => $dir);
+  ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
+
+  $fh = tempfile();
+
+MkTemp family:
+
+  use File::Temp qw/ :mktemp  /;
+
+  ($fh, $file) = mkstemp( "tmpfileXXXXX" );
+  ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
+
+  $tmpdir = mkdtemp( $template );
+
+  $unopened_file = mktemp( $template );
+
+POSIX functions:
+
+  use File::Temp qw/ :POSIX /;
+
+  $file = tmpnam();
+  $fh = tmpfile();
+
+  ($fh, $file) = tmpnam();
+  ($fh, $file) = tmpfile();
+
+
+Compatibility functions:
+
+  $unopened_file = File::Temp::tempnam( $dir, $pfx );
+
+=begin later
+
+Objects (NOT YET IMPLEMENTED):
+
+  require File::Temp;
+
+  $fh = new File::Temp($template);
+  $fname = $fh->filename;
+
+=end later
+
+=head1 DESCRIPTION
+
+C<File::Temp> can be used to create and open temporary files in a safe way.
+The tempfile() function can be used to return the name and the open
+filehandle of a temporary file.  The tempdir() function can 
+be used to create a temporary directory.
+
+The security aspect of temporary file creation is emphasized such that
+a filehandle and filename are returned together.  This helps guarantee
+that a race condition can not occur where the temporary file is
+created by another process between checking for the existence of the
+file and its opening.  Additional security levels are provided to
+check, for example, that the sticky bit is set on world writable
+directories.  See L<"safe_level"> for more information.
+
+For compatibility with popular C library functions, Perl implementations of
+the mkstemp() family of functions are provided. These are, mkstemp(),
+mkstemps(), mkdtemp() and mktemp().
+
+Additionally, implementations of the standard L<POSIX|POSIX>
+tmpnam() and tmpfile() functions are provided if required.
+
+Implementations of mktemp(), tmpnam(), and tempnam() are provided,
+but should be used with caution since they return only a filename
+that was valid when function was called, so cannot guarantee
+that the file will not exist by the time the caller opens the filename.
+
+=cut
+
+# 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
+# People would like a version on 5.005 so give them what they want :-)
+use 5.005;
+use strict;
+use Carp;
+use File::Spec 0.8;
+use File::Path qw/ rmtree /;
+use Fcntl 1.03;
+use Errno;
+require VMS::Stdio if $^O eq 'VMS';
+
+# Need the Symbol package if we are running older perl
+require Symbol if $] < 5.006;
+
+
+# use 'our' on v5.6.0
+use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG);
+
+$DEBUG = 0;
+
+# We are exporting functions
+
+use base qw/Exporter/;
+
+# Export list - to allow fine tuning of export table
+
+@EXPORT_OK = qw{
+	      tempfile
+	      tempdir
+	      tmpnam
+	      tmpfile
+	      mktemp
+	      mkstemp
+	      mkstemps
+	      mkdtemp
+	      unlink0
+		};
+
+# Groups of functions for export
+
+%EXPORT_TAGS = (
+		'POSIX' => [qw/ tmpnam tmpfile /],
+		'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
+	       );
+
+# add contents of these tags to @EXPORT
+Exporter::export_tags('POSIX','mktemp');
+
+# Version number 
+
+$VERSION = '0.12';
+
+# This is a list of characters that can be used in random filenames
+
+my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
+	         a b c d e f g h i j k l m n o p q r s t u v w x y z
+	         0 1 2 3 4 5 6 7 8 9 _
+	     /);
+
+# Maximum number of tries to make a temp file before failing
+
+use constant MAX_TRIES => 10;
+
+# Minimum number of X characters that should be in a template
+use constant MINX => 4;
+
+# Default template when no template supplied
+
+use constant TEMPXXX => 'X' x 10;
+
+# Constants for the security level
+
+use constant STANDARD => 0;
+use constant MEDIUM   => 1;
+use constant HIGH     => 2;
+
+# OPENFLAGS. If we defined the flag to use with Sysopen here this gives
+# us an optimisation when many temporary files are requested
+
+my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
+
+for my $oflag (qw/ FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
+  my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+  no strict 'refs';
+  $OPENFLAGS |= $bit if eval {
+    # Make sure that redefined die handlers do not cause problems
+    # eg CGI::Carp
+    local $SIG{__DIE__} = sub {};
+    local $SIG{__WARN__} = sub {};
+    $bit = &$func();
+    1;
+  };
+}
+
+# On some systems the O_TEMPORARY flag can be used to tell the OS
+# to automatically remove the file when it is closed. This is fine
+# in most cases but not if tempfile is called with UNLINK=>0 and
+# the filename is requested -- in the case where the filename is to
+# be passed to another routine. This happens on windows. We overcome
+# this by using a second open flags variable
+
+my $OPENTEMPFLAGS = $OPENFLAGS;
+for my $oflag (qw/ TEMPORARY /) {
+  my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+  no strict 'refs';
+  $OPENTEMPFLAGS |= $bit if eval {
+    # Make sure that redefined die handlers do not cause problems
+    # eg CGI::Carp
+    local $SIG{__DIE__} = sub {};
+    local $SIG{__WARN__} = sub {};
+    $bit = &$func();
+    1;
+  };
+}
+
+# INTERNAL ROUTINES - not to be used outside of package
+
+# Generic routine for getting a temporary filename
+# modelled on OpenBSD _gettemp() in mktemp.c
+
+# The template must contain X's that are to be replaced
+# with the random values
+
+#  Arguments:
+
+#  TEMPLATE   - string containing the XXXXX's that is converted
+#           to a random filename and opened if required
+
+# Optionally, a hash can also be supplied containing specific options
+#   "open" => if true open the temp file, else just return the name
+#             default is 0
+#   "mkdir"=> if true, we are creating a temp directory rather than tempfile
+#             default is 0
+#   "suffixlen" => number of characters at end of PATH to be ignored.
+#                  default is 0.
+#   "unlink_on_close" => indicates that, if possible,  the OS should remove
+#                        the file as soon as it is closed. Usually indicates
+#                        use of the O_TEMPORARY flag to sysopen. 
+#                        Usually irrelevant on unix
+
+# Optionally a reference to a scalar can be passed into the function
+# On error this will be used to store the reason for the error
+#   "ErrStr"  => \$errstr
+
+# "open" and "mkdir" can not both be true
+# "unlink_on_close" is not used when "mkdir" is true.
+
+# The default options are equivalent to mktemp().
+
+# Returns:
+#   filehandle - open file handle (if called with doopen=1, else undef)
+#   temp name  - name of the temp file or directory
+
+# For example:
+#   ($fh, $name) = _gettemp($template, "open" => 1);
+
+# for the current version, failures are associated with
+# stored in an error string and returned to give the reason whilst debugging
+# This routine is not called by any external function
+sub _gettemp {
+
+  croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
+    unless scalar(@_) >= 1;
+
+  # the internal error string - expect it to be overridden
+  # Need this in case the caller decides not to supply us a value
+  # need an anonymous scalar
+  my $tempErrStr;
+
+  # Default options
+  my %options = (
+		 "open" => 0,
+		 "mkdir" => 0,
+		 "suffixlen" => 0,
+		 "unlink_on_close" => 0,
+		 "ErrStr" => \$tempErrStr,
+		);
+
+  # Read the template
+  my $template = shift;
+  if (ref($template)) {
+    # Use a warning here since we have not yet merged ErrStr
+    carp "File::Temp::_gettemp: template must not be a reference";
+    return ();
+  }
+
+  # Check that the number of entries on stack are even
+  if (scalar(@_) % 2 != 0) {
+    # Use a warning here since we have not yet merged ErrStr
+    carp "File::Temp::_gettemp: Must have even number of options";
+    return ();
+  }
+
+  # Read the options and merge with defaults
+  %options = (%options, @_)  if @_;
+
+  # Make sure the error string is set to undef
+  ${$options{ErrStr}} = undef;
+
+  # Can not open the file and make a directory in a single call
+  if ($options{"open"} && $options{"mkdir"}) {
+    ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
+    return ();
+  }
+
+  # Find the start of the end of the  Xs (position of last X)
+  # Substr starts from 0
+  my $start = length($template) - 1 - $options{"suffixlen"};
+
+  # Check that we have at least MINX x X (eg 'XXXX") at the end of the string
+  # (taking suffixlen into account). Any fewer is insecure.
+
+  # Do it using substr - no reason to use a pattern match since
+  # we know where we are looking and what we are looking for
+
+  if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
+    ${$options{ErrStr}} = "The template must contain at least ".
+      MINX . " 'X' characters\n";
+    return ();
+  }
+
+  # Replace all the X at the end of the substring with a
+  # random character or just all the XX at the end of a full string.
+  # Do it as an if, since the suffix adjusts which section to replace
+  # and suffixlen=0 returns nothing if used in the substr directly
+  # and generate a full path from the template
+
+  my $path = _replace_XX($template, $options{"suffixlen"});
+
+
+  # Split the path into constituent parts - eventually we need to check
+  # whether the directory exists
+  # We need to know whether we are making a temp directory
+  # or a tempfile
+
+  my ($volume, $directories, $file);
+  my $parent; # parent directory
+  if ($options{"mkdir"}) {
+    # There is no filename at the end
+    ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
+
+    # The parent is then $directories without the last directory
+    # Split the directory and put it back together again
+    my @dirs = File::Spec->splitdir($directories);
+
+    # If @dirs only has one entry that means we are in the current
+    # directory
+    if ($#dirs == 0) {
+      $parent = File::Spec->curdir;
+    } else {
+
+      if ($^O eq 'VMS') {  # need volume to avoid relative dir spec
+        $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
+        $parent = 'sys$disk:[]' if $parent eq '';
+      } else {
+
+	# Put it back together without the last one
+	$parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
+
+	# ...and attach the volume (no filename)
+	$parent = File::Spec->catpath($volume, $parent, '');
+      }
+
+    }
+
+  } else {
+
+    # Get rid of the last filename (use File::Basename for this?)
+    ($volume, $directories, $file) = File::Spec->splitpath( $path );
+
+    # Join up without the file part
+    $parent = File::Spec->catpath($volume,$directories,'');
+
+    # If $parent is empty replace with curdir
+    $parent = File::Spec->curdir
+      unless $directories ne '';
+
+  }
+
+  # Check that the parent directories exist 
+  # Do this even for the case where we are simply returning a name
+  # not a file -- no point returning a name that includes a directory
+  # that does not exist or is not writable
+
+  unless (-d $parent) {
+    ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
+    return ();
+  }
+  unless (-w _) {
+    ${$options{ErrStr}} = "Parent directory ($parent) is not writable\n";
+      return ();
+  }
+
+
+  # Check the stickiness of the directory and chown giveaway if required
+  # If the directory is world writable the sticky bit
+  # must be set
+
+  if (File::Temp->safe_level == MEDIUM) {
+    my $safeerr;
+    unless (_is_safe($parent,\$safeerr)) {
+      ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
+      return ();
+    }
+  } elsif (File::Temp->safe_level == HIGH) {
+    my $safeerr;
+    unless (_is_verysafe($parent, \$safeerr)) {
+      ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
+      return ();
+    }
+  }
+
+
+  # Now try MAX_TRIES time to open the file
+  for (my $i = 0; $i < MAX_TRIES; $i++) {
+
+    # Try to open the file if requested
+    if ($options{"open"}) {
+      my $fh;
+
+      # If we are running before perl5.6.0 we can not auto-vivify
+      if ($] < 5.006) {
+	$fh = &Symbol::gensym;
+      }
+
+      # Try to make sure this will be marked close-on-exec
+      # XXX: Win32 doesn't respect this, nor the proper fcntl,
+      #      but may have O_NOINHERIT. This may or may not be in Fcntl.
+      local $^F = 2;
+
+      # Store callers umask
+      my $umask = umask();
+
+      # Set a known umask
+      umask(066);
+
+      # Attempt to open the file
+      my $open_success = undef;
+      if ( $^O eq 'VMS' and $options{"unlink_on_close"} ) {
+        # make it auto delete on close by setting FAB$V_DLT bit
+	$fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
+	$open_success = $fh;
+      } else {
+	my $flags = ( $options{"unlink_on_close"} ?
+		      $OPENTEMPFLAGS :
+		      $OPENFLAGS );
+	$open_success = sysopen($fh, $path, $flags, 0600);
+      }
+      if ( $open_success ) {
+
+	# Reset umask
+	umask($umask);
+	
+	# Opened successfully - return file handle and name
+	return ($fh, $path);
+
+      } else {
+	# Reset umask
+	umask($umask);
+
+	# Error opening file - abort with error
+	# if the reason was anything but EEXIST
+	unless ($!{EEXIST}) {
+	  ${$options{ErrStr}} = "Could not create temp file $path: $!";
+	  return ();
+	}
+
+	# Loop round for another try
+	
+      }
+    } elsif ($options{"mkdir"}) {
+
+      # Store callers umask
+      my $umask = umask();
+
+      # Set a known umask
+      umask(066);
+
+      # Open the temp directory
+      if (mkdir( $path, 0700)) {
+	# created okay
+	# Reset umask
+	umask($umask);
+
+	return undef, $path;
+      } else {
+
+	# Reset umask
+	umask($umask);
+
+	# Abort with error if the reason for failure was anything
+	# except EEXIST
+	unless ($!{EEXIST}) {
+	  ${$options{ErrStr}} = "Could not create directory $path: $!";
+	  return ();
+	}
+
+	# Loop round for another try
+
+      }
+
+    } else {
+
+      # Return true if the file can not be found
+      # Directory has been checked previously
+
+      return (undef, $path) unless -e $path;
+
+      # Try again until MAX_TRIES
+
+    }
+
+    # Did not successfully open the tempfile/dir
+    # so try again with a different set of random letters
+    # No point in trying to increment unless we have only
+    # 1 X say and the randomness could come up with the same
+    # file MAX_TRIES in a row.
+
+    # Store current attempt - in principal this implies that the
+    # 3rd time around the open attempt that the first temp file
+    # name could be generated again. Probably should store each
+    # attempt and make sure that none are repeated
+
+    my $original = $path;
+    my $counter = 0;  # Stop infinite loop
+    my $MAX_GUESS = 50;
+
+    do {
+
+      # Generate new name from original template
+      $path = _replace_XX($template, $options{"suffixlen"});
+
+      $counter++;
+
+    } until ($path ne $original || $counter > $MAX_GUESS);
+
+    # Check for out of control looping
+    if ($counter > $MAX_GUESS) {
+      ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
+      return ();
+    }
+
+  }
+
+  # If we get here, we have run out of tries
+  ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
+    . MAX_TRIES . ") to open temp file/dir";
+
+  return ();
+
+}
+
+# Internal routine to return a random character from the
+# character list. Does not do an srand() since rand()
+# will do one automatically
+
+# No arguments. Return value is the random character
+
+# No longer called since _replace_XX runs a few percent faster if
+# I inline the code. This is important if we are creating thousands of
+# temporary files.
+
+sub _randchar {
+
+  $CHARS[ int( rand( $#CHARS ) ) ];
+
+}
+
+# Internal routine to replace the XXXX... with random characters
+# This has to be done by _gettemp() every time it fails to 
+# open a temp file/dir
+
+# Arguments:  $template (the template with XXX), 
+#             $ignore   (number of characters at end to ignore)
+
+# Returns:    modified template
+
+sub _replace_XX {
+
+  croak 'Usage: _replace_XX($template, $ignore)'
+    unless scalar(@_) == 2;
+
+  my ($path, $ignore) = @_;
+
+  # Do it as an if, since the suffix adjusts which section to replace
+  # and suffixlen=0 returns nothing if used in the substr directly
+  # Alternatively, could simply set $ignore to length($path)-1
+  # Don't want to always use substr when not required though.
+
+  if ($ignore) {
+    substr($path, 0, - $ignore) =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
+  } else {
+    $path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
+  }
+
+  return $path;
+}
+
+# internal routine to check to see if the directory is safe
+# First checks to see if the directory is not owned by the
+# current user or root. Then checks to see if anyone else
+# can write to the directory and if so, checks to see if
+# it has the sticky bit set
+
+# Will not work on systems that do not support sticky bit
+
+#Args:  directory path to check
+#       Optionally: reference to scalar to contain error message
+# Returns true if the path is safe and false otherwise.
+# Returns undef if can not even run stat() on the path
+
+# This routine based on version written by Tom Christiansen
+
+# Presumably, by the time we actually attempt to create the
+# file or directory in this directory, it may not be safe
+# anymore... Have to run _is_safe directly after the open.
+
+sub _is_safe {
+
+  my $path = shift;
+  my $err_ref = shift;
+
+  # Stat path
+  my @info = stat($path);
+  unless (scalar(@info)) {
+    $$err_ref = "stat(path) returned no values";
+    return 0;
+  };
+  return 1 if $^O eq 'VMS';  # owner delete control at file level
+
+  # Check to see whether owner is neither superuser (or a system uid) nor me
+  # Use the real uid from the $< variable
+  # UID is in [4]
+  if ($info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
+
+    Carp::cluck(sprintf "uid=$info[4] topuid=%s \$<=$< path='$path'",
+		File::Temp->top_system_uid());
+
+    $$err_ref = "Directory owned neither by root nor the current user"
+      if ref($err_ref);
+    return 0;
+  }
+
+  # check whether group or other can write file
+  # use 066 to detect either reading or writing
+  # use 022 to check writability
+  # Do it with S_IWOTH and S_IWGRP for portability (maybe)
+  # mode is in info[2]
+  if (($info[2] & &Fcntl::S_IWGRP) ||   # Is group writable?
+      ($info[2] & &Fcntl::S_IWOTH) ) {  # Is world writable?
+    # Must be a directory
+    unless (-d _) {
+      $$err_ref = "Path ($path) is not a directory"
+      if ref($err_ref);
+      return 0;
+    }
+    # Must have sticky bit set
+    unless (-k _) {
+      $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
+	if ref($err_ref);
+      return 0;
+    }
+  }
+
+  return 1;
+}
+
+# Internal routine to check whether a directory is safe
+# for temp files. Safer than _is_safe since it checks for 
+# the possibility of chown giveaway and if that is a possibility
+# checks each directory in the path to see if it is safe (with _is_safe)
+
+# If _PC_CHOWN_RESTRICTED is not set, does the full test of each
+# directory anyway.
+
+# Takes optional second arg as scalar ref to error reason
+
+sub _is_verysafe {
+
+  # Need POSIX - but only want to bother if really necessary due to overhead
+  require POSIX;
+
+  my $path = shift;
+  print "_is_verysafe testing $path\n" if $DEBUG;
+  return 1 if $^O eq 'VMS';  # owner delete control at file level
+
+  my $err_ref = shift;
+
+  # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
+  # and If it is not there do the extensive test
+  my $chown_restricted;
+  $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
+    if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
+
+  # If chown_resticted is set to some value we should test it
+  if (defined $chown_restricted) {
+
+    # Return if the current directory is safe
+    return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
+
+  }
+
+  # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
+  # was not avialable or the symbol was there but chown giveaway
+  # is allowed. Either way, we now have to test the entire tree for
+  # safety.
+
+  # Convert path to an absolute directory if required
+  unless (File::Spec->file_name_is_absolute($path)) {
+    $path = File::Spec->rel2abs($path);
+  }
+
+  # Split directory into components - assume no file
+  my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
+
+  # Slightly less efficient than having a a function in File::Spec
+  # to chop off the end of a directory or even a function that
+  # can handle ../ in a directory tree
+  # Sometimes splitdir() returns a blank at the end
+  # so we will probably check the bottom directory twice in some cases
+  my @dirs = File::Spec->splitdir($directories);
+
+  # Concatenate one less directory each time around
+  foreach my $pos (0.. $#dirs) {
+    # Get a directory name
+    my $dir = File::Spec->catpath($volume,
+				  File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
+				  ''
+				  );
+
+    print "TESTING DIR $dir\n" if $DEBUG;
+
+    # Check the directory
+    return 0 unless _is_safe($dir,$err_ref);
+
+  }
+
+  return 1;
+}
+
+
+
+# internal routine to determine whether unlink works on this
+# platform for files that are currently open.
+# Returns true if we can, false otherwise.
+
+# Currently WinNT, OS/2 and VMS can not unlink an opened file
+# On VMS this is because the O_EXCL flag is used to open the
+# temporary file. Currently I do not know enough about the issues
+# on VMS to decide whether O_EXCL is a requirement.
+
+sub _can_unlink_opened_file {
+
+  if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos') {
+    return 0;
+  } else {
+    return 1;
+  }
+
+}
+
+# internal routine to decide which security levels are allowed
+# see safe_level() for more information on this
+
+# Controls whether the supplied security level is allowed
+
+#   $cando = _can_do_level( $level )
+
+sub _can_do_level {
+
+  # Get security level
+  my $level = shift;
+
+  # Always have to be able to do STANDARD
+  return 1 if $level == STANDARD;
+
+  # Currently, the systems that can do HIGH or MEDIUM are identical
+  if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos') {
+    return 0;
+  } else {
+    return 1;
+  }
+
+}
+
+# This routine sets up a deferred unlinking of a specified
+# filename and filehandle. It is used in the following cases:
+#  - Called by unlink0 if an opened file can not be unlinked
+#  - Called by tempfile() if files are to be removed on shutdown
+#  - Called by tempdir() if directories are to be removed on shutdown
+
+# Arguments:
+#   _deferred_unlink( $fh, $fname, $isdir );
+#
+#   - filehandle (so that it can be expclicitly closed if open
+#   - filename   (the thing we want to remove)
+#   - isdir      (flag to indicate that we are being given a directory)
+#                 [and hence no filehandle]
+
+# Status is not referred to since all the magic is done with an END block
+
+{
+  # Will set up two lexical variables to contain all the files to be
+  # removed. One array for files, another for directories
+  # They will only exist in this block
+  # This means we only have to set up a single END block to remove all files
+  # @files_to_unlink contains an array ref with the filehandle and filename
+  my (@files_to_unlink, @dirs_to_unlink);
+
+  # Set up an end block to use these arrays
+  END {
+    # Files
+    foreach my $file (@files_to_unlink) {
+      # close the filehandle without checking its state
+      # in order to make real sure that this is closed
+      # if its already closed then I dont care about the answer
+      # probably a better way to do this
+      close($file->[0]);  # file handle is [0]
+
+      if (-f $file->[1]) {  # file name is [1]
+	unlink $file->[1] or warn "Error removing ".$file->[1];
+      }
+    }
+    # Dirs
+    foreach my $dir (@dirs_to_unlink) {
+      if (-d $dir) {
+	rmtree($dir, $DEBUG, 1);
+      }
+    }
+
+  }
+
+  # This is the sub called to register a file for deferred unlinking
+  # This could simply store the input parameters and defer everything
+  # until the END block. For now we do a bit of checking at this
+  # point in order to make sure that (1) we have a file/dir to delete
+  # and (2) we have been called with the correct arguments.
+  sub _deferred_unlink {
+
+    croak 'Usage:  _deferred_unlink($fh, $fname, $isdir)'
+      unless scalar(@_) == 3;
+
+    my ($fh, $fname, $isdir) = @_;
+
+    warn "Setting up deferred removal of $fname\n"
+      if $DEBUG;
+
+    # If we have a directory, check that it is a directory
+    if ($isdir) {
+
+      if (-d $fname) {
+
+	# Directory exists so store it
+	# first on VMS turn []foo into [.foo] for rmtree
+	$fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
+	push (@dirs_to_unlink, $fname);
+
+      } else {
+	carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
+      }
+
+    } else {
+
+      if (-f $fname) {
+
+	# file exists so store handle and name for later removal
+	push(@files_to_unlink, [$fh, $fname]);
+
+      } else {
+	carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
+      }
+
+    }
+
+  }
+
+
+}
+
+=head1 FUNCTIONS
+
+This section describes the recommended interface for generating
+temporary files and directories.
+
+=over 4
+
+=item B<tempfile>
+
+This is the basic function to generate temporary files.
+The behaviour of the file can be changed using various options:
+
+  ($fh, $filename) = tempfile();
+
+Create a temporary file in  the directory specified for temporary
+files, as specified by the tmpdir() function in L<File::Spec>.
+
+  ($fh, $filename) = tempfile($template);
+
+Create a temporary file in the current directory using the supplied
+template.  Trailing `X' characters are replaced with random letters to
+generate the filename.  At least four `X' characters must be present
+in the template.
+
+  ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
+
+Same as previously, except that a suffix is added to the template
+after the `X' translation.  Useful for ensuring that a temporary
+filename has a particular extension when needed by other applications.
+But see the WARNING at the end.
+
+  ($fh, $filename) = tempfile($template, DIR => $dir);
+
+Translates the template as before except that a directory name
+is specified.
+
+  ($fh, $filename) = tempfile($template, UNLINK => 1);
+
+Return the filename and filehandle as before except that the file is
+automatically removed when the program exits. Default is for the file
+to be removed if a file handle is requested and to be kept if the
+filename is requested. In a scalar context (where no filename is 
+returned) the file is always deleted either on exit or when it is closed.
+
+If the template is not specified, a template is always
+automatically generated. This temporary file is placed in tmpdir()
+(L<File::Spec>) unless a directory is specified explicitly with the 
+DIR option.
+
+  $fh = tempfile( $template, DIR => $dir );
+
+If called in scalar context, only the filehandle is returned
+and the file will automatically be deleted when closed (see 
+the description of tmpfile() elsewhere in this document).
+This is the preferred mode of operation, as if you only 
+have a filehandle, you can never create a race condition
+by fumbling with the filename. On systems that can not unlink
+an open file or can not mark a file as temporary when it is opened
+(for example, Windows NT uses the C<O_TEMPORARY> flag))
+the file is marked for deletion when the program ends (equivalent
+to setting UNLINK to 1). The C<UNLINK> flag is ignored if present.
+
+  (undef, $filename) = tempfile($template, OPEN => 0);
+
+This will return the filename based on the template but
+will not open this file.  Cannot be used in conjunction with
+UNLINK set to true. Default is to always open the file 
+to protect from possible race conditions. A warning is issued
+if warnings are turned on. Consider using the tmpnam()
+and mktemp() functions described elsewhere in this document
+if opening the file is not required.
+
+Options can be combined as required.
+
+=cut
+
+sub tempfile {
+
+  # Can not check for argument count since we can have any
+  # number of args
+
+  # Default options
+  my %options = (
+		 "DIR"    => undef,  # Directory prefix
+                "SUFFIX" => '',     # Template suffix
+                "UNLINK" => 0,      # Do not unlink file on exit
+                "OPEN"   => 1,      # Open file
+		);
+
+  # Check to see whether we have an odd or even number of arguments
+  my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
+
+  # Read the options and merge with defaults
+  %options = (%options, @_)  if @_;
+
+  # First decision is whether or not to open the file
+  if (! $options{"OPEN"}) {
+
+    warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
+      if $^W;
+
+  }
+
+  if ($options{"DIR"} and $^O eq 'VMS') {
+
+      # on VMS turn []foo into [.foo] for concatenation
+      $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
+  }
+
+  # Construct the template
+
+  # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
+  # functions or simply constructing a template and using _gettemp()
+  # explicitly. Go for the latter
+
+  # First generate a template if not defined and prefix the directory
+  # If no template must prefix the temp directory
+  if (defined $template) {
+    if ($options{"DIR"}) {
+
+      $template = File::Spec->catfile($options{"DIR"}, $template);
+
+    }
+
+  } else {
+
+    if ($options{"DIR"}) {
+
+      $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
+
+    } else {
+
+      $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
+
+    }
+
+  }
+
+  # Now add a suffix
+  $template .= $options{"SUFFIX"};
+
+  # Determine whether we should tell _gettemp to unlink the file
+  # On unix this is irrelevant and can be worked out after the file is
+  # opened (simply by unlinking the open filehandle). On Windows or VMS
+  # we have to indicate temporary-ness when we open the file. In general
+  # we only want a true temporary file if we are returning just the 
+  # filehandle - if the user wants the filename they probably do not
+  # want the file to disappear as soon as they close it.
+  # For this reason, tie unlink_on_close to the return context regardless
+  # of OS.
+  my $unlink_on_close = ( wantarray ? 0 : 1);
+
+  # Create the file
+  my ($fh, $path, $errstr);
+  croak "Error in tempfile() using $template: $errstr"
+    unless (($fh, $path) = _gettemp($template,
+				    "open" => $options{'OPEN'},
+				    "mkdir"=> 0 ,
+                                    "unlink_on_close" => $unlink_on_close,
+				    "suffixlen" => length($options{'SUFFIX'}),
+				    "ErrStr" => \$errstr,
+				   ) );
+
+  # Set up an exit handler that can do whatever is right for the
+  # system. This removes files at exit when requested explicitly or when
+  # system is asked to unlink_on_close but is unable to do so because
+  # of OS limitations.
+  # The latter should be achieved by using a tied filehandle.
+  # Do not check return status since this is all done with END blocks.
+  _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
+
+  # Return
+  if (wantarray()) {
+
+    if ($options{'OPEN'}) {
+      return ($fh, $path);
+    } else {
+      return (undef, $path);
+    }
+
+  } else {
+
+    # Unlink the file. It is up to unlink0 to decide what to do with
+    # this (whether to unlink now or to defer until later)
+    unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
+
+    # Return just the filehandle.
+    return $fh;
+  }
+
+
+}
+
+=item B<tempdir>
+
+This is the recommended interface for creation of temporary directories.
+The behaviour of the function depends on the arguments:
+
+  $tempdir = tempdir();
+
+Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
+
+  $tempdir = tempdir( $template );
+
+Create a directory from the supplied template. This template is
+similar to that described for tempfile(). `X' characters at the end
+of the template are replaced with random letters to construct the
+directory name. At least four `X' characters must be in the template.
+
+  $tempdir = tempdir ( DIR => $dir );
+
+Specifies the directory to use for the temporary directory.
+The temporary directory name is derived from an internal template.
+
+  $tempdir = tempdir ( $template, DIR => $dir );
+
+Prepend the supplied directory name to the template. The template
+should not include parent directory specifications itself. Any parent
+directory specifications are removed from the template before
+prepending the supplied directory.
+
+  $tempdir = tempdir ( $template, TMPDIR => 1 );
+
+Using the supplied template, creat the temporary directory in 
+a standard location for temporary files. Equivalent to doing
+
+  $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
+
+but shorter. Parent directory specifications are stripped from the
+template itself. The C<TMPDIR> option is ignored if C<DIR> is set
+explicitly.  Additionally, C<TMPDIR> is implied if neither a template
+nor a directory are supplied.
+
+  $tempdir = tempdir( $template, CLEANUP => 1);
+
+Create a temporary directory using the supplied template, but 
+attempt to remove it (and all files inside it) when the program
+exits. Note that an attempt will be made to remove all files from
+the directory even if they were not created by this module (otherwise
+why ask to clean it up?). The directory removal is made with
+the rmtree() function from the L<File::Path|File::Path> module.
+Of course, if the template is not specified, the temporary directory
+will be created in tmpdir() and will also be removed at program exit.
+
+=cut
+
+# '
+
+sub tempdir  {
+
+  # Can not check for argument count since we can have any
+  # number of args
+
+  # Default options
+  my %options = (
+		 "CLEANUP"    => 0,  # Remove directory on exit
+		 "DIR"        => '', # Root directory
+		 "TMPDIR"     => 0,  # Use tempdir with template
+		);
+
+  # Check to see whether we have an odd or even number of arguments
+  my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
+
+  # Read the options and merge with defaults
+  %options = (%options, @_)  if @_;
+
+  # Modify or generate the template
+
+  # Deal with the DIR and TMPDIR options
+  if (defined $template) {
+
+    # Need to strip directory path if using DIR or TMPDIR
+    if ($options{'TMPDIR'} || $options{'DIR'}) {
+
+      # Strip parent directory from the filename
+      #
+      # There is no filename at the end
+      $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
+      my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
+
+      # Last directory is then our template
+      $template = (File::Spec->splitdir($directories))[-1];
+
+      # Prepend the supplied directory or temp dir
+      if ($options{"DIR"}) {
+
+        $template = File::Spec->catdir($options{"DIR"}, $template);
+
+      } elsif ($options{TMPDIR}) {
+
+	# Prepend tmpdir
+	$template = File::Spec->catdir(File::Spec->tmpdir, $template);
+
+      }
+
+    }
+
+  } else {
+
+    if ($options{"DIR"}) {
+
+      $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
+
+    } else {
+
+      $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
+
+    }
+
+  }
+
+  # Create the directory
+  my $tempdir;
+  my $suffixlen = 0;
+  if ($^O eq 'VMS') {  # dir names can end in delimiters
+    $template =~ m/([\.\]:>]+)$/;
+    $suffixlen = length($1);
+  }
+
+  my $errstr;
+  croak "Error in tempdir() using $template: $errstr"
+    unless ((undef, $tempdir) = _gettemp($template,
+				    "open" => 0,
+				    "mkdir"=> 1 ,
+				    "suffixlen" => $suffixlen,
+				    "ErrStr" => \$errstr,
+				   ) );
+
+  # Install exit handler; must be dynamic to get lexical
+  if ( $options{'CLEANUP'} && -d $tempdir) {
+    _deferred_unlink(undef, $tempdir, 1);
+  }
+
+  # Return the dir name
+  return $tempdir;
+
+}
+
+=back
+
+=head1 MKTEMP FUNCTIONS
+
+The following functions are Perl implementations of the 
+mktemp() family of temp file generation system calls.
+
+=over 4
+
+=item B<mkstemp>
+
+Given a template, returns a filehandle to the temporary file and the name
+of the file.
+
+  ($fh, $name) = mkstemp( $template );
+
+In scalar context, just the filehandle is returned.
+
+The template may be any filename with some number of X's appended
+to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
+with unique alphanumeric combinations.
+
+=cut
+
+
+
+sub mkstemp {
+
+  croak "Usage: mkstemp(template)"
+    if scalar(@_) != 1;
+
+  my $template = shift;
+
+  my ($fh, $path, $errstr);
+  croak "Error in mkstemp using $template: $errstr"
+    unless (($fh, $path) = _gettemp($template,
+				    "open" => 1,
+				    "mkdir"=> 0 ,
+				    "suffixlen" => 0,
+				    "ErrStr" => \$errstr,
+				   ) );
+
+  if (wantarray()) {
+    return ($fh, $path);
+  } else {
+    return $fh;
+  }
+
+}
+
+
+=item B<mkstemps>
+
+Similar to mkstemp(), except that an extra argument can be supplied
+with a suffix to be appended to the template.
+
+  ($fh, $name) = mkstemps( $template, $suffix );
+
+For example a template of C<testXXXXXX> and suffix of C<.dat>
+would generate a file similar to F<testhGji_w.dat>.
+
+Returns just the filehandle alone when called in scalar context.
+
+=cut
+
+sub mkstemps {
+
+  croak "Usage: mkstemps(template, suffix)"
+    if scalar(@_) != 2;
+
+
+  my $template = shift;
+  my $suffix   = shift;
+
+  $template .= $suffix;
+
+  my ($fh, $path, $errstr);
+  croak "Error in mkstemps using $template: $errstr"
+    unless (($fh, $path) = _gettemp($template,
+				    "open" => 1,
+				    "mkdir"=> 0 ,
+				    "suffixlen" => length($suffix),
+				    "ErrStr" => \$errstr,
+				   ) );
+
+  if (wantarray()) {
+    return ($fh, $path);
+  } else {
+    return $fh;
+  }
+
+}
+
+=item B<mkdtemp>
+
+Create a directory from a template. The template must end in
+X's that are replaced by the routine.
+
+  $tmpdir_name = mkdtemp($template);
+
+Returns the name of the temporary directory created.
+Returns undef on failure.
+
+Directory must be removed by the caller.
+
+=cut
+
+#' # for emacs
+
+sub mkdtemp {
+
+  croak "Usage: mkdtemp(template)"
+    if scalar(@_) != 1;
+
+  my $template = shift;
+  my $suffixlen = 0;
+  if ($^O eq 'VMS') {  # dir names can end in delimiters
+    $template =~ m/([\.\]:>]+)$/;
+    $suffixlen = length($1);
+  }
+  my ($junk, $tmpdir, $errstr);
+  croak "Error creating temp directory from template $template\: $errstr"
+    unless (($junk, $tmpdir) = _gettemp($template,
+					"open" => 0,
+					"mkdir"=> 1 ,
+					"suffixlen" => $suffixlen,
+					"ErrStr" => \$errstr,
+				       ) );
+
+  return $tmpdir;
+
+}
+
+=item B<mktemp>
+
+Returns a valid temporary filename but does not guarantee
+that the file will not be opened by someone else.
+
+  $unopened_file = mktemp($template);
+
+Template is the same as that required by mkstemp().
+
+=cut
+
+sub mktemp {
+
+  croak "Usage: mktemp(template)"
+    if scalar(@_) != 1;
+
+  my $template = shift;
+
+  my ($tmpname, $junk, $errstr);
+  croak "Error getting name to temp file from template $template: $errstr"
+    unless (($junk, $tmpname) = _gettemp($template,
+					 "open" => 0,
+					 "mkdir"=> 0 ,
+					 "suffixlen" => 0,
+					 "ErrStr" => \$errstr,
+					 ) );
+
+  return $tmpname;
+}
+
+=back
+
+=head1 POSIX FUNCTIONS
+
+This section describes the re-implementation of the tmpnam()
+and tmpfile() functions described in L<POSIX> 
+using the mkstemp() from this module.
+
+Unlike the L<POSIX|POSIX> implementations, the directory used
+for the temporary file is not specified in a system include
+file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
+returned by L<File::Spec|File::Spec>. On some implementations this
+location can be set using the C<TMPDIR> environment variable, which
+may not be secure.
+If this is a problem, simply use mkstemp() and specify a template.
+
+=over 4
+
+=item B<tmpnam>
+
+When called in scalar context, returns the full name (including path)
+of a temporary file (uses mktemp()). The only check is that the file does
+not already exist, but there is no guarantee that that condition will
+continue to apply.
+
+  $file = tmpnam();
+
+When called in list context, a filehandle to the open file and
+a filename are returned. This is achieved by calling mkstemp()
+after constructing a suitable template.
+
+  ($fh, $file) = tmpnam();
+
+If possible, this form should be used to prevent possible
+race conditions.
+
+See L<File::Spec/tmpdir> for information on the choice of temporary
+directory for a particular operating system.
+
+=cut
+
+sub tmpnam {
+
+   # Retrieve the temporary directory name
+   my $tmpdir = File::Spec->tmpdir;
+
+   croak "Error temporary directory is not writable"
+     if $tmpdir eq '';
+
+   # Use a ten character template and append to tmpdir
+   my $template = File::Spec->catfile($tmpdir, TEMPXXX);
+
+   if (wantarray() ) {
+       return mkstemp($template);
+   } else {
+       return mktemp($template);
+   }
+
+}
+
+=item B<tmpfile>
+
+In scalar context, returns the filehandle of a temporary file.
+
+  $fh = tmpfile();
+
+The file is removed when the filehandle is closed or when the program
+exits. No access to the filename is provided.
+
+If the temporary file can not be created undef is returned.
+Currently this command will probably not work when the temporary
+directory is on an NFS file system.
+
+=cut
+
+sub tmpfile {
+
+  # Simply call tmpnam() in a list context
+  my ($fh, $file) = tmpnam();
+
+  # Make sure file is removed when filehandle is closed
+  # This will fail on NFS
+  unlink0($fh, $file)
+    or return undef;
+
+  return $fh;
+
+}
+
+=back
+
+=head1 ADDITIONAL FUNCTIONS
+
+These functions are provided for backwards compatibility
+with common tempfile generation C library functions.
+
+They are not exported and must be addressed using the full package
+name. 
+
+=over 4
+
+=item B<tempnam>
+
+Return the name of a temporary file in the specified directory
+using a prefix. The file is guaranteed not to exist at the time
+the function was called, but such guarantees are good for one 
+clock tick only.  Always use the proper form of C<sysopen>
+with C<O_CREAT | O_EXCL> if you must open such a filename.
+
+  $filename = File::Temp::tempnam( $dir, $prefix );
+
+Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
+(using unix file convention as an example) 
+
+Because this function uses mktemp(), it can suffer from race conditions.
+
+=cut
+
+sub tempnam {
+
+  croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
+
+  my ($dir, $prefix) = @_;
+
+  # Add a string to the prefix
+  $prefix .= 'XXXXXXXX';
+
+  # Concatenate the directory to the file
+  my $template = File::Spec->catfile($dir, $prefix);
+
+  return mktemp($template);
+
+}
+
+=back
+
+=head1 UTILITY FUNCTIONS
+
+Useful functions for dealing with the filehandle and filename.
+
+=over 4
+
+=item B<unlink0>
+
+Given an open filehandle and the associated filename, make a safe
+unlink. This is achieved by first checking that the filename and
+filehandle initially point to the same file and that the number of
+links to the file is 1 (all fields returned by stat() are compared).
+Then the filename is unlinked and the filehandle checked once again to
+verify that the number of links on that file is now 0.  This is the
+closest you can come to making sure that the filename unlinked was the
+same as the file whose descriptor you hold.
+
+  unlink0($fh, $path) or die "Error unlinking file $path safely";
+
+Returns false on error. The filehandle is not closed since on some
+occasions this is not required.
+
+On some platforms, for example Windows NT, it is not possible to
+unlink an open file (the file must be closed first). On those
+platforms, the actual unlinking is deferred until the program ends and
+good status is returned. A check is still performed to make sure that
+the filehandle and filename are pointing to the same thing (but not at
+the time the end block is executed since the deferred removal may not
+have access to the filehandle).
+
+Additionally, on Windows NT not all the fields returned by stat() can
+be compared. For example, the C<dev> and C<rdev> fields seem to be
+different.  Also, it seems that the size of the file returned by stat()
+does not always agree, with C<stat(FH)> being more accurate than
+C<stat(filename)>, presumably because of caching issues even when
+using autoflush (this is usually overcome by waiting a while after
+writing to the tempfile before attempting to C<unlink0> it).
+
+Finally, on NFS file systems the link count of the file handle does
+not always go to zero immediately after unlinking. Currently, this
+command is expected to fail on NFS disks.
+
+=cut
+
+sub unlink0 {
+
+  croak 'Usage: unlink0(filehandle, filename)'
+    unless scalar(@_) == 2;
+
+  # Read args
+  my ($fh, $path) = @_;
+
+  warn "Unlinking $path using unlink0\n"
+    if $DEBUG;
+
+  # Stat the filehandle
+  my @fh = stat $fh;
+
+  if ($fh[3] > 1 && $^W) {
+    carp "unlink0: fstat found too many links; SB=@fh" if $^W;
+  }
+
+  # Stat the path
+  my @path = stat $path;
+
+  unless (@path) {
+    carp "unlink0: $path is gone already" if $^W;
+    return;
+  }
+
+  # this is no longer a file, but may be a directory, or worse
+  unless (-f _) {
+    confess "panic: $path is no longer a file: SB=@fh";
+  }
+
+  # Do comparison of each member of the array
+  # On WinNT dev and rdev seem to be different
+  # depending on whether it is a file or a handle.
+  # Cannot simply compare all members of the stat return
+  # Select the ones we can use
+  my @okstat = (0..$#fh);  # Use all by default
+  if ($^O eq 'MSWin32') {
+    @okstat = (1,2,3,4,5,7,8,9,10);
+  } elsif ($^O eq 'os2') {
+    @okstat = (0, 2..$#fh);
+  } elsif ($^O eq 'VMS') { # device and file ID are sufficient
+    @okstat = (0, 1);
+  } elsif ($^O eq 'dos') {
+     @okstat = (0,2..7,11..$#fh);
+  }
+
+  # Now compare each entry explicitly by number
+  for (@okstat) {
+    print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
+    # Use eq rather than == since rdev, blksize, and blocks (6, 11,
+    # and 12) will be '' on platforms that do not support them.  This
+    # is fine since we are only comparing integers.
+    unless ($fh[$_] eq $path[$_]) {
+      warn "Did not match $_ element of stat\n" if $DEBUG;
+      return 0;
+    }
+  }
+
+  # attempt remove the file (does not work on some platforms)
+  if (_can_unlink_opened_file()) {
+    # XXX: do *not* call this on a directory; possible race
+    #      resulting in recursive removal
+    croak "unlink0: $path has become a directory!" if -d $path;
+    unlink($path) or return 0;
+
+    # Stat the filehandle
+    @fh = stat $fh;
+
+    print "Link count = $fh[3] \n" if $DEBUG;
+
+    # Make sure that the link count is zero
+    # - Cygwin provides deferred unlinking, however,
+    #   on Win9x the link count remains 1
+    # On NFS the link count may still be 1 but we cant know that
+    # we are on NFS
+    return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
+
+  } else {
+    _deferred_unlink($fh, $path, 0);
+    return 1;
+  }
+
+}
+
+=back
+
+=head1 PACKAGE VARIABLES
+
+These functions control the global state of the package.
+
+=over 4
+
+=item B<safe_level>
+
+Controls the lengths to which the module will go to check the safety of the
+temporary file or directory before proceeding.
+Options are:
+
+=over 8
+
+=item STANDARD
+
+Do the basic security measures to ensure the directory exists and
+is writable, that the umask() is fixed before opening of the file,
+that temporary files are opened only if they do not already exist, and
+that possible race conditions are avoided.  Finally the L<unlink0|"unlink0">
+function is used to remove files safely.
+
+=item MEDIUM
+
+In addition to the STANDARD security, the output directory is checked
+to make sure that it is owned either by root or the user running the
+program. If the directory is writable by group or by other, it is then
+checked to make sure that the sticky bit is set.
+
+Will not work on platforms that do not support the C<-k> test
+for sticky bit.
+
+=item HIGH
+
+In addition to the MEDIUM security checks, also check for the
+possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
+sysconf() function. If this is a possibility, each directory in the
+path is checked in turn for safeness, recursively walking back to the 
+root directory.
+
+For platforms that do not support the L<POSIX|POSIX>
+C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is 
+assumed that ``chown() giveaway'' is possible and the recursive test
+is performed.
+
+=back
+
+The level can be changed as follows:
+
+  File::Temp->safe_level( File::Temp::HIGH );
+
+The level constants are not exported by the module.
+
+Currently, you must be running at least perl v5.6.0 in order to
+run with MEDIUM or HIGH security. This is simply because the 
+safety tests use functions from L<Fcntl|Fcntl> that are not
+available in older versions of perl. The problem is that the version
+number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
+they are different versions.
+
+On systems that do not support the HIGH or MEDIUM safety levels
+(for example Win NT or OS/2) any attempt to change the level will
+be ignored. The decision to ignore rather than raise an exception
+allows portable programs to be written with high security in mind
+for the systems that can support this without those programs failing
+on systems where the extra tests are irrelevant.
+
+If you really need to see whether the change has been accepted
+simply examine the return value of C<safe_level>.
+
+  $newlevel = File::Temp->safe_level( File::Temp::HIGH );
+  die "Could not change to high security" 
+      if $newlevel != File::Temp::HIGH;
+
+=cut
+
+{
+  # protect from using the variable itself
+  my $LEVEL = STANDARD;
+  sub safe_level {
+    my $self = shift;
+    if (@_) { 
+      my $level = shift;
+      if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
+	carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
+      } else {
+	# Dont allow this on perl 5.005 or earlier
+	if ($] < 5.006 && $level != STANDARD) {
+	  # Cant do MEDIUM or HIGH checks
+	  croak "Currently requires perl 5.006 or newer to do the safe checks";
+	}
+	# Check that we are allowed to change level
+	# Silently ignore if we can not.
+        $LEVEL = $level if _can_do_level($level);
+      }
+    }
+    return $LEVEL;
+  }
+}
+
+=item TopSystemUID
+
+This is the highest UID on the current system that refers to a root
+UID. This is used to make sure that the temporary directory is 
+owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than 
+simply by root.
+
+This is required since on many unix systems C</tmp> is not owned
+by root.
+
+Default is to assume that any UID less than or equal to 10 is a root
+UID.
+
+  File::Temp->top_system_uid(10);
+  my $topid = File::Temp->top_system_uid;
+
+This value can be adjusted to reduce security checking if required.
+The value is only relevant when C<safe_level> is set to MEDIUM or higher.
+
+=back
+
+=cut
+
+{
+  my $TopSystemUID = 10;
+  sub top_system_uid {
+    my $self = shift;
+    if (@_) {
+      my $newuid = shift;
+      croak "top_system_uid: UIDs should be numeric"
+        unless $newuid =~ /^\d+$/s;
+      $TopSystemUID = $newuid;
+    }
+    return $TopSystemUID;
+  }
+}
+
+=head1 WARNING
+
+For maximum security, endeavour always to avoid ever looking at,
+touching, or even imputing the existence of the filename.  You do not
+know that that filename is connected to the same file as the handle
+you have, and attempts to check this can only trigger more race
+conditions.  It's far more secure to use the filehandle alone and
+dispense with the filename altogether.
+
+If you need to pass the handle to something that expects a filename
+then, on a unix system, use C<"/dev/fd/" . fileno($fh)> for arbitrary
+programs, or more generally C<< "+<=&" . fileno($fh) >> for Perl
+programs.  You will have to clear the close-on-exec bit on that file
+descriptor before passing it to another process.
+
+    use Fcntl qw/F_SETFD F_GETFD/;
+    fcntl($tmpfh, F_SETFD, 0)
+        or die "Can't clear close-on-exec flag on temp fh: $!\n";
+
+=head2 Temporary files and NFS
+
+Some problems are associated with using temporary files that reside
+on NFS file systems and it is recommended that a local filesystem
+is used whenever possible. Some of the security tests will most probably
+fail when the temp file is not local. Additionally, be aware that
+the performance of I/O operations over NFS will not be as good as for
+a local disk.
+
+=head1 HISTORY
+
+Originally began life in May 1999 as an XS interface to the system
+mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
+translated to Perl for total control of the code's
+security checking, to ensure the presence of the function regardless of
+operating system and to help with portability.
+
+=head1 SEE ALSO
+
+L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
+
+See L<IO::File> and L<File::MkTemp> for different implementations of 
+temporary file handling.
+
+=head1 AUTHOR
+
+Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>
+
+Copyright (C) 1999-2001 Tim Jenness and the UK Particle Physics and
+Astronomy Research Council. All Rights Reserved.  This program is free
+software; you can redistribute it and/or modify it under the same
+terms as Perl itself.
+
+Original Perl implementation loosely based on the OpenBSD C code for 
+mkstemp(). Thanks to Tom Christiansen for suggesting that this module
+should be written and providing ideas for code improvements and
+security enhancements.
+
+=cut
+
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/File/stat.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/File/stat.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/File/stat.pm	(revision 14265)
@@ -0,0 +1,115 @@
+package File::stat;
+use strict;
+
+use 5.005_64;
+our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+BEGIN { 
+    use Exporter   ();
+    @EXPORT      = qw(stat lstat);
+    @EXPORT_OK   = qw( $st_dev	   $st_ino    $st_mode 
+		       $st_nlink   $st_uid    $st_gid 
+		       $st_rdev    $st_size 
+		       $st_atime   $st_mtime  $st_ctime 
+		       $st_blksize $st_blocks
+		    );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'File::stat' => [
+     map { $_ => '$' } qw{
+	 dev ino mode nlink uid gid rdev size
+	 atime mtime ctime blksize blocks
+     }
+];
+
+sub populate (@) {
+    return unless @_;
+    my $stob = new();
+    @$stob = (
+	$st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev,
+        $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks ) 
+	    = @_;
+    return $stob;
+} 
+
+sub lstat ($)  { populate(CORE::lstat(shift)) }
+
+sub stat ($) {
+    my $arg = shift;
+    my $st = populate(CORE::stat $arg);
+    return $st if $st;
+    no strict 'refs';
+    require Symbol;
+    return populate(CORE::stat \*{Symbol::qualify($arg)});
+}
+
+1;
+__END__
+
+=head1 NAME
+
+File::stat - by-name interface to Perl's built-in stat() functions
+
+=head1 SYNOPSIS
+
+ use File::stat;
+ $st = stat($file) or die "No $file: $!";
+ if ( ($st->mode & 0111) && $st->nlink > 1) ) {
+     print "$file is executable with lotsa links\n";
+ } 
+
+ use File::stat qw(:FIELDS);
+ stat($file) or die "No $file: $!";
+ if ( ($st_mode & 0111) && $st_nlink > 1) ) {
+     print "$file is executable with lotsa links\n";
+ } 
+
+=head1 DESCRIPTION
+
+This module's default exports override the core stat() 
+and lstat() functions, replacing them with versions that return 
+"File::stat" objects.  This object has methods that
+return the similarly named structure field name from the
+stat(2) function; namely,
+dev,
+ino,
+mode,
+nlink,
+uid,
+gid,
+rdev,
+size,
+atime,
+mtime,
+ctime,
+blksize,
+and
+blocks.  
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your stat() and lstat() functions.)  Access these fields as
+variables named with a preceding C<st_> in front their method names.
+Thus, C<$stat_obj-E<gt>dev()> corresponds to $st_dev if you import
+the fields.
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
Index: /for-distributions/trunk/bin/windows/perl/lib/FileCache.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/FileCache.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/FileCache.pm	(revision 14265)
@@ -0,0 +1,78 @@
+package FileCache;
+
+=head1 NAME
+
+FileCache - keep more files open than the system permits
+
+=head1 SYNOPSIS
+
+    cacheout $path;
+    print $path @data;
+
+=head1 DESCRIPTION
+
+The C<cacheout> function will make sure that there's a filehandle open
+for writing available as the pathname you give it.  It automatically
+closes and re-opens files if you exceed your system file descriptor
+maximum.
+
+=head1 BUGS
+
+F<sys/param.h> lies with its C<NOFILE> define on some systems,
+so you may have to set $FileCache::cacheout_maxopen yourself.
+
+=cut
+
+require 5.000;
+use Carp;
+use Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(
+    cacheout
+);
+
+# Open in their package.
+
+sub cacheout_open {
+    my $pack = caller(1);
+    open(*{$pack . '::' . $_[0]}, $_[1]);
+}
+
+sub cacheout_close {
+    my $pack = caller(1);
+    close(*{$pack . '::' . $_[0]});
+}
+
+# But only this sub name is visible to them.
+
+$cacheout_seq = 0;
+$cacheout_numopen = 0;
+
+sub cacheout {
+    ($file) = @_;
+    unless (defined $cacheout_maxopen) {
+	if (open(PARAM,'/usr/include/sys/param.h')) {
+	    local ($_, $.);
+	    while (<PARAM>) {
+		$cacheout_maxopen = $1 - 4
+		    if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
+	    }
+	    close PARAM;
+	}
+	$cacheout_maxopen = 16 unless $cacheout_maxopen;
+    }
+    if (!$isopen{$file}) {
+	if (++$cacheout_numopen > $cacheout_maxopen) {
+	    my @lru = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
+	    splice(@lru, $cacheout_maxopen / 3);
+	    $cacheout_numopen -= @lru;
+	    for (@lru) { &cacheout_close($_); delete $isopen{$_}; }
+	}
+	cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file)
+	    or croak("Can't create $file: $!");
+    }
+    $isopen{$file} = ++$cacheout_seq;
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/FileHandle.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/FileHandle.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/FileHandle.pm	(revision 14265)
@@ -0,0 +1,262 @@
+package FileHandle;
+
+use 5.005_64;
+use strict;
+our($VERSION, @ISA, @EXPORT, @EXPORT_OK);
+
+$VERSION = "2.00";
+
+require IO::File;
+@ISA = qw(IO::File);
+
+@EXPORT = qw(_IOFBF _IOLBF _IONBF);
+
+@EXPORT_OK = qw(
+    pipe
+
+    autoflush
+    output_field_separator
+    output_record_separator
+    input_record_separator
+    input_line_number
+    format_page_number
+    format_lines_per_page
+    format_lines_left
+    format_name
+    format_top_name
+    format_line_break_characters
+    format_formfeed
+
+    print
+    printf
+    getline
+    getlines
+);
+
+#
+# Everything we're willing to export, we must first import.
+#
+import IO::Handle grep { !defined(&$_) } @EXPORT, @EXPORT_OK;
+
+#
+# Some people call "FileHandle::function", so all the functions
+# that were in the old FileHandle class must be imported, too.
+#
+{
+    no strict 'refs';
+
+    my %import = (
+	'IO::Handle' =>
+	    [qw(DESTROY new_from_fd fdopen close fileno getc ungetc gets
+		eof flush error clearerr setbuf setvbuf _open_mode_string)],
+	'IO::Seekable' =>
+	    [qw(seek tell getpos setpos)],
+	'IO::File' =>
+	    [qw(new new_tmpfile open)]
+    );
+    for my $pkg (keys %import) {
+	for my $func (@{$import{$pkg}}) {
+	    my $c = *{"${pkg}::$func"}{CODE}
+		or die "${pkg}::$func missing";
+	    *$func = $c;
+	}
+    }
+}
+
+#
+# Specialized importer for Fcntl magic.
+#
+sub import {
+    my $pkg = shift;
+    my $callpkg = caller;
+    require Exporter;
+    Exporter::export($pkg, $callpkg, @_);
+
+    #
+    # If the Fcntl extension is available,
+    #  export its constants.
+    #
+    eval {
+	require Fcntl;
+	Exporter::export('Fcntl', $callpkg);
+    };
+}
+
+################################################
+# This is the only exported function we define;
+# the rest come from other classes.
+#
+
+sub pipe {
+    my $r = new IO::Handle;
+    my $w = new IO::Handle;
+    CORE::pipe($r, $w) or return undef;
+    ($r, $w);
+}
+
+# Rebless standard file handles
+bless *STDIN{IO},  "FileHandle" if ref *STDIN{IO}  eq "IO::Handle";
+bless *STDOUT{IO}, "FileHandle" if ref *STDOUT{IO} eq "IO::Handle";
+bless *STDERR{IO}, "FileHandle" if ref *STDERR{IO} eq "IO::Handle";
+
+1;
+
+__END__
+
+=head1 NAME
+
+FileHandle - supply object methods for filehandles
+
+=head1 SYNOPSIS
+
+    use FileHandle;
+
+    $fh = new FileHandle;
+    if ($fh->open("< file")) {
+        print <$fh>;
+        $fh->close;
+    }
+
+    $fh = new FileHandle "> FOO";
+    if (defined $fh) {
+        print $fh "bar\n";
+        $fh->close;
+    }
+
+    $fh = new FileHandle "file", "r";
+    if (defined $fh) {
+        print <$fh>;
+        undef $fh;       # automatically closes the file
+    }
+
+    $fh = new FileHandle "file", O_WRONLY|O_APPEND;
+    if (defined $fh) {
+        print $fh "corge\n";
+        undef $fh;       # automatically closes the file
+    }
+
+    $pos = $fh->getpos;
+    $fh->setpos($pos);
+
+    $fh->setvbuf($buffer_var, _IOLBF, 1024);
+
+    ($readfh, $writefh) = FileHandle::pipe;
+
+    autoflush STDOUT 1;
+
+=head1 DESCRIPTION
+
+NOTE: This class is now a front-end to the IO::* classes.
+
+C<FileHandle::new> creates a C<FileHandle>, which is a reference to a
+newly created symbol (see the C<Symbol> package).  If it receives any
+parameters, they are passed to C<FileHandle::open>; if the open fails,
+the C<FileHandle> object is destroyed.  Otherwise, it is returned to
+the caller.
+
+C<FileHandle::new_from_fd> creates a C<FileHandle> like C<new> does.
+It requires two parameters, which are passed to C<FileHandle::fdopen>;
+if the fdopen fails, the C<FileHandle> object is destroyed.
+Otherwise, it is returned to the caller.
+
+C<FileHandle::open> accepts one parameter or two.  With one parameter,
+it is just a front end for the built-in C<open> function.  With two
+parameters, the first parameter is a filename that may include
+whitespace or other special characters, and the second parameter is
+the open mode, optionally followed by a file permission value.
+
+If C<FileHandle::open> receives a Perl mode string (">", "+<", etc.)
+or a POSIX fopen() mode string ("w", "r+", etc.), it uses the basic
+Perl C<open> operator.
+
+If C<FileHandle::open> is given a numeric mode, it passes that mode
+and the optional permissions value to the Perl C<sysopen> operator.
+For convenience, C<FileHandle::import> tries to import the O_XXX
+constants from the Fcntl module.  If dynamic loading is not available,
+this may fail, but the rest of FileHandle will still work.
+
+C<FileHandle::fdopen> is like C<open> except that its first parameter
+is not a filename but rather a file handle name, a FileHandle object,
+or a file descriptor number.
+
+If the C functions fgetpos() and fsetpos() are available, then
+C<FileHandle::getpos> returns an opaque value that represents the
+current position of the FileHandle, and C<FileHandle::setpos> uses
+that value to return to a previously visited position.
+
+If the C function setvbuf() is available, then C<FileHandle::setvbuf>
+sets the buffering policy for the FileHandle.  The calling sequence
+for the Perl function is the same as its C counterpart, including the
+macros C<_IOFBF>, C<_IOLBF>, and C<_IONBF>, except that the buffer
+parameter specifies a scalar variable to use as a buffer.  WARNING: A
+variable used as a buffer by C<FileHandle::setvbuf> must not be
+modified in any way until the FileHandle is closed or until
+C<FileHandle::setvbuf> is called again, or memory corruption may
+result!
+
+See L<perlfunc> for complete descriptions of each of the following
+supported C<FileHandle> methods, which are just front ends for the
+corresponding built-in functions:
+
+    close
+    fileno
+    getc
+    gets
+    eof
+    clearerr
+    seek
+    tell
+
+See L<perlvar> for complete descriptions of each of the following
+supported C<FileHandle> methods:
+
+    autoflush
+    output_field_separator
+    output_record_separator
+    input_record_separator
+    input_line_number
+    format_page_number
+    format_lines_per_page
+    format_lines_left
+    format_name
+    format_top_name
+    format_line_break_characters
+    format_formfeed
+
+Furthermore, for doing normal I/O you might need these:
+
+=over 
+
+=item $fh->print
+
+See L<perlfunc/print>.
+
+=item $fh->printf
+
+See L<perlfunc/printf>.
+
+=item $fh->getline
+
+This works like <$fh> described in L<perlop/"I/O Operators">
+except that it's more readable and can be safely called in a
+list context but still returns just one line.
+
+=item $fh->getlines
+
+This works like <$fh> when called in a list context to
+read all the remaining lines in a file, except that it's more readable.
+It will also croak() if accidentally called in a scalar context.
+
+=back
+
+There are many other functions available since FileHandle is descended
+from IO::File, IO::Seekable, and IO::Handle.  Please see those
+respective pages for documentation on more functions.
+
+=head1 SEE ALSO
+
+The B<IO> extension,
+L<perlfunc>, 
+L<perlop/"I/O Operators">.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/FindBin.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/FindBin.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/FindBin.pm	(revision 14265)
@@ -0,0 +1,169 @@
+# FindBin.pm
+#
+# Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved.
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+=head1 NAME
+
+FindBin - Locate directory of original perl script
+
+=head1 SYNOPSIS
+
+ use FindBin;
+ use lib "$FindBin::Bin/../lib";
+
+ or
+
+ use FindBin qw($Bin);
+ use lib "$Bin/../lib";
+
+=head1 DESCRIPTION
+
+Locates the full path to the script bin directory to allow the use
+of paths relative to the bin directory.
+
+This allows a user to setup a directory tree for some software with
+directories E<lt>rootE<gt>/bin and E<lt>rootE<gt>/lib and then the above example will allow
+the use of modules in the lib directory without knowing where the software
+tree is installed.
+
+If perl is invoked using the B<-e> option or the perl script is read from
+C<STDIN> then FindBin sets both C<$Bin> and C<$RealBin> to the current
+directory.
+
+=head1 EXPORTABLE VARIABLES
+
+ $Bin         - path to bin directory from where script was invoked
+ $Script      - basename of script from which perl was invoked
+ $RealBin     - $Bin with all links resolved
+ $RealScript  - $Script with all links resolved
+
+=head1 KNOWN BUGS
+
+if perl is invoked as
+
+   perl filename
+
+and I<filename> does not have executable rights and a program called I<filename>
+exists in the users C<$ENV{PATH}> which satisfies both B<-x> and B<-T> then FindBin
+assumes that it was invoked via the C<$ENV{PATH}>.
+
+Workaround is to invoke perl as
+
+ perl ./filename
+
+=head1 AUTHORS
+
+FindBin is supported as part of the core perl distribution. Please send bug
+reports to E<lt>F<perlbug@perl.org>E<gt> using the perlbug program included with perl.
+
+Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
+Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. 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 FindBin;
+use Carp;
+require 5.000;
+require Exporter;
+use Cwd qw(getcwd abs_path);
+use Config;
+use File::Basename;
+use File::Spec;
+
+@EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir);
+%EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
+@ISA = qw(Exporter);
+
+$VERSION = "1.42";
+
+BEGIN
+{
+ *Dir = \$Bin;
+ *RealDir = \$RealBin;
+
+ if($0 eq '-e' || $0 eq '-')
+  {
+   # perl invoked with -e or script is on C<STDIN>
+
+   $Script = $RealScript = $0;
+   $Bin    = $RealBin    = getcwd();
+  }
+ else
+  {
+   my $script = $0;
+
+   if ($^O eq 'VMS')
+    {
+     ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*\])(.*)/s;
+     ($RealBin,$RealScript) = ($Bin,$Script);
+    }
+   else
+    {
+     my $IsWin32 = $^O eq 'MSWin32';
+     unless(($script =~ m#/# || ($IsWin32 && $script =~ m#\\#))
+            && -f $script)
+      {
+       my $dir;
+       foreach $dir (File::Spec->path)
+	{
+        my $scr = File::Spec->catfile($dir, $script);
+	if(-r $scr && (!$IsWin32 || -x _))
+         {
+          $script = $scr;
+
+	  if (-f $0)
+           {
+	    # $script has been found via PATH but perl could have
+	    # been invoked as 'perl file'. Do a dumb check to see
+	    # if $script is a perl program, if not then $script = $0
+            #
+            # well we actually only check that it is an ASCII file
+            # we know its executable so it is probably a script
+            # of some sort.
+
+            $script = $0 unless(-T $script);
+           }
+          last;
+         }
+       }
+     }
+
+     croak("Cannot find current script '$0'") unless(-f $script);
+
+     # Ensure $script contains the complete path incase we C<chdir>
+
+     $script = File::Spec->catfile(getcwd(), $script)
+       unless File::Spec->file_name_is_absolute($script);
+
+     ($Script,$Bin) = fileparse($script);
+
+     # Resolve $script if it is a link
+     while(1)
+      {
+       my $linktext = readlink($script);
+
+       ($RealScript,$RealBin) = fileparse($script);
+       last unless defined $linktext;
+
+       $script = (File::Spec->file_name_is_absolute($linktext))
+                  ? $linktext
+                  : File::Spec->catfile($RealBin, $linktext);
+      }
+
+     # Get absolute paths to directories
+     $Bin     = abs_path($Bin)     if($Bin);
+     $RealBin = abs_path($RealBin) if($RealBin);
+    }
+  }
+}
+
+1; # Keep require happy
+
Index: /for-distributions/trunk/bin/windows/perl/lib/I18N/Collate.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/I18N/Collate.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/I18N/Collate.pm	(revision 14265)
@@ -0,0 +1,190 @@
+package I18N::Collate;
+
+=head1 NAME
+
+I18N::Collate - compare 8-bit scalar data according to the current locale
+
+  ***
+
+  WARNING: starting from the Perl version 5.003_06
+  the I18N::Collate interface for comparing 8-bit scalar data
+  according to the current locale
+
+	HAS BEEN DEPRECATED
+
+  That is, please do not use it anymore for any new applications
+  and please migrate the old applications away from it because its
+  functionality was integrated into the Perl core language in the
+  release 5.003_06.
+
+  See the perllocale manual page for further information.
+
+  ***
+
+=head1 SYNOPSIS
+
+    use I18N::Collate;
+    setlocale(LC_COLLATE, 'locale-of-your-choice'); 
+    $s1 = new I18N::Collate "scalar_data_1";
+    $s2 = new I18N::Collate "scalar_data_2";
+
+=head1 DESCRIPTION
+
+This module provides you with objects that will collate 
+according to your national character set, provided that the 
+POSIX setlocale() function is supported on your system.
+
+You can compare $s1 and $s2 above with
+
+    $s1 le $s2
+
+to extract the data itself, you'll need a dereference: $$s1
+
+This module uses POSIX::setlocale(). The basic collation conversion is
+done by strxfrm() which terminates at NUL characters being a decent C
+routine.  collate_xfrm() handles embedded NUL characters gracefully.
+
+The available locales depend on your operating system; try whether
+C<locale -a> shows them or man pages for "locale" or "nlsinfo" or the
+direct approach C<ls /usr/lib/nls/loc> or C<ls /usr/lib/nls> or
+C<ls /usr/lib/locale>.  Not all the locales that your vendor supports
+are necessarily installed: please consult your operating system's
+documentation and possibly your local system administration.  The
+locale names are probably something like C<xx_XX.(ISO)?8859-N> or
+C<xx_XX.(ISO)?8859N>, for example C<fr_CH.ISO8859-1> is the Swiss (CH)
+variant of French (fr), ISO Latin (8859) 1 (-1) which is the Western
+European character set.
+
+=cut
+
+# I18N::Collate.pm
+#
+# Author:	Jarkko Hietaniemi <F<jhi@iki.fi>>
+#		Helsinki University of Technology, Finland
+#
+# Acks:		Guy Decoux <F<decoux@moulon.inra.fr>> understood
+#		overloading magic much deeper than I and told
+#		how to cut the size of this code by more than half.
+#		(my first version did overload all of lt gt eq le ge cmp)
+#
+# Purpose:      compare 8-bit scalar data according to the current locale
+#
+# Requirements:	Perl5 POSIX::setlocale() and POSIX::strxfrm()
+#
+# Exports:	setlocale 1)
+#		collate_xfrm 2)
+#
+# Overloads:	cmp # 3)
+#
+# Usage:	use I18N::Collate;
+#	        setlocale(LC_COLLATE, 'locale-of-your-choice'); # 4)
+#		$s1 = new I18N::Collate "scalar_data_1";
+#		$s2 = new I18N::Collate "scalar_data_2";
+#		
+#		now you can compare $s1 and $s2: $s1 le $s2
+#		to extract the data itself, you need to deref: $$s1
+#		
+# Notes:	
+#		1) this uses POSIX::setlocale
+#		2) the basic collation conversion is done by strxfrm() which
+#		   terminates at NUL characters being a decent C routine.
+#		   collate_xfrm handles embedded NUL characters gracefully.
+#		3) due to cmp and overload magic, lt le eq ge gt work also
+#		4) the available locales depend on your operating system;
+#		   try whether "locale -a" shows them or man pages for
+#		   "locale" or "nlsinfo" work or the more direct
+#		   approach "ls /usr/lib/nls/loc" or "ls /usr/lib/nls".
+#		   Not all the locales that your vendor supports
+#		   are necessarily installed: please consult your
+#		   operating system's documentation.
+#		   The locale names are probably something like
+#		   'xx_XX.(ISO)?8859-N' or 'xx_XX.(ISO)?8859N',
+#		   for example 'fr_CH.ISO8859-1' is the Swiss (CH)
+#		   variant of French (fr), ISO Latin (8859) 1 (-1)
+#		   which is the Western European character set.
+#
+# Updated:	19961005
+#
+# ---
+
+use POSIX qw(strxfrm LC_COLLATE);
+use warnings::register;
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(collate_xfrm setlocale LC_COLLATE);
+@EXPORT_OK = qw();
+
+use overload qw(
+fallback	1
+cmp		collate_cmp
+);
+
+sub new {
+  my $new = $_[1];
+
+  if (warnings::enabled() && $] >= 5.003_06) {
+    unless ($please_use_I18N_Collate_even_if_deprecated) {
+      warnings::warn <<___EOD___;
+***
+
+  WARNING: starting from the Perl version 5.003_06
+  the I18N::Collate interface for comparing 8-bit scalar data
+  according to the current locale
+
+	HAS BEEN DEPRECATED
+
+  That is, please do not use it anymore for any new applications
+  and please migrate the old applications away from it because its
+  functionality was integrated into the Perl core language in the
+  release 5.003_06.
+
+  See the perllocale manual page for further information.
+
+***
+___EOD___
+      $please_use_I18N_Collate_even_if_deprecated++;
+    }
+  }
+
+  bless \$new;
+}
+
+sub setlocale {
+ my ($category, $locale) = @_[0,1];
+
+ POSIX::setlocale($category, $locale) if (defined $category);
+ # the current $LOCALE 
+ $LOCALE = $locale || $ENV{'LC_COLLATE'} || $ENV{'LC_ALL'} || '';
+}
+
+sub C {
+  my $s = ${$_[0]};
+
+  $C->{$LOCALE}->{$s} = collate_xfrm($s)
+    unless (defined $C->{$LOCALE}->{$s}); # cache when met
+
+  $C->{$LOCALE}->{$s};
+}
+
+sub collate_xfrm {
+  my $s = $_[0];
+  my $x = '';
+  
+  for (split(/(\000+)/, $s)) {
+    $x .= (/^\000/) ? $_ : strxfrm("$_\000");
+  }
+
+  $x;
+}
+
+sub collate_cmp {
+  &C($_[0]) cmp &C($_[1]);
+}
+
+# init $LOCALE
+
+&I18N::Collate::setlocale();
+
+1; # keep require happy
Index: /for-distributions/trunk/bin/windows/perl/lib/IO.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/IO.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/IO.pm	(revision 14265)
@@ -0,0 +1,47 @@
+#
+
+package IO;
+
+use XSLoader ();
+use Carp;
+
+$VERSION = "1.20";
+XSLoader::load 'IO', $VERSION;
+
+sub import {
+    shift;
+    my @l = @_ ? @_ : qw(Handle Seekable File Pipe Socket Dir);
+
+    eval join("", map { "require IO::" . (/(\w+)/)[0] . ";\n" } @l)
+	or croak $@;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+IO - load various IO modules
+
+=head1 SYNOPSIS
+
+    use IO;
+
+=head1 DESCRIPTION
+
+C<IO> provides a simple mechanism to load some of the IO modules at one go.
+Currently this includes:
+
+      IO::Handle
+      IO::Seekable
+      IO::File
+      IO::Pipe
+      IO::Socket
+      IO::Dir
+
+For more information on any of these modules, please see its respective
+documentation.
+
+=cut
+
Index: /for-distributions/trunk/bin/windows/perl/lib/IO/Dir.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/IO/Dir.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/IO/Dir.pm	(revision 14265)
@@ -0,0 +1,239 @@
+# IO::Dir.pm
+#
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Dir;
+
+use 5.003_26;
+
+use strict;
+use Carp;
+use Symbol;
+use Exporter;
+use IO::File;
+our(@ISA, $VERSION, @EXPORT_OK);
+use Tie::Hash;
+use File::stat;
+
+@ISA = qw(Tie::Hash Exporter);
+$VERSION = "1.03";
+@EXPORT_OK = qw(DIR_UNLINK);
+
+sub DIR_UNLINK () { 1 }
+
+sub new {
+    @_ >= 1 && @_ <= 2 or croak 'usage: new IO::Dir [DIRNAME]';
+    my $class = shift;
+    my $dh = gensym;
+    if (@_) {
+	IO::Dir::open($dh, $_[0])
+	    or return undef;
+    }
+    bless $dh, $class;
+}
+
+sub DESTROY {
+    my ($dh) = @_;
+    closedir($dh);
+}
+
+sub open {
+    @_ == 2 or croak 'usage: $dh->open(DIRNAME)';
+    my ($dh, $dirname) = @_;
+    return undef
+	unless opendir($dh, $dirname);
+    ${*$dh}{io_dir_path} = $dirname;
+    1;
+}
+
+sub close {
+    @_ == 1 or croak 'usage: $dh->close()';
+    my ($dh) = @_;
+    closedir($dh);
+}
+
+sub read {
+    @_ == 1 or croak 'usage: $dh->read()';
+    my ($dh) = @_;
+    readdir($dh);
+}
+
+sub seek {
+    @_ == 2 or croak 'usage: $dh->seek(POS)';
+    my ($dh,$pos) = @_;
+    seekdir($dh,$pos);
+}
+
+sub tell {
+    @_ == 1 or croak 'usage: $dh->tell()';
+    my ($dh) = @_;
+    telldir($dh);
+}
+
+sub rewind {
+    @_ == 1 or croak 'usage: $dh->rewind()';
+    my ($dh) = @_;
+    rewinddir($dh);
+}
+
+sub TIEHASH {
+    my($class,$dir,$options) = @_;
+
+    my $dh = $class->new($dir)
+	or return undef;
+
+    $options ||= 0;
+
+    ${*$dh}{io_dir_unlink} = $options & DIR_UNLINK;
+    $dh;
+}
+
+sub FIRSTKEY {
+    my($dh) = @_;
+    $dh->rewind;
+    scalar $dh->read;
+}
+
+sub NEXTKEY {
+    my($dh) = @_;
+    scalar $dh->read;
+}
+
+sub EXISTS {
+    my($dh,$key) = @_;
+    -e ${*$dh}{io_dir_path} . "/" . $key;
+}
+
+sub FETCH {
+    my($dh,$key) = @_;
+    &lstat(${*$dh}{io_dir_path} . "/" . $key);
+}
+
+sub STORE {
+    my($dh,$key,$data) = @_;
+    my($atime,$mtime) = ref($data) ? @$data : ($data,$data);
+    my $file = ${*$dh}{io_dir_path} . "/" . $key;
+    unless(-e $file) {
+	my $io = IO::File->new($file,O_CREAT | O_RDWR);
+	$io->close if $io;
+    }
+    utime($atime,$mtime, $file);
+}
+
+sub DELETE {
+    my($dh,$key) = @_;
+    # Only unlink if unlink-ing is enabled
+    my $file = ${*$dh}{io_dir_path} . "/" . $key;
+
+    return 0
+	unless ${*$dh}{io_dir_unlink};
+
+    -d $file
+	? rmdir($file)
+	: unlink($file);
+}
+
+1;
+
+__END__
+
+=head1 NAME 
+
+IO::Dir - supply object methods for directory handles
+
+=head1 SYNOPSIS
+
+    use IO::Dir;
+    $d = new IO::Dir ".";
+    if (defined $d) {
+        while (defined($_ = $d->read)) { something($_); }
+        $d->rewind;
+        while (defined($_ = $d->read)) { something_else($_); }
+        undef $d;
+    }
+
+    tie %dir, IO::Dir, ".";
+    foreach (keys %dir) {
+	print $_, " " , $dir{$_}->size,"\n";
+    }
+
+=head1 DESCRIPTION
+
+The C<IO::Dir> package provides two interfaces to perl's directory reading
+routines.
+
+The first interface is an object approach. C<IO::Dir> provides an object
+constructor and methods, which are just wrappers around perl's built in
+directory reading routines.
+
+=over 4
+
+=item new ( [ DIRNAME ] )
+
+C<new> is the constuctor for C<IO::Dir> objects. It accepts one optional
+argument which,  if given, C<new> will pass to C<open>
+
+=back
+
+The following methods are wrappers for the directory related functions built
+into perl (the trailing `dir' has been removed from the names). See L<perlfunc>
+for details of these functions.
+
+=over 4
+
+=item open ( DIRNAME )
+
+=item read ()
+
+=item seek ( POS )
+
+=item tell ()
+
+=item rewind ()
+
+=item close ()
+
+=back
+
+C<IO::Dir> also provides a interface to reading directories via a tied
+HASH. The tied HASH extends the interface beyond just the directory
+reading routines by the use of C<lstat>, from the C<File::stat> package,
+C<unlink>, C<rmdir> and C<utime>.
+
+=over 4
+
+=item tie %hash, IO::Dir, DIRNAME [, OPTIONS ]
+
+=back
+
+The keys of the HASH will be the names of the entries in the directory. 
+Reading a value from the hash will be the result of calling
+C<File::stat::lstat>. Deleting an element from the hash will call C<unlink>
+providing that C<DIR_UNLINK> is passed in the C<OPTIONS>.
+
+Assigning to an entry in the HASH will cause the time stamps of the file
+to be modified. If the file does not exist then it will be created. Assigning
+a single integer to a HASH element will cause both the access and 
+modification times to be changed to that value. Alternatively a reference to
+an array of two values can be passed. The first array element will be used to
+set the access time and the second element will be used to set the modification
+time.
+
+=head1 SEE ALSO
+
+L<File::stat>
+
+=head1 AUTHOR
+
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/IO/File.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/IO/File.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/IO/File.pm	(revision 14265)
@@ -0,0 +1,169 @@
+#
+
+package IO::File;
+
+=head1 NAME
+
+IO::File - supply object methods for filehandles
+
+=head1 SYNOPSIS
+
+    use IO::File;
+
+    $fh = new IO::File;
+    if ($fh->open("< file")) {
+        print <$fh>;
+        $fh->close;
+    }
+
+    $fh = new IO::File "> file";
+    if (defined $fh) {
+        print $fh "bar\n";
+        $fh->close;
+    }
+
+    $fh = new IO::File "file", "r";
+    if (defined $fh) {
+        print <$fh>;
+        undef $fh;       # automatically closes the file
+    }
+
+    $fh = new IO::File "file", O_WRONLY|O_APPEND;
+    if (defined $fh) {
+        print $fh "corge\n";
+
+        $pos = $fh->getpos;
+        $fh->setpos($pos);
+
+        undef $fh;       # automatically closes the file
+    }
+
+    autoflush STDOUT 1;
+
+=head1 DESCRIPTION
+
+C<IO::File> inherits from C<IO::Handle> and C<IO::Seekable>. It extends
+these classes with methods that are specific to file handles.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( FILENAME [,MODE [,PERMS]] )
+
+Creates a C<IO::File>.  If it receives any parameters, they are passed to
+the method C<open>; if the open fails, the object is destroyed.  Otherwise,
+it is returned to the caller.
+
+=item new_tmpfile
+
+Creates an C<IO::File> opened for read/write on a newly created temporary
+file.  On systems where this is possible, the temporary file is anonymous
+(i.e. it is unlinked after creation, but held open).  If the temporary
+file cannot be created or opened, the C<IO::File> object is destroyed.
+Otherwise, it is returned to the caller.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item open( FILENAME [,MODE [,PERMS]] )
+
+C<open> accepts one, two or three parameters.  With one parameter,
+it is just a front end for the built-in C<open> function.  With two or three
+parameters, the first parameter is a filename that may include
+whitespace or other special characters, and the second parameter is
+the open mode, optionally followed by a file permission value.
+
+If C<IO::File::open> receives a Perl mode string ("E<gt>", "+E<lt>", etc.)
+or a ANSI C fopen() mode string ("w", "r+", etc.), it uses the basic
+Perl C<open> operator (but protects any special characters).
+
+If C<IO::File::open> is given a numeric mode, it passes that mode
+and the optional permissions value to the Perl C<sysopen> operator.
+The permissions default to 0666.
+
+For convenience, C<IO::File> exports the O_XXX constants from the
+Fcntl module, if this module is available.
+
+=back
+
+=head1 SEE ALSO
+
+L<perlfunc>, 
+L<perlop/"I/O Operators">,
+L<IO::Handle>
+L<IO::Seekable>
+
+=head1 HISTORY
+
+Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>.
+
+=cut
+
+require 5.005_64;
+use strict;
+our($VERSION, @EXPORT, @EXPORT_OK, @ISA);
+use Carp;
+use Symbol;
+use SelectSaver;
+use IO::Seekable;
+use File::Spec;
+
+require Exporter;
+
+@ISA = qw(IO::Handle IO::Seekable Exporter);
+
+$VERSION = "1.08";
+
+@EXPORT = @IO::Seekable::EXPORT;
+
+eval {
+    # Make all Fcntl O_XXX constants available for importing
+    require Fcntl;
+    my @O = grep /^O_/, @Fcntl::EXPORT;
+    Fcntl->import(@O);  # first we import what we want to export
+    push(@EXPORT, @O);
+};
+
+################################################
+## Constructor
+##
+
+sub new {
+    my $type = shift;
+    my $class = ref($type) || $type || "IO::File";
+    @_ >= 0 && @_ <= 3
+	or croak "usage: new $class [FILENAME [,MODE [,PERMS]]]";
+    my $fh = $class->SUPER::new();
+    if (@_) {
+	$fh->open(@_)
+	    or return undef;
+    }
+    $fh;
+}
+
+################################################
+## Open
+##
+
+sub open {
+    @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])';
+    my ($fh, $file) = @_;
+    if (@_ > 2) {
+	my ($mode, $perms) = @_[2, 3];
+	if ($mode =~ /^\d+$/) {
+	    defined $perms or $perms = 0666;
+	    return sysopen($fh, $file, $mode, $perms);
+	}
+	if (! File::Spec->file_name_is_absolute($file)) {
+            $file = File::Spec->catfile(File::Spec->curdir(),$file);
+        }
+	$file = IO::Handle::_open_mode_string($mode) . " $file\0";
+    }
+    open($fh, $file);
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/IO/Handle.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/IO/Handle.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/IO/Handle.pm	(revision 14265)
@@ -0,0 +1,612 @@
+
+package IO::Handle;
+
+=head1 NAME
+
+IO::Handle - supply object methods for I/O handles
+
+=head1 SYNOPSIS
+
+    use IO::Handle;
+
+    $io = new IO::Handle;
+    if ($io->fdopen(fileno(STDIN),"r")) {
+        print $io->getline;
+        $io->close;
+    }
+
+    $io = new IO::Handle;
+    if ($io->fdopen(fileno(STDOUT),"w")) {
+        $io->print("Some text\n");
+    }
+
+    use IO::Handle '_IOLBF';
+    $io->setvbuf($buffer_var, _IOLBF, 1024);
+
+    undef $io;       # automatically closes the file if it's open
+
+    autoflush STDOUT 1;
+
+=head1 DESCRIPTION
+
+C<IO::Handle> is the base class for all other IO handle classes. It is
+not intended that objects of C<IO::Handle> would be created directly,
+but instead C<IO::Handle> is inherited from by several other classes
+in the IO hierarchy.
+
+If you are reading this documentation, looking for a replacement for
+the C<FileHandle> package, then I suggest you read the documentation
+for C<IO::File> too.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ()
+
+Creates a new C<IO::Handle> object.
+
+=item new_from_fd ( FD, MODE )
+
+Creates a C<IO::Handle> like C<new> does.
+It requires two parameters, which are passed to the method C<fdopen>;
+if the fdopen fails, the object is destroyed. Otherwise, it is returned
+to the caller.
+
+=back
+
+=head1 METHODS
+
+See L<perlfunc> for complete descriptions of each of the following
+supported C<IO::Handle> methods, which are just front ends for the
+corresponding built-in functions:
+
+    $io->close
+    $io->eof
+    $io->fileno
+    $io->format_write( [FORMAT_NAME] )
+    $io->getc
+    $io->read ( BUF, LEN, [OFFSET] )
+    $io->print ( ARGS )
+    $io->printf ( FMT, [ARGS] )
+    $io->stat
+    $io->sysread ( BUF, LEN, [OFFSET] )
+    $io->syswrite ( BUF, [LEN, [OFFSET]] )
+    $io->truncate ( LEN )
+
+See L<perlvar> for complete descriptions of each of the following
+supported C<IO::Handle> methods.  All of them return the previous
+value of the attribute and takes an optional single argument that when
+given will set the value.  If no argument is given the previous value
+is unchanged (except for $io->autoflush will actually turn ON
+autoflush by default).
+
+    $io->autoflush ( [BOOL] )                         $|
+    $io->format_page_number( [NUM] )                  $%
+    $io->format_lines_per_page( [NUM] )               $=
+    $io->format_lines_left( [NUM] )                   $-
+    $io->format_name( [STR] )                         $~
+    $io->format_top_name( [STR] )                     $^
+    $io->input_line_number( [NUM])                    $.
+
+The following methods are not supported on a per-filehandle basis.
+
+    IO::Handle->format_line_break_characters( [STR] ) $:
+    IO::Handle->format_formfeed( [STR])               $^L
+    IO::Handle->output_field_separator( [STR] )       $,
+    IO::Handle->output_record_separator( [STR] )      $\
+
+    IO::Handle->input_record_separator( [STR] )       $/
+
+Furthermore, for doing normal I/O you might need these:
+
+=over 
+
+=item $io->fdopen ( FD, MODE )
+
+C<fdopen> is like an ordinary C<open> except that its first parameter
+is not a filename but rather a file handle name, a IO::Handle object,
+or a file descriptor number.
+
+=item $io->opened
+
+Returns true if the object is currently a valid file descriptor, false
+otherwise.
+
+=item $io->getline
+
+This works like <$io> described in L<perlop/"I/O Operators">
+except that it's more readable and can be safely called in a
+list context but still returns just one line.
+
+=item $io->getlines
+
+This works like <$io> when called in a list context to read all
+the remaining lines in a file, except that it's more readable.
+It will also croak() if accidentally called in a scalar context.
+
+=item $io->ungetc ( ORD )
+
+Pushes a character with the given ordinal value back onto the given
+handle's input stream.  Only one character of pushback per handle is
+guaranteed.
+
+=item $io->write ( BUF, LEN [, OFFSET ] )
+
+This C<write> is like C<write> found in C, that is it is the
+opposite of read. The wrapper for the perl C<write> function is
+called C<format_write>.
+
+=item $io->error
+
+Returns a true value if the given handle has experienced any errors
+since it was opened or since the last call to C<clearerr>, or if the
+handle is invalid. It only returns false for a valid handle with no
+outstanding errors.
+
+=item $io->clearerr
+
+Clear the given handle's error indicator. Returns -1 if the handle is
+invalid, 0 otherwise.
+
+=item $io->sync
+
+C<sync> synchronizes a file's in-memory state  with  that  on the
+physical medium. C<sync> does not operate at the perlio api level, but
+operates on the file descriptor (similar to sysread, sysseek and
+systell). This means that any data held at the perlio api level will not
+be synchronized. To synchronize data that is buffered at the perlio api
+level you must use the flush method. C<sync> is not implemented on all
+platforms. Returns "0 but true" on success, C<undef> on error, C<undef>
+for an invalid handle. See L<fsync(3c)>.
+
+=item $io->flush
+
+C<flush> causes perl to flush any buffered data at the perlio api level.
+Any unread data in the buffer will be discarded, and any unwritten data
+will be written to the underlying file descriptor. Returns "0 but true"
+on success, C<undef> on error.
+
+=item $io->printflush ( ARGS )
+
+Turns on autoflush, print ARGS and then restores the autoflush status of the
+C<IO::Handle> object. Returns the return value from print.
+
+=item $io->blocking ( [ BOOL ] )
+
+If called with an argument C<blocking> will turn on non-blocking IO if
+C<BOOL> is false, and turn it off if C<BOOL> is true.
+
+C<blocking> will return the value of the previous setting, or the
+current setting if C<BOOL> is not given. 
+
+If an error occurs C<blocking> will return undef and C<$!> will be set.
+
+=back
+
+
+If the C functions setbuf() and/or setvbuf() are available, then
+C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering
+policy for an IO::Handle.  The calling sequences for the Perl functions
+are the same as their C counterparts--including the constants C<_IOFBF>,
+C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter
+specifies a scalar variable to use as a buffer. You should only
+change the buffer before any I/O, or immediately after calling flush.
+
+WARNING: A variable used as a buffer by C<setbuf> or C<setvbuf> B<must not
+be modified> in any way until the IO::Handle is closed or C<setbuf> or
+C<setvbuf> is called again, or memory corruption may result! Remember that
+the order of global destruction is undefined, so even if your buffer
+variable remains in scope until program termination, it may be undefined
+before the file IO::Handle is closed. Note that you need to import the
+constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf
+returns nothing. setvbuf returns "0 but true", on success, C<undef> on
+failure.
+
+Lastly, there is a special method for working under B<-T> and setuid/gid
+scripts:
+
+=over
+
+=item $io->untaint
+
+Marks the object as taint-clean, and as such data read from it will also
+be considered taint-clean. Note that this is a very trusting action to
+take, and appropriate consideration for the data source and potential
+vulnerability should be kept in mind. Returns 0 on success, -1 if setting
+the taint-clean flag failed. (eg invalid handle)
+
+=back
+
+=head1 NOTE
+
+A C<IO::Handle> object is a reference to a symbol/GLOB reference (see
+the C<Symbol> package).  Some modules that
+inherit from C<IO::Handle> may want to keep object related variables
+in the hash table part of the GLOB. In an attempt to prevent modules
+trampling on each other I propose the that any such module should prefix
+its variables with its own name separated by _'s. For example the IO::Socket
+module keeps a C<timeout> variable in 'io_socket_timeout'.
+
+=head1 SEE ALSO
+
+L<perlfunc>, 
+L<perlop/"I/O Operators">,
+L<IO::File>
+
+=head1 BUGS
+
+Due to backwards compatibility, all filehandles resemble objects
+of class C<IO::Handle>, or actually classes derived from that class.
+They actually aren't.  Which means you can't derive your own 
+class from C<IO::Handle> and inherit those methods.
+
+=head1 HISTORY
+
+Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
+
+=cut
+
+require 5.005_64;
+use strict;
+our($VERSION, @EXPORT_OK, @ISA);
+use Carp;
+use Symbol;
+use SelectSaver;
+use IO ();	# Load the XS module
+
+require Exporter;
+@ISA = qw(Exporter);
+
+$VERSION = "1.21";
+
+@EXPORT_OK = qw(
+    autoflush
+    output_field_separator
+    output_record_separator
+    input_record_separator
+    input_line_number
+    format_page_number
+    format_lines_per_page
+    format_lines_left
+    format_name
+    format_top_name
+    format_line_break_characters
+    format_formfeed
+    format_write
+
+    print
+    printf
+    getline
+    getlines
+
+    printflush
+    flush
+
+    SEEK_SET
+    SEEK_CUR
+    SEEK_END
+    _IOFBF
+    _IOLBF
+    _IONBF
+);
+
+################################################
+## Constructors, destructors.
+##
+
+sub new {
+    my $class = ref($_[0]) || $_[0] || "IO::Handle";
+    @_ == 1 or croak "usage: new $class";
+    my $io = gensym;
+    bless $io, $class;
+}
+
+sub new_from_fd {
+    my $class = ref($_[0]) || $_[0] || "IO::Handle";
+    @_ == 3 or croak "usage: new_from_fd $class FD, MODE";
+    my $io = gensym;
+    shift;
+    IO::Handle::fdopen($io, @_)
+	or return undef;
+    bless $io, $class;
+}
+
+#
+# There is no need for DESTROY to do anything, because when the
+# last reference to an IO object is gone, Perl automatically
+# closes its associated files (if any).  However, to avoid any
+# attempts to autoload DESTROY, we here define it to do nothing.
+#
+sub DESTROY {}
+
+
+################################################
+## Open and close.
+##
+
+sub _open_mode_string {
+    my ($mode) = @_;
+    $mode =~ /^\+?(<|>>?)$/
+      or $mode =~ s/^r(\+?)$/$1</
+      or $mode =~ s/^w(\+?)$/$1>/
+      or $mode =~ s/^a(\+?)$/$1>>/
+      or croak "IO::Handle: bad open mode: $mode";
+    $mode;
+}
+
+sub fdopen {
+    @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
+    my ($io, $fd, $mode) = @_;
+    local(*GLOB);
+
+    if (ref($fd) && "".$fd =~ /GLOB\(/o) {
+	# It's a glob reference; Alias it as we cannot get name of anon GLOBs
+	my $n = qualify(*GLOB);
+	*GLOB = *{*$fd};
+	$fd =  $n;
+    } elsif ($fd =~ m#^\d+$#) {
+	# It's an FD number; prefix with "=".
+	$fd = "=$fd";
+    }
+
+    open($io, _open_mode_string($mode) . '&' . $fd)
+	? $io : undef;
+}
+
+sub close {
+    @_ == 1 or croak 'usage: $io->close()';
+    my($io) = @_;
+
+    close($io);
+}
+
+################################################
+## Normal I/O functions.
+##
+
+# flock
+# select
+
+sub opened {
+    @_ == 1 or croak 'usage: $io->opened()';
+    defined fileno($_[0]);
+}
+
+sub fileno {
+    @_ == 1 or croak 'usage: $io->fileno()';
+    fileno($_[0]);
+}
+
+sub getc {
+    @_ == 1 or croak 'usage: $io->getc()';
+    getc($_[0]);
+}
+
+sub eof {
+    @_ == 1 or croak 'usage: $io->eof()';
+    eof($_[0]);
+}
+
+sub print {
+    @_ or croak 'usage: $io->print(ARGS)';
+    my $this = shift;
+    print $this @_;
+}
+
+sub printf {
+    @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
+    my $this = shift;
+    printf $this @_;
+}
+
+sub getline {
+    @_ == 1 or croak 'usage: $io->getline()';
+    my $this = shift;
+    return scalar <$this>;
+} 
+
+*gets = \&getline;  # deprecated
+
+sub getlines {
+    @_ == 1 or croak 'usage: $io->getlines()';
+    wantarray or
+	croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
+    my $this = shift;
+    return <$this>;
+}
+
+sub truncate {
+    @_ == 2 or croak 'usage: $io->truncate(LEN)';
+    truncate($_[0], $_[1]);
+}
+
+sub read {
+    @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
+    read($_[0], $_[1], $_[2], $_[3] || 0);
+}
+
+sub sysread {
+    @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
+    sysread($_[0], $_[1], $_[2], $_[3] || 0);
+}
+
+sub write {
+    @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
+    local($\) = "";
+    $_[2] = length($_[1]) unless defined $_[2];
+    print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
+}
+
+sub syswrite {
+    @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
+    if (defined($_[2])) {
+	syswrite($_[0], $_[1], $_[2], $_[3] || 0);
+    } else {
+	syswrite($_[0], $_[1]);
+    }
+}
+
+sub stat {
+    @_ == 1 or croak 'usage: $io->stat()';
+    stat($_[0]);
+}
+
+################################################
+## State modification functions.
+##
+
+sub autoflush {
+    my $old = new SelectSaver qualify($_[0], caller);
+    my $prev = $|;
+    $| = @_ > 1 ? $_[1] : 1;
+    $prev;
+}
+
+sub output_field_separator {
+    carp "output_field_separator is not supported on a per-handle basis"
+	if ref($_[0]);
+    my $prev = $,;
+    $, = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub output_record_separator {
+    carp "output_record_separator is not supported on a per-handle basis"
+	if ref($_[0]);
+    my $prev = $\;
+    $\ = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub input_record_separator {
+    carp "input_record_separator is not supported on a per-handle basis"
+	if ref($_[0]);
+    my $prev = $/;
+    $/ = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub input_line_number {
+    local $.;
+    my $tell = tell qualify($_[0], caller) if ref($_[0]);
+    my $prev = $.;
+    $. = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_page_number {
+    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $%;
+    $% = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_lines_per_page {
+    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $=;
+    $= = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_lines_left {
+    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $-;
+    $- = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_name {
+    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $~;
+    $~ = qualify($_[1], caller) if @_ > 1;
+    $prev;
+}
+
+sub format_top_name {
+    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $^;
+    $^ = qualify($_[1], caller) if @_ > 1;
+    $prev;
+}
+
+sub format_line_break_characters {
+    carp "format_line_break_characters is not supported on a per-handle basis"
+	if ref($_[0]);
+    my $prev = $:;
+    $: = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_formfeed {
+    carp "format_formfeed is not supported on a per-handle basis"
+	if ref($_[0]);
+    my $prev = $^L;
+    $^L = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub formline {
+    my $io = shift;
+    my $picture = shift;
+    local($^A) = $^A;
+    local($\) = "";
+    formline($picture, @_);
+    print $io $^A;
+}
+
+sub format_write {
+    @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
+    if (@_ == 2) {
+	my ($io, $fmt) = @_;
+	my $oldfmt = $io->format_name($fmt);
+	CORE::write($io);
+	$io->format_name($oldfmt);
+    } else {
+	CORE::write($_[0]);
+    }
+}
+
+# XXX undocumented
+sub fcntl {
+    @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
+    my ($io, $op) = @_;
+    return fcntl($io, $op, $_[2]);
+}
+
+# XXX undocumented
+sub ioctl {
+    @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
+    my ($io, $op) = @_;
+    return ioctl($io, $op, $_[2]);
+}
+
+# this sub is for compatability with older releases of IO that used
+# a sub called constant to detemine if a constant existed -- GMB
+#
+# The SEEK_* and _IO?BF constants were the only constants at that time
+# any new code should just chech defined(&CONSTANT_NAME)
+
+sub constant {
+    no strict 'refs';
+    my $name = shift;
+    (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
+	? &{$name}() : undef;
+}
+
+
+# so that flush.pl can be depriciated
+
+sub printflush {
+    my $io = shift;
+    my $old = new SelectSaver qualify($io, caller) if ref($io);
+    local $| = 1;
+    if(ref($io)) {
+        print $io @_;
+    }
+    else {
+	print @_;
+    }
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/IO/Pipe.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/IO/Pipe.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/IO/Pipe.pm	(revision 14265)
@@ -0,0 +1,252 @@
+# IO::Pipe.pm
+#
+# Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Pipe;
+
+require 5.005_64;
+
+use IO::Handle;
+use strict;
+our($VERSION);
+use Carp;
+use Symbol;
+
+$VERSION = "1.121";
+
+sub new {
+    my $type = shift;
+    my $class = ref($type) || $type || "IO::Pipe";
+    @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
+
+    my $me = bless gensym(), $class;
+
+    my($readfh,$writefh) = @_ ? @_ : $me->handles;
+
+    pipe($readfh, $writefh)
+	or return undef;
+
+    @{*$me} = ($readfh, $writefh);
+
+    $me;
+}
+
+sub handles {
+    @_ == 1 or croak 'usage: $pipe->handles()';
+    (IO::Pipe::End->new(), IO::Pipe::End->new());
+}
+
+my $do_spawn = $^O eq 'os2';
+
+sub _doit {
+    my $me = shift;
+    my $rw = shift;
+
+    my $pid = $do_spawn ? 0 : fork();
+
+    if($pid) { # Parent
+        return $pid;
+    }
+    elsif(defined $pid) { # Child or spawn
+        my $fh;
+        my $io = $rw ? \*STDIN : \*STDOUT;
+        my ($mode, $save) = $rw ? "r" : "w";
+        if ($do_spawn) {
+          require Fcntl;
+          $save = IO::Handle->new_from_fd($io, $mode);
+          # Close in child:
+          fcntl(shift, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
+          $fh = $rw ? ${*$me}[0] : ${*$me}[1];
+        } else {
+          shift;
+          $fh = $rw ? $me->reader() : $me->writer(); # close the other end
+        }
+        bless $io, "IO::Handle";
+        $io->fdopen($fh, $mode);
+	$fh->close;
+
+        if ($do_spawn) {
+          $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
+          my $err = $!;
+    
+          $io->fdopen($save, $mode);
+          $save->close or croak "Cannot close $!";
+          croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0;
+          return $pid;
+        } else {
+          exec @_ or
+            croak "IO::Pipe: Cannot exec: $!";
+        }
+    }
+    else {
+        croak "IO::Pipe: Cannot fork: $!";
+    }
+
+    # NOT Reached
+}
+
+sub reader {
+    @_ >= 1 or croak 'usage: $pipe->reader( [SUB_COMMAND_ARGS] )';
+    my $me = shift;
+
+    return undef
+	unless(ref($me) || ref($me = $me->new));
+
+    my $fh  = ${*$me}[0];
+    my $pid = $me->_doit(0, $fh, @_)
+        if(@_);
+
+    close ${*$me}[1];
+    bless $me, ref($fh);
+    *$me = *$fh;          # Alias self to handle
+    $me->fdopen($fh->fileno,"r")
+	unless defined($me->fileno);
+    bless $fh;                  # Really wan't un-bless here
+    ${*$me}{'io_pipe_pid'} = $pid
+        if defined $pid;
+
+    $me;
+}
+
+sub writer {
+    @_ >= 1 or croak 'usage: $pipe->writer( [SUB_COMMAND_ARGS] )';
+    my $me = shift;
+
+    return undef
+	unless(ref($me) || ref($me = $me->new));
+
+    my $fh  = ${*$me}[1];
+    my $pid = $me->_doit(1, $fh, @_)
+        if(@_);
+
+    close ${*$me}[0];
+    bless $me, ref($fh);
+    *$me = *$fh;          # Alias self to handle
+    $me->fdopen($fh->fileno,"w")
+	unless defined($me->fileno);
+    bless $fh;                  # Really wan't un-bless here
+    ${*$me}{'io_pipe_pid'} = $pid
+        if defined $pid;
+
+    $me;
+}
+
+package IO::Pipe::End;
+
+our(@ISA);
+
+@ISA = qw(IO::Handle);
+
+sub close {
+    my $fh = shift;
+    my $r = $fh->SUPER::close(@_);
+
+    waitpid(${*$fh}{'io_pipe_pid'},0)
+	if(defined ${*$fh}{'io_pipe_pid'});
+
+    $r;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+IO::Pipe - supply object methods for pipes
+
+=head1 SYNOPSIS
+
+	use IO::Pipe;
+
+	$pipe = new IO::Pipe;
+
+	if($pid = fork()) { # Parent
+	    $pipe->reader();
+
+	    while(<$pipe> {
+		....
+	    }
+
+	}
+	elsif(defined $pid) { # Child
+	    $pipe->writer();
+
+	    print $pipe ....
+	}
+
+	or
+
+	$pipe = new IO::Pipe;
+
+	$pipe->reader(qw(ls -l));
+
+	while(<$pipe>) {
+	    ....
+	}
+
+=head1 DESCRIPTION
+
+C<IO::Pipe> provides an interface to creating pipes between
+processes.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [READER, WRITER] )
+
+Creates a C<IO::Pipe>, which is a reference to a newly created symbol
+(see the C<Symbol> package). C<IO::Pipe::new> optionally takes two
+arguments, which should be objects blessed into C<IO::Handle>, or a
+subclass thereof. These two objects will be used for the system call
+to C<pipe>. If no arguments are given then method C<handles> is called
+on the new C<IO::Pipe> object.
+
+These two handles are held in the array part of the GLOB until either
+C<reader> or C<writer> is called.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item reader ([ARGS])
+
+The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
+handle at the reading end of the pipe. If C<ARGS> are given then C<fork>
+is called and C<ARGS> are passed to exec.
+
+=item writer ([ARGS])
+
+The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
+handle at the writing end of the pipe. If C<ARGS> are given then C<fork>
+is called and C<ARGS> are passed to exec.
+
+=item handles ()
+
+This method is called during construction by C<IO::Pipe::new>
+on the newly created C<IO::Pipe> object. It returns an array of two objects
+blessed into C<IO::Pipe::End>, or a subclass thereof.
+
+=back
+
+=head1 SEE ALSO
+
+L<IO::Handle>
+
+=head1 AUTHOR
+
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/IO/Poll.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/IO/Poll.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/IO/Poll.pm	(revision 14265)
@@ -0,0 +1,204 @@
+
+# IO::Poll.pm
+#
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Poll;
+
+use strict;
+use IO::Handle;
+use Exporter ();
+our(@ISA, @EXPORT_OK, @EXPORT, $VERSION);
+
+@ISA = qw(Exporter);
+$VERSION = "0.05";
+
+@EXPORT = qw( POLLIN
+	      POLLOUT
+	      POLLERR
+	      POLLHUP
+	      POLLNVAL
+	    );
+
+@EXPORT_OK = qw(
+ POLLPRI   
+ POLLRDNORM
+ POLLWRNORM
+ POLLRDBAND
+ POLLWRBAND
+ POLLNORM  
+	       );
+
+# [0] maps fd's to requested masks
+# [1] maps fd's to returned  masks
+# [2] maps fd's to handles
+sub new {
+    my $class = shift;
+
+    my $self = bless [{},{},{}], $class;
+
+    $self;
+}
+
+sub mask {
+    my $self = shift;
+    my $io = shift;
+    my $fd = fileno($io);
+    if (@_) {
+	my $mask = shift;
+	if($mask) {
+	  $self->[0]{$fd}{$io} = $mask; # the error events are always returned
+	  $self->[1]{$fd}      = 0;     # output mask
+	  $self->[2]{$io}      = $io;   # remember handle
+	} else {
+	    delete $self->[0]{$fd}{$io};
+	  delete $self->[1]{$fd} unless %{$self->[0]{$fd}};
+	  delete $self->[2]{$io};
+	}
+    }
+    
+    return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{$io};
+	return $self->[0]{$fd}{$io};
+}
+
+
+sub poll {
+    my($self,$timeout) = @_;
+
+    $self->[1] = {};
+
+    my($fd,$mask,$iom);
+    my @poll = ();
+
+    while(($fd,$iom) = each %{$self->[0]}) {
+	$mask   = 0;
+	$mask  |= $_ for values(%$iom);
+	push(@poll,$fd => $mask);
+    }
+
+    my $ret = @poll ? _poll(defined($timeout) ? $timeout * 1000 : -1,@poll) : 0;
+
+    return $ret
+	unless $ret > 0;
+
+    while(@poll) {
+	my($fd,$got) = splice(@poll,0,2);
+	$self->[1]{$fd} = $got if $got;
+    }
+
+    return $ret;  
+}
+
+sub events {
+    my $self = shift;
+    my $io = shift;
+    my $fd = fileno($io);
+    exists $self->[1]{$fd} and exists $self->[0]{$fd}{$io} 
+                ? $self->[1]{$fd} & ($self->[0]{$fd}{$io}|POLLHUP|POLLERR|POLLNVAL)
+	: 0;
+}
+
+sub remove {
+    my $self = shift;
+    my $io = shift;
+    $self->mask($io,0);
+}
+
+sub handles {
+    my $self = shift;
+    return values %{$self->[2]} unless @_;
+
+    my $events = shift || 0;
+    my($fd,$ev,$io,$mask);
+    my @handles = ();
+
+    while(($fd,$ev) = each %{$self->[1]}) {
+	while (($io,$mask) = each %{$self->[0]{$fd}}) {
+	    $mask |= POLLHUP|POLLERR|POLLNVAL;  # must allow these
+	    push @handles,$self->[2]{$io} if ($ev & $mask) & $events;
+	}
+    }
+    return @handles;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+IO::Poll - Object interface to system poll call
+
+=head1 SYNOPSIS
+
+    use IO::Poll qw(POLLRDNORM POLLWRNORM POLLIN POLLHUP);
+
+    $poll = new IO::Poll;
+
+    $poll->mask($input_handle => POLLIN);
+    $poll->mask($output_handle => POLLOUT);
+
+    $poll->poll($timeout);
+
+    $ev = $poll->events($input);
+
+=head1 DESCRIPTION
+
+C<IO::Poll> is a simple interface to the system level poll routine.
+
+=head1 METHODS
+
+=over 4
+
+=item mask ( IO [, EVENT_MASK ] )
+
+If EVENT_MASK is given, then, if EVENT_MASK is non-zero, IO is added to the
+list of file descriptors and the next call to poll will check for
+any event specified in EVENT_MASK. If EVENT_MASK is zero then IO will be
+removed from the list of file descriptors.
+
+If EVENT_MASK is not given then the return value will be the current
+event mask value for IO.
+
+=item poll ( [ TIMEOUT ] )
+
+Call the system level poll routine. If TIMEOUT is not specified then the
+call will block. Returns the number of handles which had events
+happen, or -1 on error.
+
+=item events ( IO )
+
+Returns the event mask which represents the events that happend on IO
+during the last call to C<poll>.
+
+=item remove ( IO )
+
+Remove IO from the list of file descriptors for the next poll.
+
+=item handles( [ EVENT_MASK ] )
+
+Returns a list of handles. If EVENT_MASK is not given then a list of all
+handles known will be returned. If EVENT_MASK is given then a list
+of handles will be returned which had one of the events specified by
+EVENT_MASK happen during the last call ti C<poll>
+
+=back
+
+=head1 SEE ALSO
+
+L<poll(2)>, L<IO::Handle>, L<IO::Select>
+
+=head1 AUTHOR
+
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/IO/Seekable.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/IO/Seekable.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/IO/Seekable.pm	(revision 14265)
@@ -0,0 +1,127 @@
+#
+
+package IO::Seekable;
+
+=head1 NAME
+
+IO::Seekable - supply seek based methods for I/O objects
+
+=head1 SYNOPSIS
+
+    use IO::Seekable;
+    package IO::Something;
+    @ISA = qw(IO::Seekable);
+
+=head1 DESCRIPTION
+
+C<IO::Seekable> does not have a constructor of its own as it is intended to
+be inherited by other C<IO::Handle> based objects. It provides methods
+which allow seeking of the file descriptors.
+
+=over 4
+
+=item $io->getpos
+
+Returns an opaque value that represents the current position of the
+IO::File, or C<undef> if this is not possible (eg an unseekable stream such
+as a terminal, pipe or socket). If the fgetpos() function is available in
+your C library it is used to implements getpos, else perl emulates getpos
+using C's ftell() function.
+
+=item $io->setpos
+
+Uses the value of a previous getpos call to return to a previously visited
+position. Returns "0 but true" on success, C<undef> on failure.
+
+=back
+  
+See L<perlfunc> for complete descriptions of each of the following
+supported C<IO::Seekable> methods, which are just front ends for the
+corresponding built-in functions:
+
+=over 4
+
+=item $io->setpos ( POS, WHENCE )
+
+Seek the IO::File to position POS, relative to WHENCE:
+
+=over 8
+
+=item WHENCE=0 (SEEK_SET)
+
+POS is absolute position. (Seek relative to the start of the file)
+
+=item WHENCE=1 (SEEK_CUR)
+
+POS is an offset from the current position. (Seek relative to current)
+
+=item WHENCE=1 (SEEK_END)
+
+POS is an offset from the end of the file. (Seek relative to end)
+
+=back
+
+The SEEK_* constants can be imported from the C<Fcntl> module if you
+don't wish to use the numbers C<0> C<1> or C<2> in your code.
+
+Returns C<1> upon success, C<0> otherwise.
+
+=item $io->sysseek( POS, WHENCE )
+
+Similar to $io->seek, but sets the IO::File's position using the system
+call lseek(2) directly, so will confuse most perl IO operators except
+sysread and syswrite (see L<perlfunc> for full details)
+
+Returns the new position, or C<undef> on failure.  A position
+of zero is returned as the string C<"0 but true">
+
+=item $io->tell
+
+Returns the IO::File's current position, or -1 on error.
+
+=back
+  
+=head1 SEE ALSO
+
+L<perlfunc>, 
+L<perlop/"I/O Operators">,
+L<IO::Handle>
+L<IO::File>
+
+=head1 HISTORY
+
+Derived from FileHandle.pm by Graham Barr E<lt>gbarr@pobox.comE<gt>
+
+=cut
+
+require 5.005_64;
+use Carp;
+use strict;
+our($VERSION, @EXPORT, @ISA);
+use IO::Handle ();
+# XXX we can't get these from IO::Handle or we'll get prototype
+# mismatch warnings on C<use POSIX; use IO::File;> :-(
+use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END);
+require Exporter;
+
+@EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END);
+@ISA = qw(Exporter);
+
+$VERSION = "1.08";
+
+sub seek {
+    @_ == 3 or croak 'usage: $io->seek(POS, WHENCE)';
+    seek($_[0], $_[1], $_[2]);
+}
+
+sub sysseek {
+    @_ == 3 or croak 'usage: $io->sysseek(POS, WHENCE)';
+    sysseek($_[0], $_[1], $_[2]);
+}
+
+sub tell {
+    @_ == 1 or croak 'usage: $io->tell()';
+    tell($_[0]);
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/IO/Select.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/IO/Select.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/IO/Select.pm	(revision 14265)
@@ -0,0 +1,381 @@
+# IO::Select.pm
+#
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Select;
+
+use     strict;
+use warnings::register;
+use     vars qw($VERSION @ISA);
+require Exporter;
+
+$VERSION = "1.14";
+
+@ISA = qw(Exporter); # This is only so we can do version checking
+
+sub VEC_BITS () {0}
+sub FD_COUNT () {1}
+sub FIRST_FD () {2}
+
+sub new
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+
+ my $vec = bless [undef,0], $type;
+
+ $vec->add(@_)
+    if @_;
+
+ $vec;
+}
+
+sub add
+{
+ shift->_update('add', @_);
+}
+
+
+sub remove
+{
+ shift->_update('remove', @_);
+}
+
+
+sub exists
+{
+ my $vec = shift;
+ my $fno = $vec->_fileno(shift);
+ return undef unless defined $fno;
+ $vec->[$fno + FIRST_FD];
+}
+
+
+sub _fileno
+{
+ my($self, $f) = @_;
+ return unless defined $f;
+ $f = $f->[0] if ref($f) eq 'ARRAY';
+ ($f =~ /^\d+$/) ? $f : fileno($f);
+}
+
+sub _update
+{
+ my $vec = shift;
+ my $add = shift eq 'add';
+
+ my $bits = $vec->[VEC_BITS];
+ $bits = '' unless defined $bits;
+
+ my $count = 0;
+ my $f;
+ foreach $f (@_)
+  {
+   my $fn = $vec->_fileno($f);
+   next unless defined $fn;
+   my $i = $fn + FIRST_FD;
+   if ($add) {
+     if (defined $vec->[$i]) {
+	 $vec->[$i] = $f;  # if array rest might be different, so we update
+	 next;
+     }
+     $vec->[FD_COUNT]++;
+     vec($bits, $fn, 1) = 1;
+     $vec->[$i] = $f;
+   } else {      # remove
+     next unless defined $vec->[$i];
+     $vec->[FD_COUNT]--;
+     vec($bits, $fn, 1) = 0;
+     $vec->[$i] = undef;
+   }
+   $count++;
+  }
+ $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
+ $count;
+}
+
+sub can_read
+{
+ my $vec = shift;
+ my $timeout = shift;
+ my $r = $vec->[VEC_BITS];
+
+ defined($r) && (select($r,undef,undef,$timeout) > 0)
+    ? handles($vec, $r)
+    : ();
+}
+
+sub can_write
+{
+ my $vec = shift;
+ my $timeout = shift;
+ my $w = $vec->[VEC_BITS];
+
+ defined($w) && (select(undef,$w,undef,$timeout) > 0)
+    ? handles($vec, $w)
+    : ();
+}
+
+sub has_exception
+{
+ my $vec = shift;
+ my $timeout = shift;
+ my $e = $vec->[VEC_BITS];
+
+ defined($e) && (select(undef,undef,$e,$timeout) > 0)
+    ? handles($vec, $e)
+    : ();
+}
+
+sub has_error
+{
+ warnings::warn("Call to depreciated method 'has_error', use 'has_exception'")
+	if warnings::enabled();
+ goto &has_exception;
+}
+
+sub count
+{
+ my $vec = shift;
+ $vec->[FD_COUNT];
+}
+
+sub bits
+{
+ my $vec = shift;
+ $vec->[VEC_BITS];
+}
+
+sub as_string  # for debugging
+{
+ my $vec = shift;
+ my $str = ref($vec) . ": ";
+ my $bits = $vec->bits;
+ my $count = $vec->count;
+ $str .= defined($bits) ? unpack("b*", $bits) : "undef";
+ $str .= " $count";
+ my @handles = @$vec;
+ splice(@handles, 0, FIRST_FD);
+ for (@handles) {
+     $str .= " " . (defined($_) ? "$_" : "-");
+ }
+ $str;
+}
+
+sub _max
+{
+ my($a,$b,$c) = @_;
+ $a > $b
+    ? $a > $c
+        ? $a
+        : $c
+    : $b > $c
+        ? $b
+        : $c;
+}
+
+sub select
+{
+ shift
+   if defined $_[0] && !ref($_[0]);
+
+ my($r,$w,$e,$t) = @_;
+ my @result = ();
+
+ my $rb = defined $r ? $r->[VEC_BITS] : undef;
+ my $wb = defined $w ? $w->[VEC_BITS] : undef;
+ my $eb = defined $e ? $e->[VEC_BITS] : undef;
+
+ if(select($rb,$wb,$eb,$t) > 0)
+  {
+   my @r = ();
+   my @w = ();
+   my @e = ();
+   my $i = _max(defined $r ? scalar(@$r)-1 : 0,
+                defined $w ? scalar(@$w)-1 : 0,
+                defined $e ? scalar(@$e)-1 : 0);
+
+   for( ; $i >= FIRST_FD ; $i--)
+    {
+     my $j = $i - FIRST_FD;
+     push(@r, $r->[$i])
+        if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
+     push(@w, $w->[$i])
+        if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
+     push(@e, $e->[$i])
+        if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
+    }
+
+   @result = (\@r, \@w, \@e);
+  }
+ @result;
+}
+
+
+sub handles
+{
+ my $vec = shift;
+ my $bits = shift;
+ my @h = ();
+ my $i;
+ my $max = scalar(@$vec) - 1;
+
+ for ($i = FIRST_FD; $i <= $max; $i++)
+  {
+   next unless defined $vec->[$i];
+   push(@h, $vec->[$i])
+      if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
+  }
+ 
+ @h;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+IO::Select - OO interface to the select system call
+
+=head1 SYNOPSIS
+
+    use IO::Select;
+
+    $s = IO::Select->new();
+
+    $s->add(\*STDIN);
+    $s->add($some_handle);
+
+    @ready = $s->can_read($timeout);
+
+    @ready = IO::Select->new(@handles)->read(0);
+
+=head1 DESCRIPTION
+
+The C<IO::Select> package implements an object approach to the system C<select>
+function call. It allows the user to see what IO handles, see L<IO::Handle>,
+are ready for reading, writing or have an error condition pending.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ HANDLES ] )
+
+The constructor creates a new object and optionally initialises it with a set
+of handles.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item add ( HANDLES )
+
+Add the list of handles to the C<IO::Select> object. It is these values that
+will be returned when an event occurs. C<IO::Select> keeps these values in a
+cache which is indexed by the C<fileno> of the handle, so if more than one
+handle with the same C<fileno> is specified then only the last one is cached.
+
+Each handle can be an C<IO::Handle> object, an integer or an array
+reference where the first element is a C<IO::Handle> or an integer.
+
+=item remove ( HANDLES )
+
+Remove all the given handles from the object. This method also works
+by the C<fileno> of the handles. So the exact handles that were added
+need not be passed, just handles that have an equivalent C<fileno>
+
+=item exists ( HANDLE )
+
+Returns a true value (actually the handle itself) if it is present.
+Returns undef otherwise.
+
+=item handles
+
+Return an array of all registered handles.
+
+=item can_read ( [ TIMEOUT ] )
+
+Return an array of handles that are ready for reading. C<TIMEOUT> is
+the maximum amount of time to wait before returning an empty list, in
+seconds, possibly fractional. If C<TIMEOUT> is not given and any
+handles are registered then the call will block.
+
+=item can_write ( [ TIMEOUT ] )
+
+Same as C<can_read> except check for handles that can be written to.
+
+=item has_exception ( [ TIMEOUT ] )
+
+Same as C<can_read> except check for handles that have an exception
+condition, for example pending out-of-band data.
+
+=item count ()
+
+Returns the number of handles that the object will check for when
+one of the C<can_> methods is called or the object is passed to
+the C<select> static method.
+
+=item bits()
+
+Return the bit string suitable as argument to the core select() call.
+
+=item select ( READ, WRITE, ERROR [, TIMEOUT ] )
+
+C<select> is a static method, that is you call it with the package
+name like C<new>. C<READ>, C<WRITE> and C<ERROR> are either C<undef>
+or C<IO::Select> objects. C<TIMEOUT> is optional and has the same
+effect as for the core select call.
+
+The result will be an array of 3 elements, each a reference to an array
+which will hold the handles that are ready for reading, writing and have
+error conditions respectively. Upon error an empty array is returned.
+
+=back
+
+=head1 EXAMPLE
+
+Here is a short example which shows how C<IO::Select> could be used
+to write a server which communicates with several sockets while also
+listening for more connections on a listen socket
+
+    use IO::Select;
+    use IO::Socket;
+
+    $lsn = new IO::Socket::INET(Listen => 1, LocalPort => 8080);
+    $sel = new IO::Select( $lsn );
+
+    while(@ready = $sel->can_read) {
+        foreach $fh (@ready) {
+            if($fh == $lsn) {
+                # Create a new socket
+                $new = $lsn->accept;
+                $sel->add($new);
+            }
+            else {
+                # Process socket
+
+                # Maybe we have finished with the socket
+                $sel->remove($fh);
+                $fh->close;
+            }
+        }
+    }
+
+=head1 AUTHOR
+
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
Index: /for-distributions/trunk/bin/windows/perl/lib/IO/Socket.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/IO/Socket.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/IO/Socket.pm	(revision 14265)
@@ -0,0 +1,428 @@
+# IO::Socket.pm
+#
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Socket;
+
+require 5.005_64;
+
+use IO::Handle;
+use Socket 1.3;
+use Carp;
+use strict;
+our(@ISA, $VERSION);
+use Exporter;
+use Errno;
+
+# legacy
+
+require IO::Socket::INET;
+require IO::Socket::UNIX if ($^O ne 'epoc');
+
+@ISA = qw(IO::Handle);
+
+$VERSION = "1.26";
+
+sub import {
+    my $pkg = shift;
+    my $callpkg = caller;
+    Exporter::export 'Socket', $callpkg, @_;
+}
+
+sub new {
+    my($class,%arg) = @_;
+    my $sock = $class->SUPER::new();
+
+    $sock->autoflush(1);
+
+    ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
+
+    return scalar(%arg) ? $sock->configure(\%arg)
+			: $sock;
+}
+
+my @domain2pkg;
+
+sub register_domain {
+    my($p,$d) = @_;
+    $domain2pkg[$d] = $p;
+}
+
+sub configure {
+    my($sock,$arg) = @_;
+    my $domain = delete $arg->{Domain};
+
+    croak 'IO::Socket: Cannot configure a generic socket'
+	unless defined $domain;
+
+    croak "IO::Socket: Unsupported socket domain"
+	unless defined $domain2pkg[$domain];
+
+    croak "IO::Socket: Cannot configure socket in domain '$domain'"
+	unless ref($sock) eq "IO::Socket";
+
+    bless($sock, $domain2pkg[$domain]);
+    $sock->configure($arg);
+}
+
+sub socket {
+    @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
+    my($sock,$domain,$type,$protocol) = @_;
+
+    socket($sock,$domain,$type,$protocol) or
+    	return undef;
+
+    ${*$sock}{'io_socket_domain'} = $domain;
+    ${*$sock}{'io_socket_type'}   = $type;
+    ${*$sock}{'io_socket_proto'}  = $protocol;
+
+    $sock;
+}
+
+sub socketpair {
+    @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
+    my($class,$domain,$type,$protocol) = @_;
+    my $sock1 = $class->new();
+    my $sock2 = $class->new();
+
+    socketpair($sock1,$sock2,$domain,$type,$protocol) or
+    	return ();
+
+    ${*$sock1}{'io_socket_type'}  = ${*$sock2}{'io_socket_type'}  = $type;
+    ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol;
+
+    ($sock1,$sock2);
+}
+
+sub connect {
+    @_ == 2 or croak 'usage: $sock->connect(NAME)';
+    my $sock = shift;
+    my $addr = shift;
+    my $timeout = ${*$sock}{'io_socket_timeout'};
+    my $err;
+    my $blocking;
+    $blocking = $sock->blocking(0) if $timeout;
+
+    if (!connect($sock, $addr)) {
+	if ($timeout && $!{EINPROGRESS}) {
+	    require IO::Select;
+
+	    my $sel = new IO::Select $sock;
+
+	    if (!$sel->can_write($timeout)) {
+		$err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+		$@ = "connect: timeout";
+	    }
+	    elsif(!connect($sock,$addr) && not $!{EISCONN}) {
+		# Some systems refuse to re-connect() to
+		# an already open socket and set errno to EISCONN.
+		$err = $!;
+		$@ = "connect: $!";
+	    }
+	}
+	else {
+	    $err = $!;
+	    $@ = "connect: $!";
+	}
+    }
+
+    $sock->blocking(1) if $blocking;
+
+    $! = $err if $err;
+
+    $err ? undef : $sock;
+}
+
+sub bind {
+    @_ == 2 or croak 'usage: $sock->bind(NAME)';
+    my $sock = shift;
+    my $addr = shift;
+
+    return bind($sock, $addr) ? $sock
+			      : undef;
+}
+
+sub listen {
+    @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
+    my($sock,$queue) = @_;
+    $queue = 5
+	unless $queue && $queue > 0;
+
+    return listen($sock, $queue) ? $sock
+				 : undef;
+}
+
+sub accept {
+    @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
+    my $sock = shift;
+    my $pkg = shift || $sock;
+    my $timeout = ${*$sock}{'io_socket_timeout'};
+    my $new = $pkg->new(Timeout => $timeout);
+    my $peer = undef;
+
+    if($timeout) {
+	require IO::Select;
+
+	my $sel = new IO::Select $sock;
+
+	unless ($sel->can_read($timeout)) {
+	    $@ = 'accept: timeout';
+	    $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+	    return;
+	}
+    }
+
+    $peer = accept($new,$sock)
+	or return;
+
+    return wantarray ? ($new, $peer)
+    	      	     : $new;
+}
+
+sub sockname {
+    @_ == 1 or croak 'usage: $sock->sockname()';
+    getsockname($_[0]);
+}
+
+sub peername {
+    @_ == 1 or croak 'usage: $sock->peername()';
+    my($sock) = @_;
+    getpeername($sock)
+      || ${*$sock}{'io_socket_peername'}
+      || undef;
+}
+
+sub connected {
+    @_ == 1 or croak 'usage: $sock->connected()';
+    my($sock) = @_;
+    getpeername($sock);
+}
+
+sub send {
+    @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
+    my $sock  = $_[0];
+    my $flags = $_[2] || 0;
+    my $peer  = $_[3] || $sock->peername;
+
+    croak 'send: Cannot determine peer address'
+	 unless($peer);
+
+    my $r = defined(getpeername($sock))
+	? send($sock, $_[1], $flags)
+	: send($sock, $_[1], $flags, $peer);
+
+    # remember who we send to, if it was sucessful
+    ${*$sock}{'io_socket_peername'} = $peer
+	if(@_ == 4 && defined $r);
+
+    $r;
+}
+
+sub recv {
+    @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
+    my $sock  = $_[0];
+    my $len   = $_[2];
+    my $flags = $_[3] || 0;
+
+    # remember who we recv'd from
+    ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
+}
+
+sub shutdown {
+    @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
+    my($sock, $how) = @_;
+    shutdown($sock, $how);
+}
+
+sub setsockopt {
+    @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME)';
+    setsockopt($_[0],$_[1],$_[2],$_[3]);
+}
+
+my $intsize = length(pack("i",0));
+
+sub getsockopt {
+    @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
+    my $r = getsockopt($_[0],$_[1],$_[2]);
+    # Just a guess
+    $r = unpack("i", $r)
+	if(defined $r && length($r) == $intsize);
+    $r;
+}
+
+sub sockopt {
+    my $sock = shift;
+    @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
+	    : $sock->setsockopt(SOL_SOCKET,@_);
+}
+
+sub timeout {
+    @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
+    my($sock,$val) = @_;
+    my $r = ${*$sock}{'io_socket_timeout'} || undef;
+
+    ${*$sock}{'io_socket_timeout'} = 0 + $val
+	if(@_ == 2);
+
+    $r;
+}
+
+sub sockdomain {
+    @_ == 1 or croak 'usage: $sock->sockdomain()';
+    my $sock = shift;
+    ${*$sock}{'io_socket_domain'};
+}
+
+sub socktype {
+    @_ == 1 or croak 'usage: $sock->socktype()';
+    my $sock = shift;
+    ${*$sock}{'io_socket_type'}
+}
+
+sub protocol {
+    @_ == 1 or croak 'usage: $sock->protocol()';
+    my($sock) = @_;
+    ${*$sock}{'io_socket_proto'};
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+IO::Socket - Object interface to socket communications
+
+=head1 SYNOPSIS
+
+    use IO::Socket;
+
+=head1 DESCRIPTION
+
+C<IO::Socket> provides an object interface to creating and using sockets. It
+is built upon the L<IO::Handle> interface and inherits all the methods defined
+by L<IO::Handle>.
+
+C<IO::Socket> only defines methods for those operations which are common to all
+types of socket. Operations which are specified to a socket in a particular 
+domain have methods defined in sub classes of C<IO::Socket>
+
+C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ARGS] )
+
+Creates an C<IO::Socket>, which is a reference to a
+newly created symbol (see the C<Symbol> package). C<new>
+optionally takes arguments, these arguments are in key-value pairs.
+C<new> only looks for one key C<Domain> which tells new which domain
+the socket will be in. All other arguments will be passed to the
+configuration method of the package for that domain, See below.
+
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+
+As of VERSION 1.18 all IO::Socket objects have autoflush turned on
+by default. This was not the case with earlier releases.
+
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+
+=back
+
+=head1 METHODS
+
+See L<perlfunc> for complete descriptions of each of the following
+supported C<IO::Socket> methods, which are just front ends for the
+corresponding built-in functions:
+
+    socket
+    socketpair
+    bind
+    listen
+    accept
+    send
+    recv
+    peername (getpeername)
+    sockname (getsockname)
+    shutdown
+
+Some methods take slightly different arguments to those defined in L<perlfunc>
+in attempt to make the interface more flexible. These are
+
+=over 4
+
+=item accept([PKG])
+
+perform the system call C<accept> on the socket and return a new object. The
+new object will be created in the same class as the listen socket, unless
+C<PKG> is specified. This object can be used to communicate with the client
+that was trying to connect. In a scalar context the new socket is returned,
+or undef upon failure. In a list context a two-element array is returned
+containing the new socket and the peer address; the list will
+be empty upon failure.
+
+=item socketpair(DOMAIN, TYPE, PROTOCOL)
+
+Call C<socketpair> and return a list of two sockets created, or an
+empty list on failure.
+
+=back
+
+Additional methods that are provided are:
+
+=over 4
+
+=item timeout([VAL])
+
+Set or get the timeout value associated with this socket. If called without
+any arguments then the current setting is returned. If called with an argument
+the current setting is changed and the previous value returned.
+
+=item sockopt(OPT [, VAL])
+
+Unified method to both set and get options in the SOL_SOCKET level. If called
+with one argument then getsockopt is called, otherwise setsockopt is called.
+
+=item sockdomain
+
+Returns the numerical number for the socket domain type. For example, for
+a AF_INET socket the value of &AF_INET will be returned.
+
+=item socktype
+
+Returns the numerical number for the socket type. For example, for
+a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
+
+=item protocol
+
+Returns the numerical number for the protocol being used on the socket, if
+known. If the protocol is unknown, as with an AF_UNIX socket, zero
+is returned.
+
+=item connected
+
+If the socket is in a connected state the the peer address is returned.
+If the socket is not in a connected state then undef will be returned.
+
+=back
+
+=head1 SEE ALSO
+
+L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX>
+
+=head1 AUTHOR
+
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/IO/Socket/INET.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/IO/Socket/INET.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/IO/Socket/INET.pm	(revision 14265)
@@ -0,0 +1,414 @@
+# IO::Socket::INET.pm
+#
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Socket::INET;
+
+use strict;
+our(@ISA, $VERSION);
+use IO::Socket;
+use Socket;
+use Carp;
+use Exporter;
+use Errno;
+
+@ISA = qw(IO::Socket);
+$VERSION = "1.25";
+
+my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;
+
+IO::Socket::INET->register_domain( AF_INET );
+
+my %socket_type = ( tcp  => SOCK_STREAM,
+		    udp  => SOCK_DGRAM,
+		    icmp => SOCK_RAW
+		  );
+
+sub new {
+    my $class = shift;
+    unshift(@_, "PeerAddr") if @_ == 1;
+    return $class->SUPER::new(@_);
+}
+
+sub _sock_info {
+  my($addr,$port,$proto) = @_;
+  my $origport = $port;
+  my @proto = ();
+  my @serv = ();
+
+  $port = $1
+	if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
+
+  if(defined $proto) {
+    if (@proto = ( $proto =~ m,\D,
+		? getprotobyname($proto)
+		: getprotobynumber($proto))
+    ) {
+      $proto = $proto[2] || undef;
+    }
+    else {
+      $@ = "Bad protocol '$proto'";
+      return;
+    }
+  }
+
+  if(defined $port) {
+    $port =~ s,\((\d+)\)$,,;
+
+    my $defport = $1 || undef;
+    my $pnum = ($port =~ m,^(\d+)$,)[0];
+
+    @serv = getservbyname($port, $proto[0] || "")
+	if ($port =~ m,\D,);
+
+    $port = $pnum || $serv[2] || $defport || undef;
+    unless (defined $port) {
+	$@ = "Bad service '$origport'";
+	return;
+    }
+
+    $proto = (getprotobyname($serv[3]))[2] || undef
+	if @serv && !$proto;
+  }
+
+ return ($addr || undef,
+	 $port || undef,
+	 $proto || undef
+	);
+}
+
+sub _error {
+    my $sock = shift;
+    my $err = shift;
+    {
+      local($!);
+      $@ = join("",ref($sock),": ",@_);
+      close($sock)
+	if(defined fileno($sock));
+    }
+    $! = $err;
+    return undef;
+}
+
+sub _get_addr {
+    my($sock,$addr_str, $multi) = @_;
+    my @addr;
+    if ($multi && $addr_str !~ /^\d+(?:\.\d+){3}$/) {
+	(undef, undef, undef, undef, @addr) = gethostbyname($addr_str);
+    } else {
+	my $h = inet_aton($addr_str);
+	push(@addr, $h) if defined $h;
+    }
+    @addr;
+}
+
+sub configure {
+    my($sock,$arg) = @_;
+    my($lport,$rport,$laddr,$raddr,$proto,$type);
+
+
+    $arg->{LocalAddr} = $arg->{LocalHost}
+	if exists $arg->{LocalHost} && !exists $arg->{LocalAddr};
+
+    ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
+					$arg->{LocalPort},
+					$arg->{Proto})
+			or return _error($sock, $!, $@);
+
+    $laddr = defined $laddr ? inet_aton($laddr)
+			    : INADDR_ANY;
+
+    return _error($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr},"'")
+	unless(defined $laddr);
+
+    $arg->{PeerAddr} = $arg->{PeerHost}
+	if exists $arg->{PeerHost} && !exists $arg->{PeerAddr};
+
+    unless(exists $arg->{Listen}) {
+	($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
+					    $arg->{PeerPort},
+					    $proto)
+			or return _error($sock, $!, $@);
+    }
+
+    $proto ||= (getprotobyname('tcp'))[2];
+
+    my $pname = (getprotobynumber($proto))[0];
+    $type = $arg->{Type} || $socket_type{$pname};
+
+    my @raddr = ();
+
+    if(defined $raddr) {
+	@raddr = $sock->_get_addr($raddr, $arg->{MultiHomed});
+	return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
+	    unless @raddr;
+    }
+
+    while(1) {
+
+	$sock->socket(AF_INET, $type, $proto) or
+	    return _error($sock, $!, "$!");
+
+	if ($arg->{Reuse} || $arg->{ReuseAddr}) {
+	    $sock->sockopt(SO_REUSEADDR,1) or
+		    return _error($sock, $!, "$!");
+	}
+
+	if ($arg->{ReusePort}) {
+	    $sock->sockopt(SO_REUSEPORT,1) or
+		    return _error($sock, $!, "$!");
+	}
+
+	if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) {
+	    $sock->bind($lport || 0, $laddr) or
+		    return _error($sock, $!, "$!");
+	}
+
+	if(exists $arg->{Listen}) {
+	    $sock->listen($arg->{Listen} || 5) or
+		return _error($sock, $!, "$!");
+	    last;
+	}
+
+ 	# don't try to connect unless we're given a PeerAddr
+ 	last unless exists($arg->{PeerAddr});
+ 
+        $raddr = shift @raddr;
+
+	return _error($sock, $EINVAL, 'Cannot determine remote port')
+		unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
+
+	last
+	    unless($type == SOCK_STREAM || defined $raddr);
+
+	return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
+	    unless defined $raddr;
+
+#        my $timeout = ${*$sock}{'io_socket_timeout'};
+#        my $before = time() if $timeout;
+
+        if ($sock->connect(pack_sockaddr_in($rport, $raddr))) {
+#            ${*$sock}{'io_socket_timeout'} = $timeout;
+            return $sock;
+        }
+
+	return _error($sock, $!, "Timeout")
+	    unless @raddr;
+
+#	if ($timeout) {
+#	    my $new_timeout = $timeout - (time() - $before);
+#	    return _error($sock,
+#                         (exists(&Errno::ETIMEDOUT) ? Errno::ETIMEDOUT() : $EINVAL),
+#                         "Timeout") if $new_timeout <= 0;
+#	    ${*$sock}{'io_socket_timeout'} = $new_timeout;
+#        }
+
+    }
+
+    $sock;
+}
+
+sub connect {
+    @_ == 2 || @_ == 3 or
+       croak 'usage: $sock->connect(NAME) or $sock->connect(PORT, ADDR)';
+    my $sock = shift;
+    return $sock->SUPER::connect(@_ == 1 ? shift : pack_sockaddr_in(@_));
+}
+
+sub bind {
+    @_ == 2 || @_ == 3 or
+       croak 'usage: $sock->bind(NAME) or $sock->bind(PORT, ADDR)';
+    my $sock = shift;
+    return $sock->SUPER::bind(@_ == 1 ? shift : pack_sockaddr_in(@_))
+}
+
+sub sockaddr {
+    @_ == 1 or croak 'usage: $sock->sockaddr()';
+    my($sock) = @_;
+    my $name = $sock->sockname;
+    $name ? (sockaddr_in($name))[1] : undef;
+}
+
+sub sockport {
+    @_ == 1 or croak 'usage: $sock->sockport()';
+    my($sock) = @_;
+    my $name = $sock->sockname;
+    $name ? (sockaddr_in($name))[0] : undef;
+}
+
+sub sockhost {
+    @_ == 1 or croak 'usage: $sock->sockhost()';
+    my($sock) = @_;
+    my $addr = $sock->sockaddr;
+    $addr ? inet_ntoa($addr) : undef;
+}
+
+sub peeraddr {
+    @_ == 1 or croak 'usage: $sock->peeraddr()';
+    my($sock) = @_;
+    my $name = $sock->peername;
+    $name ? (sockaddr_in($name))[1] : undef;
+}
+
+sub peerport {
+    @_ == 1 or croak 'usage: $sock->peerport()';
+    my($sock) = @_;
+    my $name = $sock->peername;
+    $name ? (sockaddr_in($name))[0] : undef;
+}
+
+sub peerhost {
+    @_ == 1 or croak 'usage: $sock->peerhost()';
+    my($sock) = @_;
+    my $addr = $sock->peeraddr;
+    $addr ? inet_ntoa($addr) : undef;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+IO::Socket::INET - Object interface for AF_INET domain sockets
+
+=head1 SYNOPSIS
+
+    use IO::Socket::INET;
+
+=head1 DESCRIPTION
+
+C<IO::Socket::INET> provides an object interface to creating and using sockets
+in the AF_INET domain. It is built upon the L<IO::Socket> interface and
+inherits all the methods defined by L<IO::Socket>.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ARGS] )
+
+Creates an C<IO::Socket::INET> object, which is a reference to a
+newly created symbol (see the C<Symbol> package). C<new>
+optionally takes arguments, these arguments are in key-value pairs.
+
+In addition to the key-value pairs accepted by L<IO::Socket>,
+C<IO::Socket::INET> provides.
+
+
+    PeerAddr	Remote host address          <hostname>[:<port>]
+    PeerHost	Synonym for PeerAddr
+    PeerPort	Remote port or service       <service>[(<no>)] | <no>
+    LocalAddr	Local host bind	address      hostname[:port]
+    LocalHost	Synonym for LocalAddr
+    LocalPort	Local host bind	port         <service>[(<no>)] | <no>
+    Proto	Protocol name (or number)    "tcp" | "udp" | ...
+    Type	Socket type                  SOCK_STREAM | SOCK_DGRAM | ...
+    Listen	Queue size for listen
+    ReuseAddr	Set SO_REUSEADDR before binding
+    Reuse	Set SO_REUSEADDR before binding (deprecated, prefer ReuseAddr)
+    ReusePort	Set SO_REUSEPORT before binding
+    Timeout	Timeout	value for various operations
+    MultiHomed  Try all adresses for multi-homed hosts
+
+
+If C<Listen> is defined then a listen socket is created, else if the
+socket type, which is derived from the protocol, is SOCK_STREAM then
+connect() is called.
+
+Although it is not illegal, the use of C<MultiHomed> on a socket
+which is in non-blocking mode is of little use. This is because the
+first connect will never fail with a timeout as the connaect call
+will not block.
+
+The C<PeerAddr> can be a hostname or the IP-address on the
+"xx.xx.xx.xx" form.  The C<PeerPort> can be a number or a symbolic
+service name.  The service name might be followed by a number in
+parenthesis which is used if the service is not known by the system.
+The C<PeerPort> specification can also be embedded in the C<PeerAddr>
+by preceding it with a ":".
+
+If C<Proto> is not given and you specify a symbolic C<PeerPort> port,
+then the constructor will try to derive C<Proto> from the service
+name.  As a last resort C<Proto> "tcp" is assumed.  The C<Type>
+parameter will be deduced from C<Proto> if not specified.
+
+If the constructor is only passed a single argument, it is assumed to
+be a C<PeerAddr> specification.
+
+Examples:
+
+   $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
+                                 PeerPort => 'http(80)',
+                                 Proto    => 'tcp');
+
+   $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');
+
+   $sock = IO::Socket::INET->new(Listen    => 5,
+                                 LocalAddr => 'localhost',
+                                 LocalPort => 9000,
+                                 Proto     => 'tcp');
+
+   $sock = IO::Socket::INET->new('127.0.0.1:25');
+
+
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+
+As of VERSION 1.18 all IO::Socket objects have autoflush turned on
+by default. This was not the case with earlier releases.
+
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+
+=back
+
+=head2 METHODS
+
+=over 4
+
+=item sockaddr ()
+
+Return the address part of the sockaddr structure for the socket
+
+=item sockport ()
+
+Return the port number that the socket is using on the local host
+
+=item sockhost ()
+
+Return the address part of the sockaddr structure for the socket in a
+text form xx.xx.xx.xx
+
+=item peeraddr ()
+
+Return the address part of the sockaddr structure for the socket on
+the peer host
+
+=item peerport ()
+
+Return the port number for the socket on the peer host.
+
+=item peerhost ()
+
+Return the address part of the sockaddr structure for the socket on the
+peer host in a text form xx.xx.xx.xx
+
+=back
+
+=head1 SEE ALSO
+
+L<Socket>, L<IO::Socket>
+
+=head1 AUTHOR
+
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/IO/Socket/UNIX.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/IO/Socket/UNIX.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/IO/Socket/UNIX.pm	(revision 14265)
@@ -0,0 +1,143 @@
+# IO::Socket::UNIX.pm
+#
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Socket::UNIX;
+
+use strict;
+our(@ISA, $VERSION);
+use IO::Socket;
+use Socket;
+use Carp;
+
+@ISA = qw(IO::Socket);
+$VERSION = "1.20";
+
+IO::Socket::UNIX->register_domain( AF_UNIX );
+
+sub new {
+    my $class = shift;
+    unshift(@_, "Peer") if @_ == 1;
+    return $class->SUPER::new(@_);
+}
+
+sub configure {
+    my($sock,$arg) = @_;
+    my($bport,$cport);
+
+    my $type = $arg->{Type} || SOCK_STREAM;
+
+    $sock->socket(AF_UNIX, $type, 0) or
+	return undef;
+
+    if(exists $arg->{Local}) {
+	my $addr = sockaddr_un($arg->{Local});
+	$sock->bind($addr) or
+	    return undef;
+    }
+    if(exists $arg->{Listen} && $type != SOCK_DGRAM) {
+	$sock->listen($arg->{Listen} || 5) or
+	    return undef;
+    }
+    elsif(exists $arg->{Peer}) {
+	my $addr = sockaddr_un($arg->{Peer});
+	$sock->connect($addr) or
+	    return undef;
+    }
+
+    $sock;
+}
+
+sub hostpath {
+    @_ == 1 or croak 'usage: $sock->hostpath()';
+    my $n = $_[0]->sockname || return undef;
+    (sockaddr_un($n))[0];
+}
+
+sub peerpath {
+    @_ == 1 or croak 'usage: $sock->peerpath()';
+    my $n = $_[0]->peername || return undef;
+    (sockaddr_un($n))[0];
+}
+
+1; # Keep require happy
+
+__END__
+
+=head1 NAME
+
+IO::Socket::UNIX - Object interface for AF_UNIX domain sockets
+
+=head1 SYNOPSIS
+
+    use IO::Socket::UNIX;
+
+=head1 DESCRIPTION
+
+C<IO::Socket::UNIX> provides an object interface to creating and using sockets
+in the AF_UNIX domain. It is built upon the L<IO::Socket> interface and
+inherits all the methods defined by L<IO::Socket>.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ARGS] )
+
+Creates an C<IO::Socket::UNIX> object, which is a reference to a
+newly created symbol (see the C<Symbol> package). C<new>
+optionally takes arguments, these arguments are in key-value pairs.
+
+In addition to the key-value pairs accepted by L<IO::Socket>,
+C<IO::Socket::UNIX> provides.
+
+    Type    	Type of socket (eg SOCK_STREAM or SOCK_DGRAM)
+    Local   	Path to local fifo
+    Peer    	Path to peer fifo
+    Listen  	Create a listen socket
+
+If the constructor is only passed a single argument, it is assumed to
+be a C<Peer> specification.
+
+
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+ 
+As of VERSION 1.18 all IO::Socket objects have autoflush turned on
+by default. This was not the case with earlier releases.
+
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item hostpath()
+
+Returns the pathname to the fifo at the local end
+
+=item peerpath()
+
+Returns the pathanme to the fifo at the peer end
+
+=back
+
+=head1 SEE ALSO
+
+L<Socket>, L<IO::Socket>
+
+=head1 AUTHOR
+
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/O.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/O.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/O.pm	(revision 14265)
@@ -0,0 +1,86 @@
+package O;
+use B qw(minus_c save_BEGINs);
+use Carp;    
+
+sub import {
+    my ($class, $backend, @options) = @_;
+    eval "use B::$backend ()";
+    if ($@) {
+	croak "use of backend $backend failed: $@";
+    }
+    my $compilesub = &{"B::${backend}::compile"}(@options);
+    if (ref($compilesub) eq "CODE") {
+	minus_c;
+	save_BEGINs;
+	eval 'CHECK { &$compilesub() }';
+    } else {
+	die $compilesub;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+O - Generic interface to Perl Compiler backends
+
+=head1 SYNOPSIS
+
+	perl -MO=Backend[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This is the module that is used as a frontend to the Perl Compiler.
+
+=head1 CONVENTIONS
+
+Most compiler backends use the following conventions: OPTIONS
+consists of a comma-separated list of words (no white-space).
+The C<-v> option usually puts the backend into verbose mode.
+The C<-ofile> option generates output to B<file> instead of
+stdout. The C<-D> option followed by various letters turns on
+various internal debugging flags. See the documentation for the
+desired backend (named C<B::Backend> for the example above) to
+find out about that backend.
+
+=head1 IMPLEMENTATION
+
+This section is only necessary for those who want to write a
+compiler backend module that can be used via this module.
+
+The command-line mentioned in the SYNOPSIS section corresponds to
+the Perl code
+
+    use O ("Backend", OPTIONS);
+
+The C<import> function which that calls loads in the appropriate
+C<B::Backend> module and calls the C<compile> function in that
+package, passing it OPTIONS. That function is expected to return
+a sub reference which we'll call CALLBACK. Next, the "compile-only"
+flag is switched on (equivalent to the command-line option C<-c>)
+and a CHECK block is registered which calls CALLBACK. Thus the main
+Perl program mentioned on the command-line is read in, parsed and
+compiled into internal syntax tree form. Since the C<-c> flag is
+set, the program does not start running (excepting BEGIN blocks of
+course) but the CALLBACK function registered by the compiler
+backend is called.
+
+In summary, a compiler backend module should be called "B::Foo"
+for some foo and live in the appropriate directory for that name.
+It should define a function called C<compile>. When the user types
+
+    perl -MO=Foo,OPTIONS foo.pl
+
+that function is called and is passed those OPTIONS (split on
+commas). It should return a sub ref to the main compilation function.
+After the user's program is loaded and parsed, that returned sub ref
+is invoked which can then go ahead and do the compilation, usually by
+making use of the C<B> module's functionality.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/POSIX.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/POSIX.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/POSIX.pm	(revision 14265)
@@ -0,0 +1,940 @@
+package POSIX;
+
+our(@ISA, %EXPORT_TAGS, @EXPORT_OK, $AUTOLOAD) = ();
+
+use AutoLoader;
+
+use XSLoader ();
+
+our $VERSION = "1.03" ;
+
+# Grandfather old foo_h form to new :foo_h form
+my $loaded;
+
+sub import {
+    load_imports() unless $loaded++;
+    my $this = shift;
+    my @list = map { m/^\w+_h$/ ? ":$_" : $_ } @_;
+    local $Exporter::ExportLevel = 1;
+    Exporter::import($this,@list);
+}
+
+sub croak { require Carp;  goto &Carp::croak }
+
+XSLoader::load 'POSIX', $VERSION;
+
+my $EINVAL = constant("EINVAL", 0);
+my $EAGAIN = constant("EAGAIN", 0);
+
+sub AUTOLOAD {
+    if ($AUTOLOAD =~ /::(_?[a-z])/) {
+	# require AutoLoader;
+	$AutoLoader::AUTOLOAD = $AUTOLOAD;
+	goto &AutoLoader::AUTOLOAD
+    }
+    local $! = 0;
+    my $constname = $AUTOLOAD;
+    $constname =~ s/.*:://;
+    my $val = constant($constname, @_ ? $_[0] : 0);
+    if ($! == 0) {
+	*$AUTOLOAD = sub { $val };
+    }
+    elsif ($! == $EAGAIN) {	# Not really a constant, so always call.
+	*$AUTOLOAD = sub { constant($constname, $_[0]) };
+    }
+    elsif ($! == $EINVAL) {
+	croak "$constname is not a valid POSIX macro";
+    }
+    else {
+	croak "Your vendor has not defined POSIX macro $constname, used";
+    }
+
+    goto &$AUTOLOAD;
+}
+
+sub usage { 
+    my ($mess) = @_;
+    croak "Usage: POSIX::$mess";
+}
+
+sub redef { 
+    my ($mess) = @_;
+    croak "Use method $mess instead";
+}
+
+sub unimpl { 
+    my ($mess) = @_;
+    $mess =~ s/xxx//;
+    croak "Unimplemented: POSIX::$mess";
+}
+
+############################
+package POSIX::SigAction;
+
+sub new {
+    bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0}, $_[0];
+}
+
+############################
+package POSIX; # return to package POSIX so AutoSplit is happy
+1;
+__END__
+
+sub assert {
+    usage "assert(expr)" if @_ != 1;
+    if (!$_[0]) {
+	croak "Assertion failed";
+    }
+}
+
+sub tolower {
+    usage "tolower(string)" if @_ != 1;
+    lc($_[0]);
+}
+
+sub toupper {
+    usage "toupper(string)" if @_ != 1;
+    uc($_[0]);
+}
+
+sub closedir {
+    usage "closedir(dirhandle)" if @_ != 1;
+    CORE::closedir($_[0]);
+}
+
+sub opendir {
+    usage "opendir(directory)" if @_ != 1;
+    my $dirhandle;
+    CORE::opendir($dirhandle, $_[0])
+	? $dirhandle
+	: undef;
+}
+
+sub readdir {
+    usage "readdir(dirhandle)" if @_ != 1;
+    CORE::readdir($_[0]);
+}
+
+sub rewinddir {
+    usage "rewinddir(dirhandle)" if @_ != 1;
+    CORE::rewinddir($_[0]);
+}
+
+sub errno {
+    usage "errno()" if @_ != 0;
+    $! + 0;
+}
+
+sub creat {
+    usage "creat(filename, mode)" if @_ != 2;
+    &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[1]);
+}
+
+sub fcntl {
+    usage "fcntl(filehandle, cmd, arg)" if @_ != 3;
+    CORE::fcntl($_[0], $_[1], $_[2]);
+}
+
+sub getgrgid {
+    usage "getgrgid(gid)" if @_ != 1;
+    CORE::getgrgid($_[0]);
+}
+
+sub getgrnam {
+    usage "getgrnam(name)" if @_ != 1;
+    CORE::getgrnam($_[0]);
+}
+
+sub atan2 {
+    usage "atan2(x,y)" if @_ != 2;
+    CORE::atan2($_[0], $_[1]);
+}
+
+sub cos {
+    usage "cos(x)" if @_ != 1;
+    CORE::cos($_[0]);
+}
+
+sub exp {
+    usage "exp(x)" if @_ != 1;
+    CORE::exp($_[0]);
+}
+
+sub fabs {
+    usage "fabs(x)" if @_ != 1;
+    CORE::abs($_[0]);
+}
+
+sub log {
+    usage "log(x)" if @_ != 1;
+    CORE::log($_[0]);
+}
+
+sub pow {
+    usage "pow(x,exponent)" if @_ != 2;
+    $_[0] ** $_[1];
+}
+
+sub sin {
+    usage "sin(x)" if @_ != 1;
+    CORE::sin($_[0]);
+}
+
+sub sqrt {
+    usage "sqrt(x)" if @_ != 1;
+    CORE::sqrt($_[0]);
+}
+
+sub getpwnam {
+    usage "getpwnam(name)" if @_ != 1;
+    CORE::getpwnam($_[0]);
+}
+
+sub getpwuid {
+    usage "getpwuid(uid)" if @_ != 1;
+    CORE::getpwuid($_[0]);
+}
+
+sub longjmp {
+    unimpl "longjmp() is C-specific: use die instead";
+}
+
+sub setjmp {
+    unimpl "setjmp() is C-specific: use eval {} instead";
+}
+
+sub siglongjmp {
+    unimpl "siglongjmp() is C-specific: use die instead";
+}
+
+sub sigsetjmp {
+    unimpl "sigsetjmp() is C-specific: use eval {} instead";
+}
+
+sub kill {
+    usage "kill(pid, sig)" if @_ != 2;
+    CORE::kill $_[1], $_[0];
+}
+
+sub raise {
+    usage "raise(sig)" if @_ != 1;
+    CORE::kill $_[0], $$;	# Is this good enough?
+}
+
+sub offsetof {
+    unimpl "offsetof() is C-specific, stopped";
+}
+
+sub clearerr {
+    redef "IO::Handle::clearerr()";
+}
+
+sub fclose {
+    redef "IO::Handle::close()";
+}
+
+sub fdopen {
+    redef "IO::Handle::new_from_fd()";
+}
+
+sub feof {
+    redef "IO::Handle::eof()";
+}
+
+sub fgetc {
+    redef "IO::Handle::getc()";
+}
+
+sub fgets {
+    redef "IO::Handle::gets()";
+}
+
+sub fileno {
+    redef "IO::Handle::fileno()";
+}
+
+sub fopen {
+    redef "IO::File::open()";
+}
+
+sub fprintf {
+    unimpl "fprintf() is C-specific--use printf instead";
+}
+
+sub fputc {
+    unimpl "fputc() is C-specific--use print instead";
+}
+
+sub fputs {
+    unimpl "fputs() is C-specific--use print instead";
+}
+
+sub fread {
+    unimpl "fread() is C-specific--use read instead";
+}
+
+sub freopen {
+    unimpl "freopen() is C-specific--use open instead";
+}
+
+sub fscanf {
+    unimpl "fscanf() is C-specific--use <> and regular expressions instead";
+}
+
+sub fseek {
+    redef "IO::Seekable::seek()";
+}
+
+sub ferror {
+    redef "IO::Handle::error()";
+}
+
+sub fflush {
+    redef "IO::Handle::flush()";
+}
+
+sub fgetpos {
+    redef "IO::Seekable::getpos()";
+}
+
+sub fsetpos {
+    redef "IO::Seekable::setpos()";
+}
+
+sub ftell {
+    redef "IO::Seekable::tell()";
+}
+
+sub fwrite {
+    unimpl "fwrite() is C-specific--use print instead";
+}
+
+sub getc {
+    usage "getc(handle)" if @_ != 1;
+    CORE::getc($_[0]);
+}
+
+sub getchar {
+    usage "getchar()" if @_ != 0;
+    CORE::getc(STDIN);
+}
+
+sub gets {
+    usage "gets()" if @_ != 0;
+    scalar <STDIN>;
+}
+
+sub perror {
+    print STDERR "@_: " if @_;
+    print STDERR $!,"\n";
+}
+
+sub printf {
+    usage "printf(pattern, args...)" if @_ < 1;
+    CORE::printf STDOUT @_;
+}
+
+sub putc {
+    unimpl "putc() is C-specific--use print instead";
+}
+
+sub putchar {
+    unimpl "putchar() is C-specific--use print instead";
+}
+
+sub puts {
+    unimpl "puts() is C-specific--use print instead";
+}
+
+sub remove {
+    usage "remove(filename)" if @_ != 1;
+    CORE::unlink($_[0]);
+}
+
+sub rename {
+    usage "rename(oldfilename, newfilename)" if @_ != 2;
+    CORE::rename($_[0], $_[1]);
+}
+
+sub rewind {
+    usage "rewind(filehandle)" if @_ != 1;
+    CORE::seek($_[0],0,0);
+}
+
+sub scanf {
+    unimpl "scanf() is C-specific--use <> and regular expressions instead";
+}
+
+sub sprintf {
+    usage "sprintf(pattern,args)" if @_ == 0;
+    CORE::sprintf(shift,@_);
+}
+
+sub sscanf {
+    unimpl "sscanf() is C-specific--use regular expressions instead";
+}
+
+sub tmpfile {
+    redef "IO::File::new_tmpfile()";
+}
+
+sub ungetc {
+    redef "IO::Handle::ungetc()";
+}
+
+sub vfprintf {
+    unimpl "vfprintf() is C-specific";
+}
+
+sub vprintf {
+    unimpl "vprintf() is C-specific";
+}
+
+sub vsprintf {
+    unimpl "vsprintf() is C-specific";
+}
+
+sub abs {
+    usage "abs(x)" if @_ != 1;
+    CORE::abs($_[0]);
+}
+
+sub atexit {
+    unimpl "atexit() is C-specific: use END {} instead";
+}
+
+sub atof {
+    unimpl "atof() is C-specific, stopped";
+}
+
+sub atoi {
+    unimpl "atoi() is C-specific, stopped";
+}
+
+sub atol {
+    unimpl "atol() is C-specific, stopped";
+}
+
+sub bsearch {
+    unimpl "bsearch() not supplied";
+}
+
+sub calloc {
+    unimpl "calloc() is C-specific, stopped";
+}
+
+sub div {
+    unimpl "div() is C-specific, stopped";
+}
+
+sub exit {
+    usage "exit(status)" if @_ != 1;
+    CORE::exit($_[0]);
+}
+
+sub free {
+    unimpl "free() is C-specific, stopped";
+}
+
+sub getenv {
+    usage "getenv(name)" if @_ != 1;
+    $ENV{$_[0]};
+}
+
+sub labs {
+    unimpl "labs() is C-specific, use abs instead";
+}
+
+sub ldiv {
+    unimpl "ldiv() is C-specific, use / and int instead";
+}
+
+sub malloc {
+    unimpl "malloc() is C-specific, stopped";
+}
+
+sub qsort {
+    unimpl "qsort() is C-specific, use sort instead";
+}
+
+sub rand {
+    unimpl "rand() is non-portable, use Perl's rand instead";
+}
+
+sub realloc {
+    unimpl "realloc() is C-specific, stopped";
+}
+
+sub srand {
+    unimpl "srand()";
+}
+
+sub system {
+    usage "system(command)" if @_ != 1;
+    CORE::system($_[0]);
+}
+
+sub memchr {
+    unimpl "memchr() is C-specific, use index() instead";
+}
+
+sub memcmp {
+    unimpl "memcmp() is C-specific, use eq instead";
+}
+
+sub memcpy {
+    unimpl "memcpy() is C-specific, use = instead";
+}
+
+sub memmove {
+    unimpl "memmove() is C-specific, use = instead";
+}
+
+sub memset {
+    unimpl "memset() is C-specific, use x instead";
+}
+
+sub strcat {
+    unimpl "strcat() is C-specific, use .= instead";
+}
+
+sub strchr {
+    unimpl "strchr() is C-specific, use index() instead";
+}
+
+sub strcmp {
+    unimpl "strcmp() is C-specific, use eq instead";
+}
+
+sub strcpy {
+    unimpl "strcpy() is C-specific, use = instead";
+}
+
+sub strcspn {
+    unimpl "strcspn() is C-specific, use regular expressions instead";
+}
+
+sub strerror {
+    usage "strerror(errno)" if @_ != 1;
+    local $! = $_[0];
+    $! . "";
+}
+
+sub strlen {
+    unimpl "strlen() is C-specific, use length instead";
+}
+
+sub strncat {
+    unimpl "strncat() is C-specific, use .= instead";
+}
+
+sub strncmp {
+    unimpl "strncmp() is C-specific, use eq instead";
+}
+
+sub strncpy {
+    unimpl "strncpy() is C-specific, use = instead";
+}
+
+sub strpbrk {
+    unimpl "strpbrk() is C-specific, stopped";
+}
+
+sub strrchr {
+    unimpl "strrchr() is C-specific, use rindex() instead";
+}
+
+sub strspn {
+    unimpl "strspn() is C-specific, stopped";
+}
+
+sub strstr {
+    usage "strstr(big, little)" if @_ != 2;
+    CORE::index($_[0], $_[1]);
+}
+
+sub strtok {
+    unimpl "strtok() is C-specific, stopped";
+}
+
+sub chmod {
+    usage "chmod(mode, filename)" if @_ != 2;
+    CORE::chmod($_[0], $_[1]);
+}
+
+sub fstat {
+    usage "fstat(fd)" if @_ != 1;
+    local *TMP;
+    CORE::open(TMP, "<&$_[0]");		# Gross.
+    my @l = CORE::stat(TMP);
+    CORE::close(TMP);
+    @l;
+}
+
+sub mkdir {
+    usage "mkdir(directoryname, mode)" if @_ != 2;
+    CORE::mkdir($_[0], $_[1]);
+}
+
+sub stat {
+    usage "stat(filename)" if @_ != 1;
+    CORE::stat($_[0]);
+}
+
+sub umask {
+    usage "umask(mask)" if @_ != 1;
+    CORE::umask($_[0]);
+}
+
+sub wait {
+    usage "wait()" if @_ != 0;
+    CORE::wait();
+}
+
+sub waitpid {
+    usage "waitpid(pid, options)" if @_ != 2;
+    CORE::waitpid($_[0], $_[1]);
+}
+
+sub gmtime {
+    usage "gmtime(time)" if @_ != 1;
+    CORE::gmtime($_[0]);
+}
+
+sub localtime {
+    usage "localtime(time)" if @_ != 1;
+    CORE::localtime($_[0]);
+}
+
+sub time {
+    usage "time()" if @_ != 0;
+    CORE::time;
+}
+
+sub alarm {
+    usage "alarm(seconds)" if @_ != 1;
+    CORE::alarm($_[0]);
+}
+
+sub chdir {
+    usage "chdir(directory)" if @_ != 1;
+    CORE::chdir($_[0]);
+}
+
+sub chown {
+    usage "chown(filename, uid, gid)" if @_ != 3;
+    CORE::chown($_[0], $_[1], $_[2]);
+}
+
+sub execl {
+    unimpl "execl() is C-specific, stopped";
+}
+
+sub execle {
+    unimpl "execle() is C-specific, stopped";
+}
+
+sub execlp {
+    unimpl "execlp() is C-specific, stopped";
+}
+
+sub execv {
+    unimpl "execv() is C-specific, stopped";
+}
+
+sub execve {
+    unimpl "execve() is C-specific, stopped";
+}
+
+sub execvp {
+    unimpl "execvp() is C-specific, stopped";
+}
+
+sub fork {
+    usage "fork()" if @_ != 0;
+    CORE::fork;
+}
+
+sub getcwd
+{
+    usage "getcwd()" if @_ != 0;
+    if ($^O eq 'MSWin32') {
+	# this perhaps applies to everyone else also?
+	require Cwd;
+	$cwd = &Cwd::cwd;
+    }
+    else {
+	chop($cwd = `pwd`);
+    }
+    $cwd;
+}
+
+sub getegid {
+    usage "getegid()" if @_ != 0;
+    $) + 0;
+}
+
+sub geteuid {
+    usage "geteuid()" if @_ != 0;
+    $> + 0;
+}
+
+sub getgid {
+    usage "getgid()" if @_ != 0;
+    $( + 0;
+}
+
+sub getgroups {
+    usage "getgroups()" if @_ != 0;
+    my %seen;
+    grep(!$seen{$_}++, split(' ', $) ));
+}
+
+sub getlogin {
+    usage "getlogin()" if @_ != 0;
+    CORE::getlogin();
+}
+
+sub getpgrp {
+    usage "getpgrp()" if @_ != 0;
+    CORE::getpgrp;
+}
+
+sub getpid {
+    usage "getpid()" if @_ != 0;
+    $$;
+}
+
+sub getppid {
+    usage "getppid()" if @_ != 0;
+    CORE::getppid;
+}
+
+sub getuid {
+    usage "getuid()" if @_ != 0;
+    $<;
+}
+
+sub isatty {
+    usage "isatty(filehandle)" if @_ != 1;
+    -t $_[0];
+}
+
+sub link {
+    usage "link(oldfilename, newfilename)" if @_ != 2;
+    CORE::link($_[0], $_[1]);
+}
+
+sub rmdir {
+    usage "rmdir(directoryname)" if @_ != 1;
+    CORE::rmdir($_[0]);
+}
+
+sub setbuf {
+    redef "IO::Handle::setbuf()";
+}
+
+sub setgid {
+    usage "setgid(gid)" if @_ != 1;
+    $( = $_[0];
+}
+
+sub setuid {
+    usage "setuid(uid)" if @_ != 1;
+    $< = $_[0];
+}
+
+sub setvbuf {
+    redef "IO::Handle::setvbuf()";
+}
+
+sub sleep {
+    usage "sleep(seconds)" if @_ != 1;
+    CORE::sleep($_[0]);
+}
+
+sub unlink {
+    usage "unlink(filename)" if @_ != 1;
+    CORE::unlink($_[0]);
+}
+
+sub utime {
+    usage "utime(filename, atime, mtime)" if @_ != 3;
+    CORE::utime($_[1], $_[2], $_[0]);
+}
+
+sub load_imports {
+%EXPORT_TAGS = (
+
+    assert_h =>	[qw(assert NDEBUG)],
+
+    ctype_h =>	[qw(isalnum isalpha iscntrl isdigit isgraph islower
+		isprint ispunct isspace isupper isxdigit tolower toupper)],
+
+    dirent_h =>	[qw()],
+
+    errno_h =>	[qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
+		EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
+		ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
+		EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
+		EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
+		EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
+		ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
+		ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
+		ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
+		EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
+		ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
+		ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
+		EUSERS EWOULDBLOCK EXDEV errno)],
+
+    fcntl_h =>	[qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK
+		F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK
+		O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK
+		O_RDONLY O_RDWR O_TRUNC O_WRONLY
+		creat
+		SEEK_CUR SEEK_END SEEK_SET
+		S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
+		S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG S_ISUID
+		S_IWGRP S_IWOTH S_IWUSR)],
+
+    float_h =>	[qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG
+		DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP
+		DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP
+		FLT_DIG FLT_EPSILON FLT_MANT_DIG
+		FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP
+		FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP
+		FLT_RADIX FLT_ROUNDS
+		LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG
+		LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP
+		LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)],
+
+    grp_h =>	[qw()],
+
+    limits_h =>	[qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX
+		INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON
+		MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX
+		PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN
+		SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX
+		ULONG_MAX USHRT_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX
+		_POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT
+		_POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX
+		_POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX
+		_POSIX_STREAM_MAX _POSIX_TZNAME_MAX)],
+
+    locale_h =>	[qw(LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC
+		LC_TIME NULL localeconv setlocale)],
+
+    math_h =>	[qw(HUGE_VAL acos asin atan ceil cosh fabs floor fmod
+		frexp ldexp log10 modf pow sinh tan tanh)],
+
+    pwd_h =>	[qw()],
+
+    setjmp_h =>	[qw(longjmp setjmp siglongjmp sigsetjmp)],
+
+    signal_h =>	[qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK
+		SA_RESETHAND SA_RESTART SA_SIGINFO SIGABRT SIGALRM
+		SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL
+		SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN
+		SIGTTOU SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR
+		SIG_IGN SIG_SETMASK SIG_UNBLOCK raise sigaction signal
+		sigpending sigprocmask sigsuspend)],
+
+    stdarg_h =>	[qw()],
+
+    stddef_h =>	[qw(NULL offsetof)],
+
+    stdio_h =>	[qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid
+		L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET
+		STREAM_MAX TMP_MAX stderr stdin stdout
+		clearerr fclose fdopen feof ferror fflush fgetc fgetpos
+		fgets fopen fprintf fputc fputs fread freopen
+		fscanf fseek fsetpos ftell fwrite getchar gets
+		perror putc putchar puts remove rewind
+		scanf setbuf setvbuf sscanf tmpfile tmpnam
+		ungetc vfprintf vprintf vsprintf)],
+
+    stdlib_h =>	[qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX
+		abort atexit atof atoi atol bsearch calloc div
+		free getenv labs ldiv malloc mblen mbstowcs mbtowc
+		qsort realloc strtod strtol strtoul wcstombs wctomb)],
+
+    string_h =>	[qw(NULL memchr memcmp memcpy memmove memset strcat
+		strchr strcmp strcoll strcpy strcspn strerror strlen
+		strncat strncmp strncpy strpbrk strrchr strspn strstr
+		strtok strxfrm)],
+
+    sys_stat_h => [qw(S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
+		S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG
+		S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR
+		fstat mkfifo)],
+
+    sys_times_h => [qw()],
+
+    sys_types_h => [qw()],
+
+    sys_utsname_h => [qw(uname)],
+
+    sys_wait_h => [qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED
+		WNOHANG WSTOPSIG WTERMSIG WUNTRACED)],
+
+    termios_h => [qw( B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400
+		B300 B38400 B4800 B50 B600 B75 B9600 BRKINT CLOCAL
+		CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB ECHO ECHOE ECHOK
+		ECHONL HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR
+		INLCR INPCK ISIG ISTRIP IXOFF IXON NCCS NOFLSH OPOST
+		PARENB PARMRK PARODD TCIFLUSH TCIOFF TCIOFLUSH TCION
+		TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW
+		TOSTOP VEOF VEOL VERASE VINTR VKILL VMIN VQUIT VSTART
+		VSTOP VSUSP VTIME
+		cfgetispeed cfgetospeed cfsetispeed cfsetospeed tcdrain
+		tcflow tcflush tcgetattr tcsendbreak tcsetattr )],
+
+    time_h =>	[qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime
+		difftime mktime strftime tzset tzname)],
+
+    unistd_h =>	[qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET
+		STDERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK
+		_PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON
+		_PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX
+		_PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED
+		_POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS
+		_POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX
+		_SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL
+		_SC_NGROUPS_MAX _SC_OPEN_MAX _SC_SAVED_IDS
+		_SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION
+		_exit access ctermid cuserid
+		dup2 dup execl execle execlp execv execve execvp
+		fpathconf getcwd getegid geteuid getgid getgroups
+		getpid getuid isatty lseek pathconf pause setgid setpgid
+		setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)],
+
+    utime_h =>	[qw()],
+
+);
+
+# Exporter::export_tags();
+for (values %EXPORT_TAGS) {
+  push @EXPORT, @$_;
+}
+
+@EXPORT_OK = qw(
+    closedir opendir readdir rewinddir
+    fcntl open
+    getgrgid getgrnam
+    atan2 cos exp log sin sqrt
+    getpwnam getpwuid
+    kill
+    fileno getc printf rename sprintf
+    abs exit rand srand system
+    chmod mkdir stat umask
+    times
+    wait waitpid
+    gmtime localtime time 
+    alarm chdir chown close fork getlogin getppid getpgrp link
+	pipe read rmdir sleep unlink write
+    utime
+    nice
+);
+
+require Exporter;
+}
Index: /for-distributions/trunk/bin/windows/perl/lib/SelectSaver.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/SelectSaver.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/SelectSaver.pm	(revision 14265)
@@ -0,0 +1,52 @@
+package SelectSaver;
+
+=head1 NAME
+
+SelectSaver - save and restore selected file handle
+
+=head1 SYNOPSIS
+
+    use SelectSaver;
+
+    {
+       my $saver = new SelectSaver(FILEHANDLE);
+       # FILEHANDLE is selected
+    }
+    # previous handle is selected
+
+    {
+       my $saver = new SelectSaver;
+       # new handle may be selected, or not
+    }
+    # previous handle is selected
+
+=head1 DESCRIPTION
+
+A C<SelectSaver> object contains a reference to the file handle that
+was selected when it was created.  If its C<new> method gets an extra
+parameter, then that parameter is selected; otherwise, the selected
+file handle remains unchanged.
+
+When a C<SelectSaver> is destroyed, it re-selects the file handle
+that was selected when it was created.
+
+=cut
+
+require 5.000;
+use Carp;
+use Symbol;
+
+sub new {
+    @_ >= 1 && @_ <= 2 or croak 'usage: new SelectSaver [FILEHANDLE]';
+    my $fh = select;
+    my $self = bless [$fh], $_[0];
+    select qualify($_[1], caller) if @_ > 1;
+    $self;
+}
+
+sub DESTROY {
+    my $this = $_[0];
+    select $$this[0];
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/SelfLoader.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/SelfLoader.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/SelfLoader.pm	(revision 14265)
@@ -0,0 +1,307 @@
+package SelfLoader;
+# use Carp;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(AUTOLOAD);
+$VERSION = "1.0902";
+sub Version {$VERSION}
+$DEBUG = 0;
+
+my %Cache;      # private cache for all SelfLoader's client packages
+
+# allow checking for valid ': attrlist' attachments
+my $nested;
+$nested = qr{ \( (?: (?> [^()]+ ) | (??{ $nested }) )* \) }x;
+my $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x;
+my $attr_list = qr{ \s* : \s* (?: $one_attr )* }x;
+
+sub croak { require Carp; goto &Carp::croak }
+
+AUTOLOAD {
+    print STDERR "SelfLoader::AUTOLOAD for $AUTOLOAD\n" if $DEBUG;
+    my $SL_code = $Cache{$AUTOLOAD};
+    my $save = $@; # evals in both AUTOLOAD and _load_stubs can corrupt $@
+    unless ($SL_code) {
+        # Maybe this pack had stubs before __DATA__, and never initialized.
+        # Or, this maybe an automatic DESTROY method call when none exists.
+        $AUTOLOAD =~ m/^(.*)::/;
+        SelfLoader->_load_stubs($1) unless exists $Cache{"${1}::<DATA"};
+        $SL_code = $Cache{$AUTOLOAD};
+        $SL_code = "sub $AUTOLOAD { }"
+            if (!$SL_code and $AUTOLOAD =~ m/::DESTROY$/);
+        croak "Undefined subroutine $AUTOLOAD" unless $SL_code;
+    }
+    print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if $DEBUG;
+
+    eval $SL_code;
+    if ($@) {
+        $@ =~ s/ at .*\n//;
+        croak $@;
+    }
+    $@ = $save;
+    defined(&$AUTOLOAD) || die "SelfLoader inconsistency error";
+    delete $Cache{$AUTOLOAD};
+    goto &$AUTOLOAD
+}
+
+sub load_stubs { shift->_load_stubs((caller)[0]) }
+
+sub _load_stubs {
+    my($self, $callpack) = @_;
+    my $fh = \*{"${callpack}::DATA"};
+    my $currpack = $callpack;
+    my($line,$name,@lines, @stubs, $protoype);
+
+    print STDERR "SelfLoader::load_stubs($callpack)\n" if $DEBUG;
+    croak("$callpack doesn't contain an __DATA__ token")
+        unless fileno($fh);
+    $Cache{"${currpack}::<DATA"} = 1;   # indicate package is cached
+
+    local($/) = "\n";
+    while(defined($line = <$fh>) and $line !~ m/^__END__/) {
+	if ($line =~ m/^sub\s+([\w:]+)\s*((?:\([\\\$\@\%\&\*\;]*\))?(?:$attr_list)?)/) {
+            push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+            $protoype = $2;
+            @lines = ($line);
+            if (index($1,'::') == -1) {         # simple sub name
+                $name = "${currpack}::$1";
+            } else {                            # sub name with package
+                $name = $1;
+                $name =~ m/^(.*)::/;
+                if (defined(&{"${1}::AUTOLOAD"})) {
+                    \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD ||
+                        die 'SelfLoader Error: attempt to specify Selfloading',
+                            " sub $name in non-selfloading module $1";
+                } else {
+                    $self->export($1,'AUTOLOAD');
+                }
+            }
+        } elsif ($line =~ m/^package\s+([\w:]+)/) { # A package declared
+            push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+            $self->_package_defined($line);
+            $name = '';
+            @lines = ();
+            $currpack = $1;
+            $Cache{"${currpack}::<DATA"} = 1;   # indicate package is cached
+            if (defined(&{"${1}::AUTOLOAD"})) {
+                \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD ||
+                    die 'SelfLoader Error: attempt to specify Selfloading',
+                        " package $currpack which already has AUTOLOAD";
+            } else {
+                $self->export($currpack,'AUTOLOAD');
+            }
+        } else {
+            push(@lines,$line);
+        }
+    }
+    close($fh) unless defined($line) && $line =~ /^__END__\s*DATA/;     # __END__
+    push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+    eval join('', @stubs) if @stubs;
+}
+
+
+sub _add_to_cache {
+    my($self,$fullname,$pack,$lines, $protoype) = @_;
+    return () unless $fullname;
+    (require Carp), Carp::carp("Redefining sub $fullname")
+      if exists $Cache{$fullname};
+    $Cache{$fullname} = join('', "package $pack; ",@$lines);
+    print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if $DEBUG;
+    # return stub to be eval'd
+    defined($protoype) ? "sub $fullname $protoype;" : "sub $fullname;"
+}
+
+sub _package_defined {}
+
+1;
+__END__
+
+=head1 NAME
+
+SelfLoader - load functions only on demand
+
+=head1 SYNOPSIS
+
+    package FOOBAR;
+    use SelfLoader;
+
+    ... (initializing code)
+
+    __DATA__
+    sub {....
+
+
+=head1 DESCRIPTION
+
+This module tells its users that functions in the FOOBAR package are to be
+autoloaded from after the C<__DATA__> token.  See also
+L<perlsub/"Autoloading">.
+
+=head2 The __DATA__ token
+
+The C<__DATA__> token tells the perl compiler that the perl code
+for compilation is finished. Everything after the C<__DATA__> token
+is available for reading via the filehandle FOOBAR::DATA,
+where FOOBAR is the name of the current package when the C<__DATA__>
+token is reached. This works just the same as C<__END__> does in
+package 'main', but for other modules data after C<__END__> is not
+automatically retrievable, whereas data after C<__DATA__> is.
+The C<__DATA__> token is not recognized in versions of perl prior to
+5.001m.
+
+Note that it is possible to have C<__DATA__> tokens in the same package
+in multiple files, and that the last C<__DATA__> token in a given
+package that is encountered by the compiler is the one accessible
+by the filehandle. This also applies to C<__END__> and main, i.e. if
+the 'main' program has an C<__END__>, but a module 'require'd (_not_ 'use'd)
+by that program has a 'package main;' declaration followed by an 'C<__DATA__>',
+then the C<DATA> filehandle is set to access the data after the C<__DATA__>
+in the module, _not_ the data after the C<__END__> token in the 'main'
+program, since the compiler encounters the 'require'd file later.
+
+=head2 SelfLoader autoloading
+
+The B<SelfLoader> works by the user placing the C<__DATA__>
+token I<after> perl code which needs to be compiled and
+run at 'require' time, but I<before> subroutine declarations
+that can be loaded in later - usually because they may never
+be called.
+
+The B<SelfLoader> will read from the FOOBAR::DATA filehandle to
+load in the data after C<__DATA__>, and load in any subroutine
+when it is called. The costs are the one-time parsing of the
+data after C<__DATA__>, and a load delay for the _first_
+call of any autoloaded function. The benefits (hopefully)
+are a speeded up compilation phase, with no need to load
+functions which are never used.
+
+The B<SelfLoader> will stop reading from C<__DATA__> if
+it encounters the C<__END__> token - just as you would expect.
+If the C<__END__> token is present, and is followed by the
+token DATA, then the B<SelfLoader> leaves the FOOBAR::DATA
+filehandle open on the line after that token.
+
+The B<SelfLoader> exports the C<AUTOLOAD> subroutine to the
+package using the B<SelfLoader>, and this loads the called
+subroutine when it is first called.
+
+There is no advantage to putting subroutines which will _always_
+be called after the C<__DATA__> token.
+
+=head2 Autoloading and package lexicals
+
+A 'my $pack_lexical' statement makes the variable $pack_lexical
+local _only_ to the file up to the C<__DATA__> token. Subroutines
+declared elsewhere _cannot_ see these types of variables,
+just as if you declared subroutines in the package but in another
+file, they cannot see these variables.
+
+So specifically, autoloaded functions cannot see package
+lexicals (this applies to both the B<SelfLoader> and the Autoloader).
+The C<vars> pragma provides an alternative to defining package-level
+globals that will be visible to autoloaded routines. See the documentation
+on B<vars> in the pragma section of L<perlmod>.
+
+=head2 SelfLoader and AutoLoader
+
+The B<SelfLoader> can replace the AutoLoader - just change 'use AutoLoader'
+to 'use SelfLoader' (though note that the B<SelfLoader> exports
+the AUTOLOAD function - but if you have your own AUTOLOAD and
+are using the AutoLoader too, you probably know what you're doing),
+and the C<__END__> token to C<__DATA__>. You will need perl version 5.001m
+or later to use this (version 5.001 with all patches up to patch m).
+
+There is no need to inherit from the B<SelfLoader>.
+
+The B<SelfLoader> works similarly to the AutoLoader, but picks up the
+subs from after the C<__DATA__> instead of in the 'lib/auto' directory.
+There is a maintenance gain in not needing to run AutoSplit on the module
+at installation, and a runtime gain in not needing to keep opening and
+closing files to load subs. There is a runtime loss in needing
+to parse the code after the C<__DATA__>. Details of the B<AutoLoader> and
+another view of these distinctions can be found in that module's
+documentation.
+
+=head2 __DATA__, __END__, and the FOOBAR::DATA filehandle.
+
+This section is only relevant if you want to use
+the C<FOOBAR::DATA> together with the B<SelfLoader>.
+
+Data after the C<__DATA__> token in a module is read using the
+FOOBAR::DATA filehandle. C<__END__> can still be used to denote the end
+of the C<__DATA__> section if followed by the token DATA - this is supported
+by the B<SelfLoader>. The C<FOOBAR::DATA> filehandle is left open if an
+C<__END__> followed by a DATA is found, with the filehandle positioned at
+the start of the line after the C<__END__> token. If no C<__END__> token is
+present, or an C<__END__> token with no DATA token on the same line, then
+the filehandle is closed.
+
+The B<SelfLoader> reads from wherever the current
+position of the C<FOOBAR::DATA> filehandle is, until the
+EOF or C<__END__>. This means that if you want to use
+that filehandle (and ONLY if you want to), you should either
+
+1. Put all your subroutine declarations immediately after
+the C<__DATA__> token and put your own data after those
+declarations, using the C<__END__> token to mark the end
+of subroutine declarations. You must also ensure that the B<SelfLoader>
+reads first by  calling 'SelfLoader-E<gt>load_stubs();', or by using a
+function which is selfloaded;
+
+or
+
+2. You should read the C<FOOBAR::DATA> filehandle first, leaving
+the handle open and positioned at the first line of subroutine
+declarations.
+
+You could conceivably do both.
+
+=head2 Classes and inherited methods.
+
+For modules which are not classes, this section is not relevant.
+This section is only relevant if you have methods which could
+be inherited.
+
+A subroutine stub (or forward declaration) looks like
+
+  sub stub;
+
+i.e. it is a subroutine declaration without the body of the
+subroutine. For modules which are not classes, there is no real
+need for stubs as far as autoloading is concerned.
+
+For modules which ARE classes, and need to handle inherited methods,
+stubs are needed to ensure that the method inheritance mechanism works
+properly. You can load the stubs into the module at 'require' time, by
+adding the statement 'SelfLoader-E<gt>load_stubs();' to the module to do
+this.
+
+The alternative is to put the stubs in before the C<__DATA__> token BEFORE
+releasing the module, and for this purpose the C<Devel::SelfStubber>
+module is available.  However this does require the extra step of ensuring
+that the stubs are in the module. If this is done I strongly recommend
+that this is done BEFORE releasing the module - it should NOT be done
+at install time in general.
+
+=head1 Multiple packages and fully qualified subroutine names
+
+Subroutines in multiple packages within the same file are supported - but you
+should note that this requires exporting the C<SelfLoader::AUTOLOAD> to
+every package which requires it. This is done automatically by the
+B<SelfLoader> when it first loads the subs into the cache, but you should
+really specify it in the initialization before the C<__DATA__> by putting
+a 'use SelfLoader' statement in each package.
+
+Fully qualified subroutine names are also supported. For example,
+
+   __DATA__
+   sub foo::bar {23}
+   package baz;
+   sub dob {32}
+
+will all be loaded correctly by the B<SelfLoader>, and the B<SelfLoader>
+will ensure that the packages 'foo' and 'baz' correctly have the
+B<SelfLoader> C<AUTOLOAD> method when the data after C<__DATA__> is first
+parsed.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/Shell.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Shell.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Shell.pm	(revision 14265)
@@ -0,0 +1,201 @@
+package Shell;
+use 5.005_64;
+use strict;
+use warnings;
+our($capture_stderr, $VERSION, $AUTOLOAD);
+
+$VERSION = '0.3';
+
+sub new { bless \$VERSION, shift } # Nothing better to bless
+sub DESTROY { }
+
+sub import {
+    my $self = shift;
+    my ($callpack, $callfile, $callline) = caller;
+    my @EXPORT;
+    if (@_) {
+	@EXPORT = @_;
+    } else {
+	@EXPORT = 'AUTOLOAD';
+    }
+    foreach my $sym (@EXPORT) {
+        no strict 'refs';
+        *{"${callpack}::$sym"} = \&{"Shell::$sym"};
+    }
+}
+
+sub AUTOLOAD {
+    shift if ref $_[0] && $_[0]->isa( 'Shell' );
+    my $cmd = $AUTOLOAD;
+    $cmd =~ s/^.*:://;
+    eval <<"*END*";
+	sub $AUTOLOAD {
+	    if (\@_ < 1) {
+		\$Shell::capture_stderr ? `$cmd 2>&1` : `$cmd`;
+	    } elsif ('$^O' eq 'os2') {
+		local(\*SAVEOUT, \*READ, \*WRITE);
+
+		open SAVEOUT, '>&STDOUT' or die;
+		pipe READ, WRITE or die;
+		open STDOUT, '>&WRITE' or die;
+		close WRITE;
+
+		my \$pid = system(1, '$cmd', \@_);
+		die "Can't execute $cmd: \$!\\n" if \$pid < 0;
+
+		open STDOUT, '>&SAVEOUT' or die;
+		close SAVEOUT;
+
+		if (wantarray) {
+		    my \@ret = <READ>;
+		    close READ;
+		    waitpid \$pid, 0;
+		    \@ret;
+		} else {
+		    local(\$/) = undef;
+		    my \$ret = <READ>;
+		    close READ;
+		    waitpid \$pid, 0;
+		    \$ret;
+		}
+	    } else {
+		my \$a;
+		my \@arr = \@_;
+		if ('$^O' eq 'MSWin32') {
+		    # XXX this special-casing should not be needed
+		    # if we do quoting right on Windows. :-(
+		    #
+		    # First, escape all quotes.  Cover the case where we
+		    # want to pass along a quote preceded by a backslash
+		    # (i.e., C<"param \\""" end">).
+		    # Ugly, yup?  You know, windoze.
+		    # Enclose in quotes only the parameters that need it:
+		    #   try this: c:\> dir "/w"
+		    #   and this: c:\> dir /w
+		    for (\@arr) {
+			s/"/\\\\"/g;
+			s/\\\\\\\\"/\\\\\\\\"""/g;
+			\$_ = qq["\$_"] if /\\s/;
+		    }
+		} else {
+		    for (\@arr) {
+			s/(['\\\\])/\\\\\$1/g;
+			\$_ = \$_;
+		    }
+		}
+		push \@arr, '2>&1' if \$Shell::capture_stderr;
+		open(SUBPROC, join(' ', '$cmd', \@arr, '|'))
+		    or die "Can't exec $cmd: \$!\\n";
+		if (wantarray) {
+		    my \@ret = <SUBPROC>;
+		    close SUBPROC;	# XXX Oughta use a destructor.
+		    \@ret;
+		} else {
+		    local(\$/) = undef;
+		    my \$ret = <SUBPROC>;
+		    close SUBPROC;
+		    \$ret;
+		}
+	    }
+	}
+*END*
+
+    die "$@\n" if $@;
+    goto &$AUTOLOAD;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Shell - run shell commands transparently within perl
+
+=head1 SYNOPSIS
+
+See below.
+
+=head1 DESCRIPTION
+
+  Date: Thu, 22 Sep 94 16:18:16 -0700
+  Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
+  To: perl5-porters@isu.edu
+  From: Larry Wall <lwall@scalpel.netlabs.com>
+  Subject: a new module I just wrote
+
+Here's one that'll whack your mind a little out.
+
+    #!/usr/bin/perl
+
+    use Shell;
+
+    $foo = echo("howdy", "<funny>", "world");
+    print $foo;
+
+    $passwd = cat("</etc/passwd");
+    print $passwd;
+
+    sub ps;
+    print ps -ww;
+
+    cp("/etc/passwd", "/tmp/passwd");
+
+That's maybe too gonzo.  It actually exports an AUTOLOAD to the current
+package (and uncovered a bug in Beta 3, by the way).  Maybe the usual
+usage should be
+
+    use Shell qw(echo cat ps cp);
+
+Larry
+
+
+If you set $Shell::capture_stderr to 1, the module will attempt to
+capture the STDERR of the process as well.
+
+The module now should work on Win32.
+
+ Jenda
+
+There seemed to be a problem where all arguments to a shell command were
+quoted before being executed.  As in the following example:
+
+ cat('</etc/passwd');
+ ls('*.pl');
+
+really turned into:
+
+ cat '</etc/passwd'
+ ls '*.pl'
+
+instead of:
+
+  cat </etc/passwd
+  ls *.pl
+
+and of course, this is wrong.
+
+I have fixed this bug, it was brought up by Wolfgang Laun [ID 20000326.008]
+
+Casey
+
+=head2 OBJECT ORIENTED SYNTAX
+
+Shell now has an OO interface.  Good for namespace conservation 
+and shell representation.
+
+ use Shell;
+ my $sh = Shell->new;
+ print $sh->ls;
+
+Casey
+
+=head1 AUTHOR
+
+Larry Wall
+
+Changes by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>
+
+Changes and bug fixes by Casey Tweten <crt@kiski.net>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/Socket.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Socket.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Socket.pm	(revision 14265)
@@ -0,0 +1,453 @@
+package Socket;
+
+our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+$VERSION = "1.72";
+
+=head1 NAME
+
+Socket, sockaddr_in, sockaddr_un, inet_aton, inet_ntoa - load the C socket.h defines and structure manipulators 
+
+=head1 SYNOPSIS
+
+    use Socket;
+
+    $proto = getprotobyname('udp');
+    socket(Socket_Handle, PF_INET, SOCK_DGRAM, $proto);
+    $iaddr = gethostbyname('hishost.com');
+    $port = getservbyname('time', 'udp');
+    $sin = sockaddr_in($port, $iaddr);
+    send(Socket_Handle, 0, 0, $sin);
+
+    $proto = getprotobyname('tcp');
+    socket(Socket_Handle, PF_INET, SOCK_STREAM, $proto);
+    $port = getservbyname('smtp', 'tcp');
+    $sin = sockaddr_in($port,inet_aton("127.1"));
+    $sin = sockaddr_in(7,inet_aton("localhost"));
+    $sin = sockaddr_in(7,INADDR_LOOPBACK);
+    connect(Socket_Handle,$sin);
+
+    ($port, $iaddr) = sockaddr_in(getpeername(Socket_Handle));
+    $peer_host = gethostbyaddr($iaddr, AF_INET);
+    $peer_addr = inet_ntoa($iaddr);
+
+    $proto = getprotobyname('tcp');
+    socket(Socket_Handle, PF_UNIX, SOCK_STREAM, $proto);
+    unlink('/tmp/usock');
+    $sun = sockaddr_un('/tmp/usock');
+    connect(Socket_Handle,$sun);
+
+=head1 DESCRIPTION
+
+This module is just a translation of the C F<socket.h> file.
+Unlike the old mechanism of requiring a translated F<socket.ph>
+file, this uses the B<h2xs> program (see the Perl source distribution)
+and your native C compiler.  This means that it has a 
+far more likely chance of getting the numbers right.  This includes
+all of the commonly used pound-defines like AF_INET, SOCK_STREAM, etc.
+
+Also, some common socket "newline" constants are provided: the
+constants C<CR>, C<LF>, and C<CRLF>, as well as C<$CR>, C<$LF>, and
+C<$CRLF>, which map to C<\015>, C<\012>, and C<\015\012>.  If you do
+not want to use the literal characters in your programs, then use
+the constants provided here.  They are not exported by default, but can
+be imported individually, and with the C<:crlf> export tag:
+
+    use Socket qw(:DEFAULT :crlf);
+
+In addition, some structure manipulation functions are available:
+
+=over
+
+=item inet_aton HOSTNAME
+
+Takes a string giving the name of a host, and translates that
+to the 4-byte string (structure). Takes arguments of both
+the 'rtfm.mit.edu' type and '18.181.0.24'. If the host name
+cannot be resolved, returns undef. For multi-homed hosts (hosts
+with more than one address), the first address found is returned.
+
+=item inet_ntoa IP_ADDRESS
+
+Takes a four byte ip address (as returned by inet_aton())
+and translates it into a string of the form 'd.d.d.d'
+where the 'd's are numbers less than 256 (the normal
+readable four dotted number notation for internet addresses).
+
+=item INADDR_ANY
+
+Note: does not return a number, but a packed string.
+
+Returns the 4-byte wildcard ip address which specifies any
+of the hosts ip addresses. (A particular machine can have
+more than one ip address, each address corresponding to
+a particular network interface. This wildcard address
+allows you to bind to all of them simultaneously.)
+Normally equivalent to inet_aton('0.0.0.0').
+
+=item INADDR_BROADCAST
+
+Note: does not return a number, but a packed string.
+
+Returns the 4-byte 'this-lan' ip broadcast address.
+This can be useful for some protocols to solicit information
+from all servers on the same LAN cable.
+Normally equivalent to inet_aton('255.255.255.255').
+
+=item INADDR_LOOPBACK
+
+Note - does not return a number.
+
+Returns the 4-byte loopback address. Normally equivalent
+to inet_aton('localhost').
+
+=item INADDR_NONE
+
+Note - does not return a number.
+
+Returns the 4-byte 'invalid' ip address. Normally equivalent
+to inet_aton('255.255.255.255').
+
+=item sockaddr_in PORT, ADDRESS
+
+=item sockaddr_in SOCKADDR_IN
+
+In a list context, unpacks its SOCKADDR_IN argument and returns an array
+consisting of (PORT, ADDRESS).  In a scalar context, packs its (PORT,
+ADDRESS) arguments as a SOCKADDR_IN and returns it.  If this is confusing,
+use pack_sockaddr_in() and unpack_sockaddr_in() explicitly.
+
+=item pack_sockaddr_in PORT, IP_ADDRESS
+
+Takes two arguments, a port number and a 4 byte IP_ADDRESS (as returned by
+inet_aton()). Returns the sockaddr_in structure with those arguments
+packed in with AF_INET filled in.  For internet domain sockets, this
+structure is normally what you need for the arguments in bind(),
+connect(), and send(), and is also returned by getpeername(),
+getsockname() and recv().
+
+=item unpack_sockaddr_in SOCKADDR_IN
+
+Takes a sockaddr_in structure (as returned by pack_sockaddr_in()) and
+returns an array of two elements: the port and the 4-byte ip-address.
+Will croak if the structure does not have AF_INET in the right place.
+
+=item sockaddr_un PATHNAME
+
+=item sockaddr_un SOCKADDR_UN
+
+In a list context, unpacks its SOCKADDR_UN argument and returns an array
+consisting of (PATHNAME).  In a scalar context, packs its PATHNAME
+arguments as a SOCKADDR_UN and returns it.  If this is confusing, use
+pack_sockaddr_un() and unpack_sockaddr_un() explicitly.
+These are only supported if your system has E<lt>F<sys/un.h>E<gt>.
+
+=item pack_sockaddr_un PATH
+
+Takes one argument, a pathname. Returns the sockaddr_un structure with
+that path packed in with AF_UNIX filled in. For unix domain sockets, this
+structure is normally what you need for the arguments in bind(),
+connect(), and send(), and is also returned by getpeername(),
+getsockname() and recv().
+
+=item unpack_sockaddr_un SOCKADDR_UN
+
+Takes a sockaddr_un structure (as returned by pack_sockaddr_un())
+and returns the pathname.  Will croak if the structure does not
+have AF_UNIX in the right place.
+
+=back
+
+=cut
+
+use Carp;
+use warnings::register;
+
+require Exporter;
+use XSLoader ();
+@ISA = qw(Exporter);
+@EXPORT = qw(
+	inet_aton inet_ntoa pack_sockaddr_in unpack_sockaddr_in
+	pack_sockaddr_un unpack_sockaddr_un
+	sockaddr_in sockaddr_un
+	INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
+	AF_802
+	AF_APPLETALK
+	AF_CCITT
+	AF_CHAOS
+	AF_DATAKIT
+	AF_DECnet
+	AF_DLI
+	AF_ECMA
+	AF_GOSIP
+	AF_HYLINK
+	AF_IMPLINK
+	AF_INET
+	AF_LAT
+	AF_MAX
+	AF_NBS
+	AF_NIT
+	AF_NS
+	AF_OSI
+	AF_OSINET
+	AF_PUP
+	AF_SNA
+	AF_UNIX
+	AF_UNSPEC
+	AF_X25
+	IOV_MAX
+	MSG_BCAST
+	MSG_CTLFLAGS
+	MSG_CTLIGNORE
+	MSG_CTRUNC
+	MSG_DONTROUTE
+	MSG_DONTWAIT
+	MSG_EOF
+	MSG_EOR
+	MSG_ERRQUEUE
+	MSG_FIN
+	MSG_MAXIOVLEN
+	MSG_MCAST
+	MSG_NOSIGNAL
+	MSG_OOB
+	MSG_PEEK
+	MSG_PROXY
+	MSG_RST
+	MSG_SYN
+	MSG_TRUNC
+	MSG_URG
+	MSG_WAITALL
+	PF_802
+	PF_APPLETALK
+	PF_CCITT
+	PF_CHAOS
+	PF_DATAKIT
+	PF_DECnet
+	PF_DLI
+	PF_ECMA
+	PF_GOSIP
+	PF_HYLINK
+	PF_IMPLINK
+	PF_INET
+	PF_LAT
+	PF_MAX
+	PF_NBS
+	PF_NIT
+	PF_NS
+	PF_OSI
+	PF_OSINET
+	PF_PUP
+	PF_SNA
+	PF_UNIX
+	PF_UNSPEC
+	PF_X25
+	SCM_CONNECT
+	SCM_CREDENTIALS
+	SCM_CREDS
+	SCM_RIGHTS
+	SCM_TIMESTAMP
+	SHUT_RD
+	SHUT_RDWR
+	SHUT_WR
+	SOCK_DGRAM
+	SOCK_RAW
+	SOCK_RDM
+	SOCK_SEQPACKET
+	SOCK_STREAM
+	SOL_SOCKET
+	SOMAXCONN
+	SO_ACCEPTCONN
+	SO_BROADCAST
+	SO_DEBUG
+	SO_DONTLINGER
+	SO_DONTROUTE
+	SO_ERROR
+	SO_KEEPALIVE
+	SO_LINGER
+	SO_OOBINLINE
+	SO_RCVBUF
+	SO_RCVLOWAT
+	SO_RCVTIMEO
+	SO_REUSEADDR
+	SO_REUSEPORT
+	SO_SNDBUF
+	SO_SNDLOWAT
+	SO_SNDTIMEO
+	SO_TYPE
+	SO_USELOOPBACK
+	UIO_MAXIOV
+);
+
+@EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF
+
+	       IPPROTO_TCP
+	       TCP_KEEPALIVE
+	       TCP_MAXRT
+	       TCP_MAXSEG
+	       TCP_NODELAY
+	       TCP_STDURG);
+
+%EXPORT_TAGS = (
+    crlf    => [qw(CR LF CRLF $CR $LF $CRLF)],
+    all     => [@EXPORT, @EXPORT_OK],
+);
+
+BEGIN {
+    sub CR   () {"\015"}
+    sub LF   () {"\012"}
+    sub CRLF () {"\015\012"}
+}
+
+*CR   = \CR();
+*LF   = \LF();
+*CRLF = \CRLF();
+
+sub sockaddr_in {
+    if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die
+	my($af, $port, @quad) = @_;
+	warnings::warn "6-ARG sockaddr_in call is deprecated" 
+	    if warnings::enabled();
+	pack_sockaddr_in($port, inet_aton(join('.', @quad)));
+    } elsif (wantarray) {
+	croak "usage:   (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1;
+        unpack_sockaddr_in(@_);
+    } else {
+	croak "usage:   sin_sv = sockaddr_in(port,iaddr))" unless @_ == 2;
+        pack_sockaddr_in(@_);
+    }
+}
+
+sub sockaddr_un {
+    if (wantarray) {
+	croak "usage:   (filename) = sockaddr_un(sun_sv)" unless @_ == 1;
+        unpack_sockaddr_un(@_);
+    } else {
+	croak "usage:   sun_sv = sockaddr_un(filename)" unless @_ == 1;
+        pack_sockaddr_un(@_);
+    }
+}
+
+sub INADDR_ANY 		();
+sub INADDR_BROADCAST	();
+sub INADDR_LOOPBACK	();
+sub INADDR_LOOPBACK	();
+
+sub AF_802		();
+sub AF_APPLETALK	();
+sub AF_CCITT		();
+sub AF_CHAOS		();
+sub AF_DATAKIT		();
+sub AF_DECnet		();
+sub AF_DLI		();
+sub AF_ECMA		();
+sub AF_GOSIP		();
+sub AF_HYLINK		();
+sub AF_IMPLINK		();
+sub AF_INET		();
+sub AF_LAT		();
+sub AF_MAX		();
+sub AF_NBS		();
+sub AF_NIT		();
+sub AF_NS		();
+sub AF_OSI		();
+sub AF_OSINET		();
+sub AF_PUP		();
+sub AF_SNA		();
+sub AF_UNIX		();
+sub AF_UNSPEC		();
+sub AF_X25		();
+sub IOV_MAX		();
+sub MSG_BCAST		();
+sub MSG_CTLFLAGS	();
+sub MSG_CTLIGNORE	();
+sub MSG_CTRUNC		();
+sub MSG_DONTROUTE	();
+sub MSG_DONTWAIT	();
+sub MSG_EOF		();
+sub MSG_EOR		();
+sub MSG_ERRQUEUE	();
+sub MSG_FIN		();
+sub MSG_MAXIOVLEN	();
+sub MSG_MCAST		();
+sub MSG_NOSIGNAL	();
+sub MSG_OOB		();
+sub MSG_PEEK		();
+sub MSG_PROXY		();
+sub MSG_RST		();
+sub MSG_SYN		();
+sub MSG_TRUNC		();
+sub MSG_URG		();
+sub MSG_WAITALL		();
+sub PF_802		();
+sub PF_APPLETALK	();
+sub PF_CCITT		();
+sub PF_CHAOS		();
+sub PF_DATAKIT		();
+sub PF_DECnet		();
+sub PF_DLI		();
+sub PF_ECMA		();
+sub PF_GOSIP		();
+sub PF_HYLINK		();
+sub PF_IMPLINK		();
+sub PF_INET		();
+sub PF_LAT		();
+sub PF_MAX		();
+sub PF_NBS		();
+sub PF_NIT		();
+sub PF_NS		();
+sub PF_OSI		();
+sub PF_OSINET		();
+sub PF_PUP		();
+sub PF_SNA		();
+sub PF_UNIX		();
+sub PF_UNSPEC		();
+sub PF_X25		();
+sub SCM_CONNECT		();
+sub SCM_CREDENTIALS	();
+sub SCM_CREDS		();
+sub SCM_RIGHTS		();
+sub SCM_TIMESTAMP	();
+sub SHUT_RD		();
+sub SHUT_RDWR		();
+sub SHUT_WR		();
+sub SOCK_DGRAM		();
+sub SOCK_RAW		();
+sub SOCK_RDM		();
+sub SOCK_SEQPACKET	();
+sub SOCK_STREAM		();
+sub SOL_SOCKET		();
+sub SOMAXCONN		();
+sub SO_ACCEPTCONN	();
+sub SO_BROADCAST	();
+sub SO_DEBUG		();
+sub SO_DONTLINGER	();
+sub SO_DONTROUTE	();
+sub SO_ERROR		();
+sub SO_KEEPALIVE	();
+sub SO_LINGER		();
+sub SO_OOBINLINE	();
+sub SO_RCVBUF		();
+sub SO_RCVLOWAT		();
+sub SO_RCVTIMEO		();
+sub SO_REUSEADDR	();
+sub SO_SNDBUF		();
+sub SO_SNDLOWAT		();
+sub SO_SNDTIMEO		();
+sub SO_TYPE		();
+sub SO_USELOOPBACK	();
+sub UIO_MAXIOV		();
+
+sub AUTOLOAD {
+    my($constname);
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+    my $val = constant($constname, @_ ? $_[0] : 0);
+    if ($! != 0) {
+	my ($pack,$file,$line) = caller;
+	croak "Your vendor has not defined Socket macro $constname, used";
+    }
+    eval "sub $AUTOLOAD () { $val }";
+    goto &$AUTOLOAD;
+}
+
+XSLoader::load 'Socket', $VERSION;
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Symbol.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Symbol.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Symbol.pm	(revision 14265)
@@ -0,0 +1,146 @@
+package Symbol;
+
+=head1 NAME
+
+Symbol - manipulate Perl symbols and their names
+
+=head1 SYNOPSIS
+
+    use Symbol;
+
+    $sym = gensym;
+    open($sym, "filename");
+    $_ = <$sym>;
+    # etc.
+
+    ungensym $sym;      # no effect
+
+    print qualify("x"), "\n";              # "Test::x"
+    print qualify("x", "FOO"), "\n"        # "FOO::x"
+    print qualify("BAR::x"), "\n";         # "BAR::x"
+    print qualify("BAR::x", "FOO"), "\n";  # "BAR::x"
+    print qualify("STDOUT", "FOO"), "\n";  # "main::STDOUT" (global)
+    print qualify(\*x), "\n";              # returns \*x
+    print qualify(\*x, "FOO"), "\n";       # returns \*x
+
+    use strict refs;
+    print { qualify_to_ref $fh } "foo!\n";
+    $ref = qualify_to_ref $name, $pkg;
+
+    use Symbol qw(delete_package);
+    delete_package('Foo::Bar');
+    print "deleted\n" unless exists $Foo::{'Bar::'};
+
+
+=head1 DESCRIPTION
+
+C<Symbol::gensym> creates an anonymous glob and returns a reference
+to it.  Such a glob reference can be used as a file or directory
+handle.
+
+For backward compatibility with older implementations that didn't
+support anonymous globs, C<Symbol::ungensym> is also provided.
+But it doesn't do anything.
+
+C<Symbol::qualify> turns unqualified symbol names into qualified
+variable names (e.g. "myvar" -E<gt> "MyPackage::myvar").  If it is given a
+second parameter, C<qualify> uses it as the default package;
+otherwise, it uses the package of its caller.  Regardless, global
+variable names (e.g. "STDOUT", "ENV", "SIG") are always qualified with
+"main::".
+
+Qualification applies only to symbol names (strings).  References are
+left unchanged under the assumption that they are glob references,
+which are qualified by their nature.
+
+C<Symbol::qualify_to_ref> is just like C<Symbol::qualify> except that it
+returns a glob ref rather than a symbol name, so you can use the result
+even if C<use strict 'refs'> is in effect.
+
+C<Symbol::delete_package> wipes out a whole package namespace.  Note
+this routine is not exported by default--you may want to import it
+explicitly.
+
+=cut
+
+BEGIN { require 5.002; }
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(gensym ungensym qualify qualify_to_ref);
+@EXPORT_OK = qw(delete_package);
+
+$VERSION = 1.02;
+
+my $genpkg = "Symbol::";
+my $genseq = 0;
+
+my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT);
+
+#
+# Note that we never _copy_ the glob; we just make a ref to it.
+# If we did copy it, then SVf_FAKE would be set on the copy, and
+# glob-specific behaviors (e.g. C<*$ref = \&func>) wouldn't work.
+#
+sub gensym () {
+    my $name = "GEN" . $genseq++;
+    my $ref = \*{$genpkg . $name};
+    delete $$genpkg{$name};
+    $ref;
+}
+
+sub ungensym ($) {}
+
+sub qualify ($;$) {
+    my ($name) = @_;
+    if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
+	my $pkg;
+	# Global names: special character, "^x", or other. 
+	if ($name =~ /^([^a-z])|(\^[a-z])$/i || $global{$name}) {
+	    $pkg = "main";
+	}
+	else {
+	    $pkg = (@_ > 1) ? $_[1] : caller;
+	}
+	$name = $pkg . "::" . $name;
+    }
+    $name;
+}
+
+sub qualify_to_ref ($;$) {
+    return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller };
+}
+
+#
+# of Safe.pm lineage
+#
+sub delete_package ($) {
+    my $pkg = shift;
+
+    # expand to full symbol table name if needed
+
+    unless ($pkg =~ /^main::.*::$/) {
+        $pkg = "main$pkg"	if	$pkg =~ /^::/;
+        $pkg = "main::$pkg"	unless	$pkg =~ /^main::/;
+        $pkg .= '::'		unless	$pkg =~ /::$/;
+    }
+
+    my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
+    my $stem_symtab = *{$stem}{HASH};
+    return unless defined $stem_symtab and exists $stem_symtab->{$leaf};
+
+
+    # free all the symbols in the package
+
+    my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
+    foreach my $name (keys %$leaf_symtab) {
+        undef *{$pkg . $name};
+    }
+
+    # delete the symbol table
+
+    %$leaf_symtab = ();
+    delete $stem_symtab->{$leaf};
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Test.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Test.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Test.pm	(revision 14265)
@@ -0,0 +1,262 @@
+use strict;
+package Test;
+use Test::Harness 1.1601 ();
+use Carp;
+our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $ntest, $TestLevel); #public-ish
+our($TESTOUT, $ONFAIL, %todo, %history, $planned, @FAILDETAIL); #private-ish
+$VERSION = '1.15';
+require Exporter;
+@ISA=('Exporter');
+@EXPORT=qw(&plan &ok &skip);
+@EXPORT_OK=qw($ntest $TESTOUT);
+
+$TestLevel = 0;		# how many extra stack frames to skip
+$|=1;
+#$^W=1;  ?
+$ntest=1;
+$TESTOUT = *STDOUT{IO};
+
+# Use of this variable is strongly discouraged.  It is set mainly to
+# help test coverage analyzers know which test is running.
+$ENV{REGRESSION_TEST} = $0;
+
+sub plan {
+    croak "Test::plan(%args): odd number of arguments" if @_ & 1;
+    croak "Test::plan(): should not be called more than once" if $planned;
+    my $max=0;
+    for (my $x=0; $x < @_; $x+=2) {
+	my ($k,$v) = @_[$x,$x+1];
+	if ($k =~ /^test(s)?$/) { $max = $v; }
+	elsif ($k eq 'todo' or 
+	       $k eq 'failok') { for (@$v) { $todo{$_}=1; }; }
+	elsif ($k eq 'onfail') { 
+	    ref $v eq 'CODE' or croak "Test::plan(onfail => $v): must be CODE";
+	    $ONFAIL = $v; 
+	}
+	else { carp "Test::plan(): skipping unrecognized directive '$k'" }
+    }
+    my @todo = sort { $a <=> $b } keys %todo;
+    if (@todo) {
+	print $TESTOUT "1..$max todo ".join(' ', @todo).";\n";
+    } else {
+	print $TESTOUT "1..$max\n";
+    }
+    ++$planned;
+}
+
+sub to_value {
+    my ($v) = @_;
+    (ref $v or '') eq 'CODE' ? $v->() : $v;
+}
+
+sub ok ($;$$) {
+    croak "ok: plan before you test!" if !$planned;
+    my ($pkg,$file,$line) = caller($TestLevel);
+    my $repetition = ++$history{"$file:$line"};
+    my $context = ("$file at line $line".
+		   ($repetition > 1 ? " fail \#$repetition" : ''));
+    my $ok=0;
+    my $result = to_value(shift);
+    my ($expected,$diag);
+    if (@_ == 0) {
+	$ok = $result;
+    } else {
+	$expected = to_value(shift);
+	my ($regex,$ignore);
+	if (!defined $expected) {
+	    $ok = !defined $result;
+	} elsif (!defined $result) {
+	    $ok = 0;
+	} elsif ((ref($expected)||'') eq 'Regexp') {
+	    $ok = $result =~ /$expected/;
+	} elsif (($regex) = ($expected =~ m,^ / (.+) / $,sx) or
+	    ($ignore, $regex) = ($expected =~ m,^ m([^\w\s]) (.+) \1 $,sx)) {
+	    $ok = $result =~ /$regex/;
+	} else {
+	    $ok = $result eq $expected;
+	}
+    }
+    my $todo = $todo{$ntest};
+    if ($todo and $ok) {
+	$context .= ' TODO?!' if $todo;
+	print $TESTOUT "ok $ntest # ($context)\n";
+    } else {
+	# Issuing two separate print()s causes severe trouble with 
+	# Test::Harness on VMS.  The "not "'s for failed tests occur
+	# on a separate line and would not get counted as failures.
+	#print $TESTOUT "not " if !$ok;
+	#print $TESTOUT "ok $ntest\n";
+	# Replace with a single print() as a workaround:
+	my $okline = '';
+	$okline = "not " if !$ok;
+	$okline .= "ok $ntest\n";
+	print $TESTOUT $okline;
+	
+	if (!$ok) {
+	    my $detail = { 'repetition' => $repetition, 'package' => $pkg,
+			   'result' => $result, 'todo' => $todo };
+	    $$detail{expected} = $expected if defined $expected;
+	    $diag = $$detail{diagnostic} = to_value(shift) if @_;
+	    $context .= ' *TODO*' if $todo;
+	    if (!defined $expected) {
+		if (!$diag) {
+		    print $TESTOUT "# Failed test $ntest in $context\n";
+		} else {
+		    print $TESTOUT "# Failed test $ntest in $context: $diag\n";
+		}
+	    } else {
+		my $prefix = "Test $ntest";
+		print $TESTOUT "# $prefix got: ".
+		    (defined $result? "'$result'":'<UNDEF>')." ($context)\n";
+		$prefix = ' ' x (length($prefix) - 5);
+		if ((ref($expected)||'') eq 'Regexp') {
+		    $expected = 'qr/'.$expected.'/'
+		} else {
+		    $expected = "'$expected'";
+		}
+		if (!$diag) {
+		    print $TESTOUT "# $prefix Expected: $expected\n";
+		} else {
+		    print $TESTOUT "# $prefix Expected: $expected ($diag)\n";
+		}
+	    }
+	    push @FAILDETAIL, $detail;
+	}
+    }
+    ++ $ntest;
+    $ok;
+}
+
+sub skip ($$;$$) {
+    my $whyskip = to_value(shift);
+    if ($whyskip) {
+	$whyskip = 'skip' if $whyskip =~ m/^\d+$/;
+	print $TESTOUT "ok $ntest # $whyskip\n";
+	++ $ntest;
+	1;
+    } else {
+	local($TestLevel) = $TestLevel+1;  #ignore this stack frame
+	&ok;
+    }
+}
+
+END {
+    $ONFAIL->(\@FAILDETAIL) if @FAILDETAIL && $ONFAIL;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+  Test - provides a simple framework for writing test scripts
+
+=head1 SYNOPSIS
+
+  use strict;
+  use Test;
+
+  # use a BEGIN block so we print our plan before MyModule is loaded
+  BEGIN { plan tests => 14, todo => [3,4] }
+
+  # load your module...
+  use MyModule;
+
+  ok(0); # failure
+  ok(1); # success
+
+  ok(0); # ok, expected failure (see todo list, above)
+  ok(1); # surprise success!
+
+  ok(0,1);             # failure: '0' ne '1'
+  ok('broke','fixed'); # failure: 'broke' ne 'fixed'
+  ok('fixed','fixed'); # success: 'fixed' eq 'fixed'
+  ok('fixed',qr/x/);   # success: 'fixed' =~ qr/x/
+
+  ok(sub { 1+1 }, 2);  # success: '2' eq '2'
+  ok(sub { 1+1 }, 3);  # failure: '2' ne '3'
+  ok(0, int(rand(2));  # (just kidding :-)
+
+  my @list = (0,0);
+  ok @list, 3, "\@list=".join(',',@list);      #extra diagnostics
+  ok 'segmentation fault', '/(?i)success/';    #regex match
+
+  skip($feature_is_missing, ...);    #do platform specific test
+
+=head1 DESCRIPTION
+
+L<Test::Harness|Test::Harness> expects to see particular output when it
+executes tests.  This module aims to make writing proper test scripts just
+a little bit easier (and less error prone :-).
+
+=head1 TEST TYPES
+
+=over 4
+
+=item * NORMAL TESTS
+
+These tests are expected to succeed.  If they don't something's
+screwed up!
+
+=item * SKIPPED TESTS
+
+Skip is for tests that might or might not be possible to run depending
+on the availability of platform specific features.  The first argument
+should evaluate to true (think "yes, please skip") if the required
+feature is not available.  After the first argument, skip works
+exactly the same way as do normal tests.
+
+=item * TODO TESTS
+
+TODO tests are designed for maintaining an B<executable TODO list>.
+These tests are expected NOT to succeed.  If a TODO test does succeed,
+the feature in question should not be on the TODO list, now should it?
+
+Packages should NOT be released with succeeding TODO tests.  As soon
+as a TODO test starts working, it should be promoted to a normal test
+and the newly working feature should be documented in the release
+notes or change log.
+
+=back
+
+=head1 RETURN VALUE
+
+Both C<ok> and C<skip> return true if their test succeeds and false
+otherwise in a scalar context.
+
+=head1 ONFAIL
+
+  BEGIN { plan test => 4, onfail => sub { warn "CALL 911!" } }
+
+While test failures should be enough, extra diagnostics can be
+triggered at the end of a test run.  C<onfail> is passed an array ref
+of hash refs that describe each test failure.  Each hash will contain
+at least the following fields: C<package>, C<repetition>, and
+C<result>.  (The file, line, and test number are not included because
+their correspondence to a particular test is tenuous.)  If the test
+had an expected value or a diagnostic string, these will also be
+included.
+
+The B<optional> C<onfail> hook might be used simply to print out the
+version of your package and/or how to report problems.  It might also
+be used to generate extremely sophisticated diagnostics for a
+particularly bizarre test failure.  However it's not a panacea.  Core
+dumps or other unrecoverable errors prevent the C<onfail> hook from
+running.  (It is run inside an C<END> block.)  Besides, C<onfail> is
+probably over-kill in most cases.  (Your test code should be simpler
+than the code it is testing, yes?)
+
+=head1 SEE ALSO
+
+L<Test::Harness> and, perhaps, test coverage analysis tools.
+
+=head1 AUTHOR
+
+Copyright (c) 1998-1999 Joshua Nathaniel Pritikin.  All rights reserved.
+
+This package is free software and is provided "as is" without express
+or implied warranty.  It may be used, redistributed and/or modified
+under the terms of the Perl Artistic License (see
+http://www.perl.com/perl/misc/Artistic.html)
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/Thread.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Thread.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Thread.pm	(revision 14265)
@@ -0,0 +1,225 @@
+package Thread;
+require Exporter;
+use XSLoader ();
+our($VERSION, @ISA, @EXPORT);
+
+$VERSION = "1.0";
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(yield cond_signal cond_broadcast cond_wait async);
+
+=head1 NAME
+
+Thread - manipulate threads in Perl (EXPERIMENTAL, subject to change)
+
+=head1 CAVEAT
+
+The Thread extension requires Perl to be built in a particular way to
+enable the older 5.005 threading model.  Just to confuse matters, there
+is an alternate threading model known as "ithreads" that does NOT
+support this extension.  If you are using a binary distribution such
+as ActivePerl that is built with ithreads support, this extension CANNOT
+be used.
+
+=head1 SYNOPSIS
+
+    use Thread;
+
+    my $t = new Thread \&start_sub, @start_args;
+
+    $result = $t->join;
+    $result = $t->eval;
+    $t->detach;
+
+    if($t->equal($another_thread)) {
+    	# ...
+    }
+
+    my $tid = Thread->self->tid; 
+    my $tlist = Thread->list;
+
+    lock($scalar);
+    yield();
+
+    use Thread 'async';
+
+=head1 DESCRIPTION
+
+    WARNING: Threading is an experimental feature.  Both the interface
+    and implementation are subject to change drastically.  In fact, this
+    documentation describes the flavor of threads that was in version
+    5.005.  Perl 5.6.0 and later have the beginnings of support for
+    interpreter threads, which (when finished) is expected to be
+    significantly different from what is described here.  The information
+    contained here may therefore soon be obsolete.  Use at your own risk!
+
+The C<Thread> module provides multithreading support for perl.
+
+=head1 FUNCTIONS
+
+=over 8
+
+=item new \&start_sub
+
+=item new \&start_sub, LIST
+
+C<new> starts a new thread of execution in the referenced subroutine. The
+optional list is passed as parameters to the subroutine. Execution
+continues in both the subroutine and the code after the C<new> call.
+
+C<new Thread> returns a thread object representing the newly created
+thread.
+
+=item lock VARIABLE
+
+C<lock> places a lock on a variable until the lock goes out of scope.  If
+the variable is locked by another thread, the C<lock> call will block until
+it's available. C<lock> is recursive, so multiple calls to C<lock> are
+safe--the variable will remain locked until the outermost lock on the
+variable goes out of scope.
+
+Locks on variables only affect C<lock> calls--they do I<not> affect normal
+access to a variable. (Locks on subs are different, and covered in a bit)
+If you really, I<really> want locks to block access, then go ahead and tie
+them to something and manage this yourself. This is done on purpose. While
+managing access to variables is a good thing, perl doesn't force you out of
+its living room...
+
+If a container object, such as a hash or array, is locked, all the elements
+of that container are not locked. For example, if a thread does a C<lock
+@a>, any other thread doing a C<lock($a[12])> won't block.
+
+You may also C<lock> a sub, using C<lock &sub>. Any calls to that sub from
+another thread will block until the lock is released. This behaviour is not
+equivalent to declaring the sub with the C<locked> attribute.  The C<locked>
+attribute serializes access to a subroutine, but allows different threads
+non-simultaneous access. C<lock &sub>, on the other hand, will not allow
+I<any> other thread access for the duration of the lock.
+
+Finally, C<lock> will traverse up references exactly I<one> level.
+C<lock(\$a)> is equivalent to C<lock($a)>, while C<lock(\\$a)> is not.
+
+=item async BLOCK;
+
+C<async> creates a thread to execute the block immediately following
+it. This block is treated as an anonymous sub, and so must have a
+semi-colon after the closing brace. Like C<new Thread>, C<async> returns a
+thread object.
+
+=item Thread->self
+
+The C<Thread-E<gt>self> function returns a thread object that represents
+the thread making the C<Thread-E<gt>self> call.
+
+=item Thread->list
+
+C<Thread-E<gt>list> returns a list of thread objects for all running and
+finished but un-C<join>ed threads.
+
+=item cond_wait VARIABLE
+
+The C<cond_wait> function takes a B<locked> variable as a parameter,
+unlocks the variable, and blocks until another thread does a C<cond_signal>
+or C<cond_broadcast> for that same locked variable. The variable that
+C<cond_wait> blocked on is relocked after the C<cond_wait> is satisfied.
+If there are multiple threads C<cond_wait>ing on the same variable, all but
+one will reblock waiting to reaquire the lock on the variable. (So if
+you're only using C<cond_wait> for synchronization, give up the lock as
+soon as possible)
+
+=item cond_signal VARIABLE
+
+The C<cond_signal> function takes a locked variable as a parameter and
+unblocks one thread that's C<cond_wait>ing on that variable. If more than
+one thread is blocked in a C<cond_wait> on that variable, only one (and
+which one is indeterminate) will be unblocked.
+
+If there are no threads blocked in a C<cond_wait> on the variable, the
+signal is discarded.
+
+=item cond_broadcast VARIABLE
+
+The C<cond_broadcast> function works similarly to C<cond_signal>.
+C<cond_broadcast>, though, will unblock B<all> the threads that are blocked
+in a C<cond_wait> on the locked variable, rather than only one.
+
+=item yield
+
+The C<yield> function allows another thread to take control of the
+CPU. The exact results are implementation-dependent.
+
+=back
+
+=head1 METHODS
+
+=over 8
+
+=item join
+
+C<join> waits for a thread to end and returns any values the thread exited
+with. C<join> will block until the thread has ended, though it won't block
+if the thread has already terminated.
+
+If the thread being C<join>ed C<die>d, the error it died with will be
+returned at this time. If you don't want the thread performing the C<join>
+to die as well, you should either wrap the C<join> in an C<eval> or use the
+C<eval> thread method instead of C<join>.
+
+=item eval
+
+The C<eval> method wraps an C<eval> around a C<join>, and so waits for a
+thread to exit, passing along any values the thread might have returned.
+Errors, of course, get placed into C<$@>.
+
+=item detach
+
+C<detach> tells a thread that it is never going to be joined i.e.
+that all traces of its existence can be removed once it stops running.
+Errors in detached threads will not be visible anywhere - if you want
+to catch them, you should use $SIG{__DIE__} or something like that.
+
+=item equal 
+
+C<equal> tests whether two thread objects represent the same thread and
+returns true if they do.
+
+=item tid
+
+The C<tid> method returns the tid of a thread. The tid is a monotonically
+increasing integer assigned when a thread is created. The main thread of a
+program will have a tid of zero, while subsequent threads will have tids
+assigned starting with one.
+
+=back
+
+=head1 LIMITATIONS
+
+The sequence number used to assign tids is a simple integer, and no
+checking is done to make sure the tid isn't currently in use. If a program
+creates more than 2^32 - 1 threads in a single run, threads may be assigned
+duplicate tids. This limitation may be lifted in a future version of Perl.
+
+=head1 SEE ALSO
+
+L<attributes>, L<Thread::Queue>, L<Thread::Semaphore>, L<Thread::Specific>.
+
+=cut
+
+#
+# Methods
+#
+
+#
+# Exported functions
+#
+sub async (&) {
+    return new Thread $_[0];
+}
+
+sub eval {
+    return eval { shift->join; };
+}
+
+XSLoader::load 'Thread';
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Tie/Array.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Tie/Array.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Tie/Array.pm	(revision 14265)
@@ -0,0 +1,288 @@
+package Tie::Array;
+
+use 5.005_64;
+use strict;
+use Carp;
+our $VERSION = '1.01';
+
+# Pod documentation after __END__ below.
+
+sub DESTROY { }
+sub EXTEND  { }
+sub UNSHIFT { scalar shift->SPLICE(0,0,@_) }
+sub SHIFT { shift->SPLICE(0,1) }
+#sub SHIFT   { (shift->SPLICE(0,1))[0] }
+sub CLEAR   { shift->STORESIZE(0) }
+
+sub PUSH
+{
+ my $obj = shift;
+ my $i   = $obj->FETCHSIZE;
+ $obj->STORE($i++, shift) while (@_);
+}
+
+sub POP
+{
+ my $obj = shift;
+ my $newsize = $obj->FETCHSIZE - 1;
+ my $val;
+ if ($newsize >= 0)
+  {
+   $val = $obj->FETCH($newsize);
+   $obj->STORESIZE($newsize);
+  }
+ $val;
+}
+
+sub SPLICE {
+    my $obj = shift;
+    my $sz  = $obj->FETCHSIZE;
+    my $off = (@_) ? shift : 0;
+    $off += $sz if ($off < 0);
+    my $len = (@_) ? shift : $sz - $off;
+    $len += $sz - $off if $len < 0;
+    my @result;
+    for (my $i = 0; $i < $len; $i++) {
+        push(@result,$obj->FETCH($off+$i));
+    }
+    $off = $sz if $off > $sz;
+    $len -= $off + $len - $sz if $off + $len > $sz;
+    if (@_ > $len) {
+        # Move items up to make room
+        my $d = @_ - $len;
+        my $e = $off+$len;
+        $obj->EXTEND($sz+$d);
+        for (my $i=$sz-1; $i >= $e; $i--) {
+            my $val = $obj->FETCH($i);
+            $obj->STORE($i+$d,$val);
+        }
+    }
+    elsif (@_ < $len) {
+        # Move items down to close the gap
+        my $d = $len - @_;
+        my $e = $off+$len;
+        for (my $i=$off+$len; $i < $sz; $i++) {
+            my $val = $obj->FETCH($i);
+            $obj->STORE($i-$d,$val);
+        }
+        $obj->STORESIZE($sz-$d);
+    }
+    for (my $i=0; $i < @_; $i++) {
+        $obj->STORE($off+$i,$_[$i]);
+    }
+    return @result;
+}
+
+sub EXISTS {
+    my $pkg = ref $_[0];
+    croak "$pkg dosn't define an EXISTS method";
+}
+
+sub DELETE {
+    my $pkg = ref $_[0];
+    croak "$pkg dosn't define a DELETE method";
+}
+
+package Tie::StdArray;
+use vars qw(@ISA);
+@ISA = 'Tie::Array';
+
+sub TIEARRAY  { bless [], $_[0] }
+sub FETCHSIZE { scalar @{$_[0]} }
+sub STORESIZE { $#{$_[0]} = $_[1]-1 }
+sub STORE     { $_[0]->[$_[1]] = $_[2] }
+sub FETCH     { $_[0]->[$_[1]] }
+sub CLEAR     { @{$_[0]} = () }
+sub POP       { pop(@{$_[0]}) }
+sub PUSH      { my $o = shift; push(@$o,@_) }
+sub SHIFT     { shift(@{$_[0]}) }
+sub UNSHIFT   { my $o = shift; unshift(@$o,@_) }
+sub EXISTS    { exists $_[0]->[$_[1]] }
+sub DELETE    { delete $_[0]->[$_[1]] }
+
+sub SPLICE
+{
+ my $ob  = shift;
+ my $sz  = $ob->FETCHSIZE;
+ my $off = @_ ? shift : 0;
+ $off   += $sz if $off < 0;
+ my $len = @_ ? shift : $sz-$off;
+ return splice(@$ob,$off,$len,@_);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Tie::Array - base class for tied arrays
+
+=head1 SYNOPSIS
+
+    package NewArray;
+    use Tie::Array;
+    @ISA = ('Tie::Array');
+
+    # mandatory methods
+    sub TIEARRAY { ... }
+    sub FETCH { ... }
+    sub FETCHSIZE { ... }
+
+    sub STORE { ... }        # mandatory if elements writeable
+    sub STORESIZE { ... }    # mandatory if elements can be added/deleted
+    sub EXISTS { ... }       # mandatory if exists() expected to work
+    sub DELETE { ... }       # mandatory if delete() expected to work
+
+    # optional methods - for efficiency
+    sub CLEAR { ... }
+    sub PUSH { ... }
+    sub POP { ... }
+    sub SHIFT { ... }
+    sub UNSHIFT { ... }
+    sub SPLICE { ... }
+    sub EXTEND { ... }
+    sub DESTROY { ... }
+
+    package NewStdArray;
+    use Tie::Array;
+
+    @ISA = ('Tie::StdArray');
+
+    # all methods provided by default
+
+    package main;
+
+    $object = tie @somearray,Tie::NewArray;
+    $object = tie @somearray,Tie::StdArray;
+    $object = tie @somearray,Tie::NewStdArray;
+
+
+
+=head1 DESCRIPTION
+
+This module provides methods for array-tying classes. See
+L<perltie> for a list of the functions required in order to tie an array
+to a package. The basic B<Tie::Array> package provides stub C<DESTROY>,
+and C<EXTEND> methods that do nothing, stub C<DELETE> and C<EXISTS>
+methods that croak() if the delete() or exists() builtins are ever called
+on the tied array, and implementations of C<PUSH>, C<POP>, C<SHIFT>,
+C<UNSHIFT>, C<SPLICE> and C<CLEAR> in terms of basic C<FETCH>, C<STORE>,
+C<FETCHSIZE>, C<STORESIZE>.
+
+The B<Tie::StdArray> package provides efficient methods required for tied arrays
+which are implemented as blessed references to an "inner" perl array.
+It inherits from B<Tie::Array>, and should cause tied arrays to behave exactly
+like standard arrays, allowing for selective overloading of methods.
+
+For developers wishing to write their own tied arrays, the required methods
+are briefly defined below. See the L<perltie> section for more detailed
+descriptive, as well as example code:
+
+=over
+
+=item TIEARRAY classname, LIST
+
+The class method is invoked by the command C<tie @array, classname>. Associates
+an array instance with the specified class. C<LIST> would represent
+additional arguments (along the lines of L<AnyDBM_File> and compatriots) needed
+to complete the association. The method should return an object of a class which
+provides the methods below.
+
+=item STORE this, index, value
+
+Store datum I<value> into I<index> for the tied array associated with
+object I<this>. If this makes the array larger then
+class's mapping of C<undef> should be returned for new positions.
+
+=item FETCH this, index
+
+Retrieve the datum in I<index> for the tied array associated with
+object I<this>.
+
+=item FETCHSIZE this
+
+Returns the total number of items in the tied array associated with
+object I<this>. (Equivalent to C<scalar(@array)>).
+
+=item STORESIZE this, count
+
+Sets the total number of items in the tied array associated with
+object I<this> to be I<count>. If this makes the array larger then
+class's mapping of C<undef> should be returned for new positions.
+If the array becomes smaller then entries beyond count should be
+deleted.
+
+=item EXTEND this, count
+
+Informative call that array is likely to grow to have I<count> entries.
+Can be used to optimize allocation. This method need do nothing.
+
+=item EXISTS this, key
+
+Verify that the element at index I<key> exists in the tied array I<this>.
+
+The B<Tie::Array> implementation is a stub that simply croaks.
+
+=item DELETE this, key
+
+Delete the element at index I<key> from the tied array I<this>.
+
+The B<Tie::Array> implementation is a stub that simply croaks.
+
+=item CLEAR this
+
+Clear (remove, delete, ...) all values from the tied array associated with
+object I<this>.
+
+=item DESTROY this
+
+Normal object destructor method.
+
+=item PUSH this, LIST
+
+Append elements of LIST to the array.
+
+=item POP this
+
+Remove last element of the array and return it.
+
+=item SHIFT this
+
+Remove the first element of the array (shifting other elements down)
+and return it.
+
+=item UNSHIFT this, LIST
+
+Insert LIST elements at the beginning of the array, moving existing elements
+up to make room.
+
+=item SPLICE this, offset, length, LIST
+
+Perform the equivalent of C<splice> on the array.
+
+I<offset> is optional and defaults to zero, negative values count back
+from the end of the array.
+
+I<length> is optional and defaults to rest of the array.
+
+I<LIST> may be empty.
+
+Returns a list of the original I<length> elements at I<offset>.
+
+=back
+
+=head1 CAVEATS
+
+There is no support at present for tied @ISA. There is a potential conflict
+between magic entries needed to notice setting of @ISA, and those needed to
+implement 'tie'.
+
+Very little consideration has been given to the behaviour of tied arrays
+when C<$[> is not default value of zero.
+
+=head1 AUTHOR
+
+Nick Ing-Simmons E<lt>nik@tiuk.ti.comE<gt>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/Tie/Handle.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Tie/Handle.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Tie/Handle.pm	(revision 14265)
@@ -0,0 +1,234 @@
+package Tie::Handle;
+
+use 5.005_64;
+our $VERSION = '4.0';
+
+=head1 NAME
+
+Tie::Handle, Tie::StdHandle  - base class definitions for tied handles
+
+=head1 SYNOPSIS
+
+    package NewHandle;
+    require Tie::Handle;
+
+    @ISA = (Tie::Handle);
+
+    sub READ { ... }		# Provide a needed method
+    sub TIEHANDLE { ... }	# Overrides inherited method
+
+
+    package main;
+
+    tie *FH, 'NewHandle';
+
+=head1 DESCRIPTION
+
+This module provides some skeletal methods for handle-tying classes. See
+L<perltie> for a list of the functions required in tying a handle to a package.
+The basic B<Tie::Handle> package provides a C<new> method, as well as methods
+C<TIEHANDLE>, C<PRINT>, C<PRINTF> and C<GETC>. 
+
+For developers wishing to write their own tied-handle classes, the methods
+are summarized below. The L<perltie> section not only documents these, but
+has sample code as well:
+
+=over
+
+=item TIEHANDLE classname, LIST
+
+The method invoked by the command C<tie *glob, classname>. Associates a new
+glob instance with the specified class. C<LIST> would represent additional
+arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
+complete the association.
+
+=item WRITE this, scalar, length, offset
+
+Write I<length> bytes of data from I<scalar> starting at I<offset>.
+
+=item PRINT this, LIST
+
+Print the values in I<LIST>
+
+=item PRINTF this, format, LIST
+
+Print the values in I<LIST> using I<format>
+
+=item READ this, scalar, length, offset
+
+Read I<length> bytes of data into I<scalar> starting at I<offset>.
+
+=item READLINE this
+
+Read a single line
+
+=item GETC this
+
+Get a single character
+
+=item CLOSE this
+
+Close the handle
+
+=item OPEN this, filename
+
+(Re-)open the handle
+
+=item BINMODE this
+
+Specify content is binary
+
+=item EOF this
+
+Test for end of file.
+
+=item TELL this
+
+Return position in the file.
+
+=item SEEK this, offset, whence
+
+Position the file.
+
+Test for end of file.
+
+=item DESTROY this
+
+Free the storage associated with the tied handle referenced by I<this>.
+This is rarely needed, as Perl manages its memory quite well. But the
+option exists, should a class wish to perform specific actions upon the
+destruction of an instance.
+
+=back
+
+=head1 MORE INFORMATION
+
+The L<perltie> section contains an example of tying handles.
+
+=head1 COMPATIBILITY
+
+This version of Tie::Handle is neither related to nor compatible with
+the Tie::Handle (3.0) module available on CPAN. It was due to an
+accident that two modules with the same name appeared. The namespace
+clash has been cleared in favor of this module that comes with the
+perl core in September 2000 and accordingly the version number has
+been bumped up to 4.0.
+
+=cut
+
+use Carp;
+use warnings::register;
+
+sub new {
+    my $pkg = shift;
+    $pkg->TIEHANDLE(@_);
+}
+
+# "Grandfather" the new, a la Tie::Hash
+
+sub TIEHANDLE {
+    my $pkg = shift;
+    if (defined &{"{$pkg}::new"}) {
+	warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIEHANDLE is missing");
+	$pkg->new(@_);
+    }
+    else {
+	croak "$pkg doesn't define a TIEHANDLE method";
+    }
+}
+
+sub PRINT {
+    my $self = shift;
+    if($self->can('WRITE') != \&WRITE) {
+	my $buf = join(defined $, ? $, : "",@_);
+	$buf .= $\ if defined $\;
+	$self->WRITE($buf,length($buf),0);
+    }
+    else {
+	croak ref($self)," doesn't define a PRINT method";
+    }
+}
+
+sub PRINTF {
+    my $self = shift;
+    
+    if($self->can('WRITE') != \&WRITE) {
+	my $buf = sprintf(shift,@_);
+	$self->WRITE($buf,length($buf),0);
+    }
+    else {
+	croak ref($self)," doesn't define a PRINTF method";
+    }
+}
+
+sub READLINE {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a READLINE method";
+}
+
+sub GETC {
+    my $self = shift;
+    
+    if($self->can('READ') != \&READ) {
+	my $buf;
+	$self->READ($buf,1);
+	return $buf;
+    }
+    else {
+	croak ref($self)," doesn't define a GETC method";
+    }
+}
+
+sub READ {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a READ method";
+}
+
+sub WRITE {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a WRITE method";
+}
+
+sub CLOSE {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a CLOSE method";
+}
+
+package Tie::StdHandle; 
+our @ISA = 'Tie::Handle';
+use Carp;
+
+sub TIEHANDLE 
+{
+ my $class = shift;
+ my $fh    = do { \local *HANDLE};
+ bless $fh,$class;
+ $fh->OPEN(@_) if (@_);
+ return $fh;
+}
+
+sub EOF     { eof($_[0]) }
+sub TELL    { tell($_[0]) }
+sub FILENO  { fileno($_[0]) }
+sub SEEK    { seek($_[0],$_[1],$_[2]) }
+sub CLOSE   { close($_[0]) }
+sub BINMODE { binmode($_[0]) }
+
+sub OPEN
+{
+ $_[0]->CLOSE if defined($_[0]->FILENO);
+ @_ == 2 ? open($_[0], $_[1]) : open($_[0], $_[1], $_[2]);
+}
+
+sub READ     { read($_[0],$_[1],$_[2]) }
+sub READLINE { my $fh = $_[0]; <$fh> }
+sub GETC     { getc($_[0]) }
+
+sub WRITE
+{
+ my $fh = $_[0];
+ print $fh substr($_[1],0,$_[2])
+}
+
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Tie/Hash.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Tie/Hash.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Tie/Hash.pm	(revision 14265)
@@ -0,0 +1,160 @@
+package Tie::Hash;
+
+=head1 NAME
+
+Tie::Hash, Tie::StdHash - base class definitions for tied hashes
+
+=head1 SYNOPSIS
+
+    package NewHash;
+    require Tie::Hash;
+    
+    @ISA = (Tie::Hash);
+    
+    sub DELETE { ... }		# Provides needed method
+    sub CLEAR { ... }		# Overrides inherited method
+    
+    
+    package NewStdHash;
+    require Tie::Hash;
+    
+    @ISA = (Tie::StdHash);
+    
+    # All methods provided by default, define only those needing overrides
+    sub DELETE { ... }
+    
+    
+    package main;
+    
+    tie %new_hash, 'NewHash';
+    tie %new_std_hash, 'NewStdHash';
+
+=head1 DESCRIPTION
+
+This module provides some skeletal methods for hash-tying classes. See
+L<perltie> for a list of the functions required in order to tie a hash
+to a package. The basic B<Tie::Hash> package provides a C<new> method, as well
+as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<Tie::StdHash> package
+provides most methods required for hashes in L<perltie>. It inherits from
+B<Tie::Hash>, and causes tied hashes to behave exactly like standard hashes,
+allowing for selective overloading of methods. The C<new> method is provided
+as grandfathering in the case a class forgets to include a C<TIEHASH> method.
+
+For developers wishing to write their own tied hashes, the required methods
+are briefly defined below. See the L<perltie> section for more detailed
+descriptive, as well as example code:
+
+=over
+
+=item TIEHASH classname, LIST
+
+The method invoked by the command C<tie %hash, classname>. Associates a new
+hash instance with the specified class. C<LIST> would represent additional
+arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
+complete the association.
+
+=item STORE this, key, value
+
+Store datum I<value> into I<key> for the tied hash I<this>.
+
+=item FETCH this, key
+
+Retrieve the datum in I<key> for the tied hash I<this>.
+
+=item FIRSTKEY this
+
+Return the (key, value) pair for the first key in the hash.
+
+=item NEXTKEY this, lastkey
+
+Return the next key for the hash.
+
+=item EXISTS this, key
+
+Verify that I<key> exists with the tied hash I<this>.
+
+The B<Tie::Hash> implementation is a stub that simply croaks.
+
+=item DELETE this, key
+
+Delete the key I<key> from the tied hash I<this>.
+
+=item CLEAR this
+
+Clear all values from the tied hash I<this>.
+
+=back
+
+=head1 CAVEATS
+
+The L<perltie> documentation includes a method called C<DESTROY> as
+a necessary method for tied hashes. Neither B<Tie::Hash> nor B<Tie::StdHash>
+define a default for this method. This is a standard for class packages,
+but may be omitted in favor of a simple default.
+
+=head1 MORE INFORMATION
+
+The packages relating to various DBM-related implementations (F<DB_File>,
+F<NDBM_File>, etc.) show examples of general tied hashes, as does the
+L<Config> module. While these do not utilize B<Tie::Hash>, they serve as
+good working examples.
+
+=cut
+
+use Carp;
+use warnings::register;
+
+sub new {
+    my $pkg = shift;
+    $pkg->TIEHASH(@_);
+}
+
+# Grandfather "new"
+
+sub TIEHASH {
+    my $pkg = shift;
+    if (defined &{"${pkg}::new"}) {
+	warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing");
+	$pkg->new(@_);
+    }
+    else {
+	croak "$pkg doesn't define a TIEHASH method";
+    }
+}
+
+sub EXISTS {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define an EXISTS method";
+}
+
+sub CLEAR {
+    my $self = shift;
+    my $key = $self->FIRSTKEY(@_);
+    my @keys;
+
+    while (defined $key) {
+	push @keys, $key;
+	$key = $self->NEXTKEY(@_, $key);
+    }
+    foreach $key (@keys) {
+	$self->DELETE(@_, $key);
+    }
+}
+
+# The Tie::StdHash package implements standard perl hash behaviour.
+# It exists to act as a base class for classes which only wish to
+# alter some parts of their behaviour.
+
+package Tie::StdHash;
+@ISA = qw(Tie::Hash);
+
+sub TIEHASH  { bless {}, $_[0] }
+sub STORE    { $_[0]->{$_[1]} = $_[2] }
+sub FETCH    { $_[0]->{$_[1]} }
+sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
+sub NEXTKEY  { each %{$_[0]} }
+sub EXISTS   { exists $_[0]->{$_[1]} }
+sub DELETE   { delete $_[0]->{$_[1]} }
+sub CLEAR    { %{$_[0]} = () }
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Tie/RefHash.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Tie/RefHash.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Tie/RefHash.pm	(revision 14265)
@@ -0,0 +1,162 @@
+package Tie::RefHash;
+
+=head1 NAME
+
+Tie::RefHash - use references as hash keys
+
+=head1 SYNOPSIS
+
+    require 5.004;
+    use Tie::RefHash;
+    tie HASHVARIABLE, 'Tie::RefHash', LIST;
+    tie HASHVARIABLE, 'Tie::RefHash::Nestable', LIST;
+
+    untie HASHVARIABLE;
+
+=head1 DESCRIPTION
+
+This module provides the ability to use references as hash keys if you
+first C<tie> the hash variable to this module.  Normally, only the
+keys of the tied hash itself are preserved as references; to use
+references as keys in hashes-of-hashes, use Tie::RefHash::Nestable,
+included as part of Tie::RefHash.
+
+It is implemented using the standard perl TIEHASH interface.  Please
+see the C<tie> entry in perlfunc(1) and perltie(1) for more information.
+
+The Nestable version works by looking for hash references being stored
+and converting them to tied hashes so that they too can have
+references as keys.  This will happen without warning whenever you
+store a reference to one of your own hashes in the tied hash.
+
+=head1 EXAMPLE
+
+    use Tie::RefHash;
+    tie %h, 'Tie::RefHash';
+    $a = [];
+    $b = {};
+    $c = \*main;
+    $d = \"gunk";
+    $e = sub { 'foo' };
+    %h = ($a => 1, $b => 2, $c => 3, $d => 4, $e => 5);
+    $a->[0] = 'foo';
+    $b->{foo} = 'bar';
+    for (keys %h) {
+       print ref($_), "\n";
+    }
+
+    tie %h, 'Tie::RefHash::Nestable';
+    $h{$a}->{$b} = 1;
+    for (keys %h, keys %{$h{$a}}) {
+       print ref($_), "\n";
+    }
+
+=head1 AUTHOR
+
+Gurusamy Sarathy        gsar@activestate.com
+
+=head1 VERSION
+
+Version 1.3    8 Apr 2001
+
+=head1 SEE ALSO
+
+perl(1), perlfunc(1), perltie(1)
+
+=cut
+
+use v5.6.0;
+use Tie::Hash;
+use strict;
+
+our @ISA = qw(Tie::Hash);
+our $VERSION = '1.3';
+
+sub TIEHASH {
+  my $c = shift;
+  my $s = [];
+  bless $s, $c;
+  while (@_) {
+    $s->STORE(shift, shift);
+  }
+  return $s;
+}
+
+sub FETCH {
+  my($s, $k) = @_;
+  if (ref $k) {
+      if (defined $s->[0]{"$k"}) {
+        $s->[0]{"$k"}[1];
+      }
+      else {
+        undef;
+      }
+  }
+  else {
+      $s->[1]{$k};
+  }
+}
+
+sub STORE {
+  my($s, $k, $v) = @_;
+  if (ref $k) {
+    $s->[0]{"$k"} = [$k, $v];
+  }
+  else {
+    $s->[1]{$k} = $v;
+  }
+  $v;
+}
+
+sub DELETE {
+  my($s, $k) = @_;
+  (ref $k) ? delete($s->[0]{"$k"}) : delete($s->[1]{$k});
+}
+
+sub EXISTS {
+  my($s, $k) = @_;
+  (ref $k) ? exists($s->[0]{"$k"}) : exists($s->[1]{$k});
+}
+
+sub FIRSTKEY {
+  my $s = shift;
+  keys %{$s->[0]};	# reset iterator
+  keys %{$s->[1]};	# reset iterator
+  $s->[2] = 0;
+  $s->NEXTKEY;
+}
+
+sub NEXTKEY {
+  my $s = shift;
+  my ($k, $v);
+  if (!$s->[2]) {
+    if (($k, $v) = each %{$s->[0]}) {
+      return $s->[0]{"$k"}[0];
+    }
+    else {
+      $s->[2] = 1;
+    }
+  }
+  return each %{$s->[1]};
+}
+
+sub CLEAR {
+  my $s = shift;
+  $s->[2] = 0;
+  %{$s->[0]} = ();
+  %{$s->[1]} = ();
+}
+
+package Tie::RefHash::Nestable;
+our @ISA = qw(Tie::RefHash);
+
+sub STORE {
+  my($s, $k, $v) = @_;
+  if (ref($v) eq 'HASH' and not tied %$v) {
+      my @elems = %$v;
+      tie %$v, ref($s), @elems;
+  }
+  $s->SUPER::STORE($k, $v);
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Tie/Scalar.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Tie/Scalar.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Tie/Scalar.pm	(revision 14265)
@@ -0,0 +1,138 @@
+package Tie::Scalar;
+
+=head1 NAME
+
+Tie::Scalar, Tie::StdScalar - base class definitions for tied scalars
+
+=head1 SYNOPSIS
+
+    package NewScalar;
+    require Tie::Scalar;
+
+    @ISA = (Tie::Scalar);
+
+    sub FETCH { ... }		# Provide a needed method
+    sub TIESCALAR { ... }	# Overrides inherited method
+
+
+    package NewStdScalar;
+    require Tie::Scalar;
+
+    @ISA = (Tie::StdScalar);
+
+    # All methods provided by default, so define only what needs be overridden
+    sub FETCH { ... }
+
+
+    package main;
+
+    tie $new_scalar, 'NewScalar';
+    tie $new_std_scalar, 'NewStdScalar';
+
+=head1 DESCRIPTION
+
+This module provides some skeletal methods for scalar-tying classes. See
+L<perltie> for a list of the functions required in tying a scalar to a
+package. The basic B<Tie::Scalar> package provides a C<new> method, as well
+as methods C<TIESCALAR>, C<FETCH> and C<STORE>. The B<Tie::StdScalar>
+package provides all the methods specified in  L<perltie>. It inherits from
+B<Tie::Scalar> and causes scalars tied to it to behave exactly like the
+built-in scalars, allowing for selective overloading of methods. The C<new>
+method is provided as a means of grandfathering, for classes that forget to
+provide their own C<TIESCALAR> method.
+
+For developers wishing to write their own tied-scalar classes, the methods
+are summarized below. The L<perltie> section not only documents these, but
+has sample code as well:
+
+=over
+
+=item TIESCALAR classname, LIST
+
+The method invoked by the command C<tie $scalar, classname>. Associates a new
+scalar instance with the specified class. C<LIST> would represent additional
+arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
+complete the association.
+
+=item FETCH this
+
+Retrieve the value of the tied scalar referenced by I<this>.
+
+=item STORE this, value
+
+Store data I<value> in the tied scalar referenced by I<this>.
+
+=item DESTROY this
+
+Free the storage associated with the tied scalar referenced by I<this>.
+This is rarely needed, as Perl manages its memory quite well. But the
+option exists, should a class wish to perform specific actions upon the
+destruction of an instance.
+
+=back
+
+=head1 MORE INFORMATION
+
+The L<perltie> section uses a good example of tying scalars by associating
+process IDs with priority.
+
+=cut
+
+use Carp;
+use warnings::register;
+
+sub new {
+    my $pkg = shift;
+    $pkg->TIESCALAR(@_);
+}
+
+# "Grandfather" the new, a la Tie::Hash
+
+sub TIESCALAR {
+    my $pkg = shift;
+    if (defined &{"{$pkg}::new"}) {
+	warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR is missing");
+	$pkg->new(@_);
+    }
+    else {
+	croak "$pkg doesn't define a TIESCALAR method";
+    }
+}
+
+sub FETCH {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a FETCH method";
+}
+
+sub STORE {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a STORE method";
+}
+
+#
+# The Tie::StdScalar package provides scalars that behave exactly like
+# Perl's built-in scalars. Good base to inherit from, if you're only going to
+# tweak a small bit.
+#
+package Tie::StdScalar;
+@ISA = (Tie::Scalar);
+
+sub TIESCALAR {
+    my $class = shift;
+    my $instance = shift || undef;
+    return bless \$instance => $class;
+}
+
+sub FETCH {
+    return ${$_[0]};
+}
+
+sub STORE {
+    ${$_[0]} = $_[1];
+}
+
+sub DESTROY {
+    undef ${$_[0]};
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Tie/SubstrHash.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Tie/SubstrHash.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Tie/SubstrHash.pm	(revision 14265)
@@ -0,0 +1,213 @@
+package Tie::SubstrHash;
+
+=head1 NAME
+
+Tie::SubstrHash - Fixed-table-size, fixed-key-length hashing
+
+=head1 SYNOPSIS
+
+    require Tie::SubstrHash;
+
+    tie %myhash, 'Tie::SubstrHash', $key_len, $value_len, $table_size;
+
+=head1 DESCRIPTION
+
+The B<Tie::SubstrHash> package provides a hash-table-like interface to
+an array of determinate size, with constant key size and record size.
+
+Upon tying a new hash to this package, the developer must specify the
+size of the keys that will be used, the size of the value fields that the
+keys will index, and the size of the overall table (in terms of key-value
+pairs, not size in hard memory). I<These values will not change for the
+duration of the tied hash>. The newly-allocated hash table may now have
+data stored and retrieved. Efforts to store more than C<$table_size>
+elements will result in a fatal error, as will efforts to store a value
+not exactly C<$value_len> characters in length, or reference through a
+key not exactly C<$key_len> characters in length. While these constraints
+may seem excessive, the result is a hash table using much less internal
+memory than an equivalent freely-allocated hash table.
+
+=head1 CAVEATS
+
+Because the current implementation uses the table and key sizes for the
+hashing algorithm, there is no means by which to dynamically change the
+value of any of the initialization parameters.
+
+The hash does not support exists().
+
+=cut
+
+use Carp;
+
+sub TIEHASH {
+    my $pack = shift;
+    my ($klen, $vlen, $tsize) = @_;
+    my $rlen = 1 + $klen + $vlen;
+    $tsize = [$tsize,
+	      findgteprime($tsize * 1.1)]; # Allow 10% empty.
+    $self = bless ["\0", $klen, $vlen, $tsize, $rlen, 0, -1];
+    $$self[0] x= $rlen * $tsize->[1];
+    $self;
+}
+
+sub CLEAR {
+    local($self) = @_;
+    $$self[0] = "\0" x ($$self[4] * $$self[3]->[1]);
+    $$self[5] =  0;
+    $$self[6] = -1;
+}
+
+sub FETCH {
+    local($self,$key) = @_;
+    local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
+    &hashkey;
+    for (;;) {
+	$offset = $hash * $rlen;
+	$record = substr($$self[0], $offset, $rlen);
+	if (ord($record) == 0) {
+	    return undef;
+	}
+	elsif (ord($record) == 1) {
+	}
+	elsif (substr($record, 1, $klen) eq $key) {
+	    return substr($record, 1+$klen, $vlen);
+	}
+	&rehash;
+    }
+}
+
+sub STORE {
+    local($self,$key,$val) = @_;
+    local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
+    croak("Table is full ($tsize->[0] elements)") if $$self[5] > $tsize->[0];
+    croak(qq/Value "$val" is not $vlen characters long/)
+	if length($val) != $vlen;
+    my $writeoffset;
+
+    &hashkey;
+    for (;;) {
+	$offset = $hash * $rlen;
+	$record = substr($$self[0], $offset, $rlen);
+	if (ord($record) == 0) {
+	    $record = "\2". $key . $val;
+	    die "panic" unless length($record) == $rlen;
+	    $writeoffset = $offset unless defined $writeoffset;
+	    substr($$self[0], $writeoffset, $rlen) = $record;
+	    ++$$self[5];
+	    return;
+	}
+	elsif (ord($record) == 1) {
+	    $writeoffset = $offset unless defined $writeoffset;
+	}
+	elsif (substr($record, 1, $klen) eq $key) {
+	    $record = "\2". $key . $val;
+	    die "panic" unless length($record) == $rlen;
+	    substr($$self[0], $offset, $rlen) = $record;
+	    return;
+	}
+	&rehash;
+    }
+}
+
+sub DELETE {
+    local($self,$key) = @_;
+    local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
+    &hashkey;
+    for (;;) {
+	$offset = $hash * $rlen;
+	$record = substr($$self[0], $offset, $rlen);
+	if (ord($record) == 0) {
+	    return undef;
+	}
+	elsif (ord($record) == 1) {
+	}
+	elsif (substr($record, 1, $klen) eq $key) {
+	    substr($$self[0], $offset, 1) = "\1";
+	    return substr($record, 1+$klen, $vlen);
+	    --$$self[5];
+	}
+	&rehash;
+    }
+}
+
+sub FIRSTKEY {
+    local($self) = @_;
+    $$self[6] = -1;
+    &NEXTKEY;
+}
+
+sub NEXTKEY {
+    local($self) = @_;
+    local($klen, $vlen, $tsize, $rlen, $entries, $iterix) = @$self[1..6];
+    for (++$iterix; $iterix < $tsize->[1]; ++$iterix) {
+	next unless substr($$self[0], $iterix * $rlen, 1) eq "\2";
+	$$self[6] = $iterix;
+	return substr($$self[0], $iterix * $rlen + 1, $klen);
+    }
+    $$self[6] = -1;
+    undef;
+}
+
+sub EXISTS {
+    croak "Tie::SubstrHash does not support exists()";
+}
+
+sub hashkey {
+    croak(qq/Key "$key" is not $klen characters long/)
+	if length($key) != $klen;
+    $hash = 2;
+    for (unpack('C*', $key)) {
+	$hash = $hash * 33 + $_;
+	&_hashwrap if $hash >= 1e13;
+    }
+    &_hashwrap if $hash >= $tsize->[1];
+    $hash = 1 unless $hash;
+    $hashbase = $hash;
+}
+
+sub _hashwrap {
+    $hash -= int($hash / $tsize->[1]) * $tsize->[1];
+}
+
+sub rehash {
+    $hash += $hashbase;
+    $hash -= $tsize->[1] if $hash >= $tsize->[1];
+}
+
+# using POSIX::ceil() would be too heavy, and not all platforms have it.
+sub ceil {
+    my $num = shift;
+    $num = int($num + 1) unless $num == int $num;
+    return $num;
+}
+
+# See:
+#
+# http://www-groups.dcs.st-andrews.ac.uk/~history/HistTopics/Prime_numbers.html
+#
+
+sub findgteprime { # find the smallest prime integer greater than or equal to
+    use integer;
+
+    my $num = ceil(shift);
+    return 2 if $num <= 2;
+
+    $num++ unless $num % 2;
+    my $i;
+    my $sqrtnum = int sqrt $num;
+    my $sqrtnumsquared = $sqrtnum * $sqrtnum;
+
+  NUM:
+    for (;; $num += 2) {
+	if ($sqrtnumsquared < $num) {
+	    $sqrtnum++;
+	    $sqrtnumsquared = $sqrtnum * $sqrtnum;
+	}
+        for ($i = 3; $i <= $sqrtnum; $i += 2) {
+            next NUM unless $num % $i;
+        }
+        return $num;
+    }
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/Time/Local.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Time/Local.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Time/Local.pm	(revision 14265)
@@ -0,0 +1,246 @@
+package Time::Local;
+require 5.000;
+require Exporter;
+use Carp;
+
+@ISA		= qw( Exporter );
+@EXPORT		= qw( timegm timelocal );
+@EXPORT_OK	= qw( timegm_nocheck timelocal_nocheck );
+
+# Set up constants
+    $SEC  = 1;
+    $MIN  = 60 * $SEC;
+    $HR   = 60 * $MIN;
+    $DAY  = 24 * $HR;
+# Determine breakpoint for rolling century
+    my $thisYear = (localtime())[5];
+    $nextCentury = int($thisYear / 100) * 100;
+    $breakpoint = ($thisYear + 50) % 100;
+    $nextCentury += 100 if $breakpoint < 50;
+
+my %options;
+
+sub timegm {
+    my (@date) = @_;
+    if ($date[5] > 999) {
+        $date[5] -= 1900;
+    }
+    elsif ($date[5] >= 0 && $date[5] < 100) {
+        $date[5] -= 100 if $date[5] > $breakpoint;
+        $date[5] += $nextCentury;
+    }
+    $ym = pack(C2, @date[5,4]);
+    $cheat = $cheat{$ym} || &cheat(@date);
+    $cheat
+    + $date[0] * $SEC
+    + $date[1] * $MIN
+    + $date[2] * $HR
+    + ($date[3]-1) * $DAY;
+}
+
+sub timegm_nocheck {
+    local $options{no_range_check} = 1;
+    &timegm;
+}
+
+sub timelocal {
+    my $t = &timegm;
+    my $tt = $t;
+
+    my (@lt) = localtime($t);
+    my (@gt) = gmtime($t);
+    if ($t < $DAY and ($lt[5] >= 70 or $gt[5] >= 70 )) {
+	# Wrap error, too early a date
+	# Try a safer date
+	$tt += $DAY;
+	@lt = localtime($tt);
+	@gt = gmtime($tt);
+    }
+
+    my $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR;
+
+    if($lt[5] > $gt[5]) {
+	$tzsec -= $DAY;
+    }
+    elsif($gt[5] > $lt[5]) {
+	$tzsec += $DAY;
+    }
+    else {
+	$tzsec += ($gt[7] - $lt[7]) * $DAY;
+    }
+
+    $tzsec += $HR if($lt[8]);
+    
+    $time = $t + $tzsec;
+    @test = localtime($time + ($tt - $t));
+    $time -= $HR if $test[2] != $_[2];
+    $time;
+}
+
+sub timelocal_nocheck {
+    local $options{no_range_check} = 1;
+    &timelocal;
+}
+
+sub cheat {
+    $year = $_[5];
+    $month = $_[4];
+    unless ($options{no_range_check}) {
+	croak "Month '$month' out of range 0..11" if $month > 11 || $month < 0;
+	croak "Day '$_[3]' out of range 1..31"	  if $_[3] > 31 || $_[3] < 1;
+	croak "Hour '$_[2]' out of range 0..23"	  if $_[2] > 23 || $_[2] < 0;
+	croak "Minute '$_[1]' out of range 0..59" if $_[1] > 59 || $_[1] < 0;
+	croak "Second '$_[0]' out of range 0..59" if $_[0] > 59 || $_[0] < 0;
+    }
+    $guess = $^T;
+    @g = gmtime($guess);
+    $lastguess = "";
+    $counter = 0;
+    while ($diff = $year - $g[5]) {
+	croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
+	$guess += $diff * (363 * $DAY);
+	@g = gmtime($guess);
+	if (($thisguess = "@g") eq $lastguess){
+	    croak "Can't handle date (".join(", ",@_).")";
+	    #date beyond this machine's integer limit
+	}
+	$lastguess = $thisguess;
+    }
+    while ($diff = $month - $g[4]) {
+	croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
+	$guess += $diff * (27 * $DAY);
+	@g = gmtime($guess);
+	if (($thisguess = "@g") eq $lastguess){
+	    croak "Can't handle date (".join(", ",@_).")";
+	    #date beyond this machine's integer limit
+	}
+	$lastguess = $thisguess;
+    }
+    @gfake = gmtime($guess-1); #still being sceptic
+    if ("@gfake" eq $lastguess){
+        croak "Can't handle date (".join(", ",@_).")";
+        #date beyond this machine's integer limit
+    }
+    $g[3]--;
+    $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAY;
+    $cheat{$ym} = $guess;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Time::Local - efficiently compute time from local and GMT time
+
+=head1 SYNOPSIS
+
+    $time = timelocal($sec,$min,$hours,$mday,$mon,$year);
+    $time = timegm($sec,$min,$hours,$mday,$mon,$year);
+
+=head1 DESCRIPTION
+
+These routines are the inverse of built-in perl fuctions localtime()
+and gmtime().  They accept a date as a six-element array, and return
+the corresponding time(2) value in seconds since the Epoch (Midnight,
+January 1, 1970).  This value can be positive or negative.
+
+It is worth drawing particular attention to the expected ranges for
+the values provided.  While the day of the month is expected to be in
+the range 1..31, the month should be in the range 0..11.  
+This is consistent with the values returned from localtime() and gmtime().
+
+The timelocal() and timegm() functions perform range checking on the
+input $sec, $min, $hours, $mday, and $mon values by default.  If you'd
+rather they didn't, you can explicitly import the timelocal_nocheck()
+and timegm_nocheck() functions.
+
+	use Time::Local 'timelocal_nocheck';
+
+	{
+	    # The 365th day of 1999
+	    print scalar localtime timelocal_nocheck 0,0,0,365,0,99;
+
+	    # The twenty thousandth day since 1970
+	    print scalar localtime timelocal_nocheck 0,0,0,20000,0,70;
+
+	    # And even the 10,000,000th second since 1999!
+	    print scalar localtime timelocal_nocheck 10000000,0,0,1,0,99;
+	}
+
+Your mileage may vary when trying these with minutes and hours,
+and it doesn't work at all for months.
+
+Strictly speaking, the year should also be specified in a form consistent
+with localtime(), i.e. the offset from 1900.
+In order to make the interpretation of the year easier for humans,
+however, who are more accustomed to seeing years as two-digit or four-digit
+values, the following conventions are followed:
+
+=over 4
+
+=item *
+
+Years greater than 999 are interpreted as being the actual year,
+rather than the offset from 1900.  Thus, 1963 would indicate the year
+Martin Luther King won the Nobel prize, not the year 2863.
+
+=item *
+
+Years in the range 100..999 are interpreted as offset from 1900, 
+so that 112 indicates 2012.  This rule also applies to years less than zero
+(but see note below regarding date range).
+
+=item *
+
+Years in the range 0..99 are interpreted as shorthand for years in the
+rolling "current century," defined as 50 years on either side of the current
+year.  Thus, today, in 1999, 0 would refer to 2000, and 45 to 2045,
+but 55 would refer to 1955.  Twenty years from now, 55 would instead refer
+to 2055.  This is messy, but matches the way people currently think about
+two digit dates.  Whenever possible, use an absolute four digit year instead.
+
+=back
+
+The scheme above allows interpretation of a wide range of dates, particularly
+if 4-digit years are used.  
+
+Please note, however, that the range of dates that can be actually be handled
+depends on the size of an integer (time_t) on a given platform.  
+Currently, this is 32 bits for most systems, yielding an approximate range 
+from Dec 1901 to Jan 2038.
+
+Both timelocal() and timegm() croak if given dates outside the supported
+range.
+
+=head1 IMPLEMENTATION
+
+These routines are quite efficient and yet are always guaranteed to agree
+with localtime() and gmtime().  We manage this by caching the start times
+of any months we've seen before.  If we know the start time of the month,
+we can always calculate any time within the month.  The start times
+themselves are guessed by successive approximation starting at the
+current time, since most dates seen in practice are close to the
+current date.  Unlike algorithms that do a binary search (calling gmtime
+once for each bit of the time value, resulting in 32 calls), this algorithm
+calls it at most 6 times, and usually only once or twice.  If you hit
+the month cache, of course, it doesn't call it at all.
+
+timelocal() is implemented using the same cache.  We just assume that we're
+translating a GMT time, and then fudge it when we're done for the timezone
+and daylight savings arguments.  Note that the timezone is evaluated for
+each date because countries occasionally change their official timezones.
+Assuming that localtime() corrects for these changes, this routine will
+also be correct.  The daylight savings offset is currently assumed 
+to be one hour.
+
+=head1 BUGS
+
+The whole scheme for interpreting two-digit years can be considered a bug.
+
+Note that the cache currently handles only years from 1900 through 2155.
+
+The proclivity to croak() is probably a bug.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/Time/gmtime.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Time/gmtime.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Time/gmtime.pm	(revision 14265)
@@ -0,0 +1,89 @@
+package Time::gmtime;
+use strict;
+use Time::tm;
+
+use 5.005_64;
+our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
+BEGIN { 
+    use Exporter   ();
+    @ISA         = qw(Exporter Time::tm);
+    @EXPORT      = qw(gmtime gmctime);
+    @EXPORT_OK   = qw(  
+			$tm_sec $tm_min $tm_hour $tm_mday 
+			$tm_mon $tm_year $tm_wday $tm_yday 
+			$tm_isdst
+		    );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+    $VERSION     = 1.01;
+}
+use vars      @EXPORT_OK;
+
+sub populate (@) {
+    return unless @_;
+    my $tmob = Time::tm->new();
+    @$tmob = (
+		$tm_sec, $tm_min, $tm_hour, $tm_mday, 
+		$tm_mon, $tm_year, $tm_wday, $tm_yday, 
+		$tm_isdst )
+	    = @_;
+    return $tmob;
+} 
+
+sub gmtime (;$)    { populate CORE::gmtime(@_ ? shift : time)}
+sub gmctime (;$)   { scalar   CORE::gmtime(@_ ? shift : time)} 
+
+1;
+__END__
+
+=head1 NAME
+
+Time::gmtime - by-name interface to Perl's built-in gmtime() function
+
+=head1 SYNOPSIS
+
+ use Time::gmtime;
+ $gm = gmtime();
+ printf "The day in Greenwich is %s\n", 
+    (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ gm->wday() ];
+
+ use Time::gmtime w(:FIELDS;
+ printf "The day in Greenwich is %s\n", 
+    (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ gm_wday() ];
+
+ $now = gmctime();
+
+ use Time::gmtime;
+ use File::stat;
+ $date_string = gmctime(stat($file)->mtime);
+
+=head1 DESCRIPTION
+
+This module's default exports override the core gmtime() function,
+replacing it with a version that returns "Time::tm" objects.
+This object has methods that return the similarly named structure field
+name from the C's tm structure from F<time.h>; namely sec, min, hour,
+mday, mon, year, wday, yday, and isdst.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this
+still overrides your core functions.)  Access these fields as variables
+named with a preceding C<tm_> in front their method names.  Thus,
+C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import the fields.
+
+The gmctime() function provides a way of getting at the 
+scalar sense of the original CORE::gmtime() function.
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
Index: /for-distributions/trunk/bin/windows/perl/lib/Time/localtime.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Time/localtime.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Time/localtime.pm	(revision 14265)
@@ -0,0 +1,85 @@
+package Time::localtime;
+use strict;
+use Time::tm;
+
+use 5.005_64;
+our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
+BEGIN {
+    use Exporter   ();
+    @ISA         = qw(Exporter Time::tm);
+    @EXPORT      = qw(localtime ctime);
+    @EXPORT_OK   = qw(  
+			$tm_sec $tm_min $tm_hour $tm_mday 
+			$tm_mon $tm_year $tm_wday $tm_yday 
+			$tm_isdst
+		    );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+    $VERSION     = 1.01;
+}
+use vars      @EXPORT_OK;
+
+sub populate (@) {
+    return unless @_;
+    my $tmob = Time::tm->new();
+    @$tmob = (
+		$tm_sec, $tm_min, $tm_hour, $tm_mday, 
+		$tm_mon, $tm_year, $tm_wday, $tm_yday, 
+		$tm_isdst )
+	    = @_;
+    return $tmob;
+} 
+
+sub localtime (;$) { populate CORE::localtime(@_ ? shift : time)}
+sub ctime (;$)     { scalar   CORE::localtime(@_ ? shift : time) } 
+
+1;
+
+__END__
+
+=head1 NAME
+
+Time::localtime - by-name interface to Perl's built-in localtime() function
+
+=head1 SYNOPSIS
+
+ use Time::localtime;
+ printf "Year is %d\n", localtime->year() + 1900;
+
+ $now = ctime();
+
+ use Time::localtime;
+ use File::stat;
+ $date_string = ctime(stat($file)->mtime);
+
+=head1 DESCRIPTION
+
+This module's default exports override the core localtime() function,
+replacing it with a version that returns "Time::tm" objects.
+This object has methods that return the similarly named structure field
+name from the C's tm structure from F<time.h>; namely sec, min, hour,
+mday, mon, year, wday, yday, and isdst.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as
+variables named with a preceding C<tm_> in front their method names.
+Thus, C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import
+the fields.
+
+The ctime() function provides a way of getting at the 
+scalar sense of the original CORE::localtime() function.
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
Index: /for-distributions/trunk/bin/windows/perl/lib/Time/tm.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/Time/tm.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/Time/tm.pm	(revision 14265)
@@ -0,0 +1,31 @@
+package Time::tm;
+use strict;
+
+use Class::Struct qw(struct);
+struct('Time::tm' => [
+     map { $_ => '$' } qw{ sec min hour mday mon year wday yday isdst }
+]);
+
+1;
+__END__
+
+=head1 NAME
+
+Time::tm - internal object used by Time::gmtime and Time::localtime
+
+=head1 SYNOPSIS
+
+Don't use this module directly.
+
+=head1 DESCRIPTION
+
+This module is used internally as a base class by Time::localtime And
+Time::gmtime functions.  It creates a Time::tm struct object which is
+addressable just like's C's tm structure from F<time.h>; namely with sec,
+min, hour, mday, mon, year, wday, yday, and isdst.
+
+This class is an internal interface only. 
+
+=head1 AUTHOR
+
+Tom Christiansen
Index: /for-distributions/trunk/bin/windows/perl/lib/UNIVERSAL.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/UNIVERSAL.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/UNIVERSAL.pm	(revision 14265)
@@ -0,0 +1,101 @@
+package UNIVERSAL;
+
+# UNIVERSAL should not contain any extra subs/methods beyond those
+# that it exists to define. The use of Exporter below is a historical
+# accident that should be fixed sometime.
+require Exporter;
+*import = \&Exporter::import;
+@EXPORT_OK = qw(isa can);
+
+1;
+__END__
+
+=head1 NAME
+
+UNIVERSAL - base class for ALL classes (blessed references)
+
+=head1 SYNOPSIS
+
+    $io = $fd->isa("IO::Handle");
+    $sub = $obj->can('print');
+
+    $yes = UNIVERSAL::isa($ref, "HASH");
+
+=head1 DESCRIPTION
+
+C<UNIVERSAL> is the base class which all bless references will inherit from,
+see L<perlobj>
+
+C<UNIVERSAL> provides the following methods
+
+=over 4
+
+=item isa ( TYPE )
+
+C<isa> returns I<true> if C<REF> is blessed into package C<TYPE>
+or inherits from package C<TYPE>.
+
+C<isa> can be called as either a static or object method call.
+
+=item can ( METHOD )
+
+C<can> checks if the object has a method called C<METHOD>. If it does
+then a reference to the sub is returned. If it does not then I<undef>
+is returned.
+
+C<can> can be called as either a static or object method call.
+
+=item VERSION ( [ REQUIRE ] )
+
+C<VERSION> will return the value of the variable C<$VERSION> in the
+package the object is blessed into. If C<REQUIRE> is given then
+it will do a comparison and die if the package version is not
+greater than or equal to C<REQUIRE>.
+
+C<VERSION> can be called as either a static or object method call.
+
+=back
+
+The C<isa> and C<can> methods can also be called as subroutines
+
+=over 4
+
+=item UNIVERSAL::isa ( VAL, TYPE )
+
+C<isa> returns I<true> if one of the following statements is true.
+
+=over 8
+
+=item *
+
+C<VAL> is a reference blessed into either package C<TYPE> or a package
+which inherits from package C<TYPE>.
+
+=item *
+
+C<VAL> is a reference to a C<TYPE> of Perl variable (e.g. 'HASH').
+
+=item *
+
+C<VAL> is the name of a package that inherits from (or is itself)
+package C<TYPE>.
+
+=back
+
+=item UNIVERSAL::can ( VAL, METHOD )
+
+If C<VAL> is a blessed reference which has a method called C<METHOD>,
+C<can> returns a reference to the subroutine.   If C<VAL> is not
+a blessed reference, or if it does not have a method C<METHOD>,
+I<undef> is returned.
+
+=back
+
+These subroutines should I<not> be imported via S<C<use UNIVERSAL qw(...)>>.
+If you want simple local access to them you can do
+
+  *isa = \&UNIVERSAL::isa;
+
+to import isa into your package.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/XML/Parser.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/XML/Parser.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/XML/Parser.pm	(revision 14265)
@@ -0,0 +1,1028 @@
+# XML::Parser
+#
+# Copyright (c) 1998 Larry Wall and Clark Cooper
+# All rights reserved.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package XML::Parser;
+
+use vars qw($VERSION %Built_In_Styles $have_LWP);
+use Carp;
+
+BEGIN {
+  require XML::Parser::Expat;
+  $VERSION = '2.27';
+  die "Parser.pm and Expat.pm versions don't match"
+    unless $VERSION eq $XML::Parser::Expat::VERSION;
+  eval {
+    require 'LWP.pm';
+    require 'URI/URL.pm';
+  };
+  $have_LWP = not $@;
+  if ($have_LWP) {
+    import LWP;
+  }
+}
+
+use strict;
+
+sub new {
+  my ($class, %args) = @_;
+  my $style = $args{Style};
+  
+  my $nonexopt = $args{Non_Expat_Options} ||= {};
+  
+  $nonexopt->{Style}             = 1;
+  $nonexopt->{Non_Expat_Options} = 1;
+  $nonexopt->{Handlers}          = 1;
+  $nonexopt->{_HNDL_TYPES}       = 1;
+  
+  
+  $args{_HNDL_TYPES} = {%XML::Parser::Expat::Handler_Setters};
+  $args{_HNDL_TYPES}->{Init} = 1;
+  $args{_HNDL_TYPES}->{Final} = 1;
+  
+  $args{Handlers} ||= {};
+  my $handlers = $args{Handlers};
+  
+  if (defined($style)) {
+    my $stylepkg = $style;
+    
+    if ($stylepkg !~ /::/) {
+      $stylepkg = "\u$style";
+      
+      # I'm using the Built_In_Styles hash to define
+      # valid internal styles, since a style doesn't
+      # need to define any particular Handler to be valid.
+      # So I can't check for the existence of a particular sub.
+      
+      croak "Undefined style: $style"
+	unless defined($Built_In_Styles{$stylepkg});
+      $stylepkg = 'XML::Parser::' . $stylepkg;
+    }
+    
+    my $htype;
+    foreach $htype (keys %{$args{_HNDL_TYPES}}) {
+      # Handlers explicity given override
+      # handlers from the Style package
+      unless (defined($handlers->{$htype})) {
+	
+	# A handler in the style package must either have
+	# exactly the right case as the type name or a
+	# completely lower case version of it.
+	
+	my $hname = "${stylepkg}::$htype";
+	if (defined(&$hname)) {
+	  $handlers->{$htype} = \&$hname;
+	  next;
+	}
+	
+	$hname = "${stylepkg}::\L$htype";
+	if (defined(&$hname)) {
+	  $handlers->{$htype} = \&$hname;
+	  next;
+	}
+      }
+    }
+  }
+  
+  $handlers->{ExternEnt} ||= ($have_LWP
+			      ? \&lwp_ext_ent_handler
+			      : \&file_ext_ent_handler);
+
+  $args{Pkg} ||= caller;
+  bless \%args, $class;
+}				# End of new
+
+sub setHandlers {
+  my ($self, @handler_pairs) = @_;
+  
+  croak("Uneven number of arguments to setHandlers method")
+    if (int(@handler_pairs) & 1);
+  
+  my @ret;
+  while (@handler_pairs) {
+    my $type = shift @handler_pairs;
+    my $handler = shift @handler_pairs;
+    unless (defined($self->{_HNDL_TYPES}->{$type})) {
+      my @types = sort keys %{$self->{_HNDL_TYPES}};
+      
+      croak("Unknown Parser handler type: $type\n Valid types: @types");
+    }
+    push(@ret, $type, $self->{Handlers}->{$type});
+    $self->{Handlers}->{$type} = $handler;
+  }
+
+  return @ret;
+}				# End of setHandlers
+
+sub parse_start {
+  my $self = shift;
+  my @expat_options = ();
+
+  my ($key, $val);
+  while (($key, $val) = each %{$self}) {
+    push (@expat_options, $key, $val)
+      unless exists $self->{Non_Expat_Options}->{$key};
+  }
+
+  my %handlers = %{$self->{Handlers}};
+  my $init = delete $handlers{Init};
+  my $final = delete $handlers{Final};
+
+  my $expatnb = new XML::Parser::ExpatNB(@expat_options, @_);
+  $expatnb->setHandlers(%handlers);
+
+  &$init($expatnb)
+    if defined($init);
+
+  $expatnb->{FinalHandler} = $final
+    if defined($final);
+
+  return $expatnb;
+}
+
+sub parse {
+  my $self = shift;
+  my $arg  = shift;
+  my @expat_options = ();
+  my ($key, $val);
+  while (($key, $val) = each %{$self}) {
+    push(@expat_options, $key, $val)
+      unless exists $self->{Non_Expat_Options}->{$key};
+  }
+  
+  my $expat = new XML::Parser::Expat(@expat_options, @_);
+  my %handlers = %{$self->{Handlers}};
+  my $init = delete $handlers{Init};
+  my $final = delete $handlers{Final};
+  
+  $expat->setHandlers(%handlers);
+  
+  &$init($expat)
+    if defined($init);
+  
+  my @result = ();
+  my $result = $expat->parse($arg);
+  
+  if ($result and defined($final)) {
+    if (wantarray) {
+      @result = &$final($expat);
+    }
+    else {
+      $result = &$final($expat);
+    }
+  }
+  
+  $expat->release;
+
+  return unless defined wantarray;
+  return wantarray ? @result : $result;
+}				# End of parse
+
+sub parsestring {
+  my $self = shift;
+  $self->parse(@_);
+}				# End of parsestring
+
+sub parsefile {
+  my $self = shift;
+  my $file = shift;
+  local(*FILE);
+  open(FILE, $file) or  croak "Couldn't open $file:\n$!";
+  binmode(FILE);
+  my @ret;
+  my $ret;
+  
+  if (wantarray) {
+    eval {
+      @ret = $self->parse(*FILE, @_);
+    };
+  }
+  else {
+    eval {
+      $ret = $self->parse(*FILE, @_);
+    };
+  }
+  my $err = $@;
+  close(FILE);
+  die $err if $err;
+  
+  return unless defined wantarray;
+  return wantarray ? @ret : $ret;
+}				# End of parsefile
+
+my %External_Entity_Table = ();
+
+sub file_ext_ent_handler {
+  my ($exp, $base, $sys) = @_;	# We don't use pub id
+
+  local(*ENT);
+
+  my $name = $sys;
+
+  # Prepend base only for relative URLs
+
+  if (defined($base)
+      and not ($name =~ m!^(?:/|\w+:)!))
+    {
+      $name = $base . $sys;
+    }
+
+  if ($name =~ s/^(\w+)://) {
+    my $method = $1;
+
+    unless ($method eq 'file') {
+      $exp->{ErrorMessage}
+	.= "\nDefault external entity handler only deals with file URLs.";
+      return undef;
+    }
+  }
+
+  if ($name =~ /^[|>+]/
+      or $name =~ /\|$/) {
+    $exp->{ErrorMessage}
+	.= "Perl IO controls not permitted in system id";
+    return undef;
+  }
+
+  my $def = $External_Entity_Table{$name};
+  if (! defined($def)) {
+    unless (open(ENT, $name)) {
+      $exp->{ErrorMessage}
+	.= "Failed to open $name: $!";
+      return undef;
+    }
+    my $status;
+    $status = read(ENT, $def, -s $name);
+    close(ENT);
+
+    unless (defined($status)) {
+      $exp->{ErrorMessage}
+	.= "Error reading $name: $!";
+      return undef;
+    }
+
+    $External_Entity_Table{$name} = $def;
+  }
+
+  return $def;
+}  # End file_ext_ent_handler
+
+##
+## Note that this external entity handler reads the entire entity into
+## memory, so it will choke on huge ones.
+##
+sub lwp_ext_ent_handler {
+  my ($exp, $base, $sys) = @_;  # We don't use public id
+
+  my $uri = new URI::URL($sys);
+  if (not $uri->scheme and $base) {
+    $uri = $uri->abs($base);
+  }
+  
+  my $scheme = $uri->scheme;
+  if (not $scheme or $scheme eq 'file') {
+    return file_ext_ent_handler($exp, $base, $sys);
+  }
+
+  my $ua = ($exp->{_lwpagent} ||= new LWP::UserAgent());
+
+  my $req = new HTTP::Request('GET', $uri);
+
+  my $res = $ua->request($req);
+  if ($res->is_error) {
+    $exp->{ErrorMessage} .= "\n" . $res->status_line;
+    return undef;
+  }
+  
+  return $res->content;
+}  # End lwp_ext_ent_handler
+
+###################################################################
+
+package XML::Parser::Debug;
+$XML::Parser::Built_In_Styles{Debug} = 1;
+
+sub Start {
+  my $expat = shift;
+  my $tag = shift;
+  print STDERR "@{$expat->{Context}} \\\\ (@_)\n";
+}
+
+sub End {
+  my $expat = shift;
+  my $tag = shift;
+  print STDERR "@{$expat->{Context}} //\n";
+}
+
+sub Char {
+  my $expat = shift;
+  my $text = shift;
+  $text =~ s/([\x80-\xff])/sprintf "#x%X;", ord $1/eg;
+  $text =~ s/([\t\n])/sprintf "#%d;", ord $1/eg;
+  print STDERR "@{$expat->{Context}} || $text\n";
+}
+
+sub Proc {
+  my $expat = shift;
+  my $target = shift;
+  my $text = shift;
+  print $expat,"\n";
+  print $expat->{Context}, "\n";
+  my @foo = @{$expat->{Context}};
+  print STDERR "@foo $target($text)\n";
+}
+
+###################################################################
+
+package XML::Parser::Subs;
+$XML::Parser::Built_In_Styles{Subs} = 1;
+
+sub Start {
+  no strict 'refs';
+  my $expat = shift;
+  my $tag = shift;
+  my $sub = $expat->{Pkg} . "::$tag";
+  eval { &$sub($expat, $tag, @_) };
+}
+
+sub End {
+  no strict 'refs';
+  my $expat = shift;
+  my $tag = shift;
+  my $sub = $expat->{Pkg} . "::${tag}_";
+  eval { &$sub($expat, $tag) };
+}
+
+###################################################################
+
+package XML::Parser::Tree;
+$XML::Parser::Built_In_Styles{Tree} = 1;
+
+sub Init {
+  my $expat = shift;
+  $expat->{Lists} = [];
+  $expat->{Curlist} = $expat->{Tree} = [];
+}
+
+sub Start {
+  my $expat = shift;
+  my $tag = shift;
+  my $newlist = [ { @_ } ];
+  push @{ $expat->{Lists} }, $expat->{Curlist};
+  push @{ $expat->{Curlist} }, $tag => $newlist;
+  $expat->{Curlist} = $newlist;
+}
+
+sub End {
+  my $expat = shift;
+  my $tag = shift;
+  $expat->{Curlist} = pop @{ $expat->{Lists} };
+}
+
+sub Char {
+  my $expat = shift;
+  my $text = shift;
+  my $clist = $expat->{Curlist};
+  my $pos = $#$clist;
+  
+  if ($pos > 0 and $clist->[$pos - 1] eq '0') {
+    $clist->[$pos] .= $text;
+  } else {
+    push @$clist, 0 => $text;
+  }
+}
+
+sub Final {
+  my $expat = shift;
+  delete $expat->{Curlist};
+  delete $expat->{Lists};
+  $expat->{Tree};
+}
+
+###################################################################
+
+package XML::Parser::Objects;
+$XML::Parser::Built_In_Styles{Objects} = 1;
+
+sub Init {
+  my $expat = shift;
+  $expat->{Lists} = [];
+  $expat->{Curlist} = $expat->{Tree} = [];
+}
+
+sub Start {
+  my $expat = shift;
+  my $tag = shift;
+  my $newlist = [ ];
+  my $class = "${$expat}{Pkg}::$tag";
+  my $newobj = bless { @_, Kids => $newlist }, $class;
+  push @{ $expat->{Lists} }, $expat->{Curlist};
+  push @{ $expat->{Curlist} }, $newobj;
+  $expat->{Curlist} = $newlist;
+}
+
+sub End {
+  my $expat = shift;
+  my $tag = shift;
+  $expat->{Curlist} = pop @{ $expat->{Lists} };
+}
+
+sub Char {
+  my $expat = shift;
+  my $text = shift;
+  my $class = "${$expat}{Pkg}::Characters";
+  my $clist = $expat->{Curlist};
+  my $pos = $#$clist;
+  
+  if ($pos >= 0 and ref($clist->[$pos]) eq $class) {
+    $clist->[$pos]->{Text} .= $text;
+  } else {
+    push @$clist, bless { Text => $text }, $class;
+  }
+}
+
+sub Final {
+  my $expat = shift;
+  delete $expat->{Curlist};
+  delete $expat->{Lists};
+  $expat->{Tree};
+}
+
+################################################################
+
+package XML::Parser::Stream;
+$XML::Parser::Built_In_Styles{Stream} = 1;
+
+# This style invented by Tim Bray <tbray@textuality.com>
+
+sub Init {
+  no strict 'refs';
+  my $expat = shift;
+  $expat->{Text} = '';
+  my $sub = $expat->{Pkg} ."::StartDocument";
+  &$sub($expat)
+    if defined(&$sub);
+}
+
+sub Start {
+  no strict 'refs';
+  my $expat = shift;
+  my $type = shift;
+  
+  doText($expat);
+  $_ = "<$type";
+  
+  %_ = @_;
+  while (@_) {
+    $_ .= ' ' . shift() . '="' . shift() . '"';
+  }
+  $_ .= '>';
+  
+  my $sub = $expat->{Pkg} . "::StartTag";
+  if (defined(&$sub)) {
+    &$sub($expat, $type);
+  } else {
+    print;
+  }
+}
+
+sub End {
+  no strict 'refs';
+  my $expat = shift;
+  my $type = shift;
+  
+  # Set right context for Text handler
+  push(@{$expat->{Context}}, $type);
+  doText($expat);
+  pop(@{$expat->{Context}});
+  
+  $_ = "</$type>";
+  
+  my $sub = $expat->{Pkg} . "::EndTag";
+  if (defined(&$sub)) {
+    &$sub($expat, $type);
+  } else {
+    print;
+  }
+}
+
+sub Char {
+  my $expat = shift;
+  $expat->{Text} .= shift;
+}
+
+sub Proc {
+  no strict 'refs';
+  my $expat = shift;
+  my $target = shift;
+  my $text = shift;
+  
+  $_ = "<?$target $text?>";
+  
+  my $sub = $expat->{Pkg} . "::PI";
+  if (defined(&$sub)) {
+    &$sub($expat, $target, $text);
+  } else {
+    print;
+  }
+}
+
+sub Final {
+  no strict 'refs';
+  my $expat = shift;
+  my $sub = $expat->{Pkg} . "::EndDocument";
+  &$sub($expat)
+    if defined(&$sub);
+}
+
+sub doText {
+  no strict 'refs';
+  my $expat = shift;
+  $_ = $expat->{Text};
+  
+  if (length($_)) {
+    my $sub = $expat->{Pkg} . "::Text";
+    if (defined(&$sub)) {
+      &$sub($expat);
+    } else {
+      print;
+    }
+    
+    $expat->{Text} = '';
+  }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+XML::Parser - A perl module for parsing XML documents
+
+=head1 SYNOPSIS
+
+  use XML::Parser;
+  
+  $p1 = new XML::Parser(Style => 'Debug');
+  $p1->parsefile('REC-xml-19980210.xml');
+  $p1->parse('<foo id="me">Hello World</foo>');
+
+  # Alternative
+  $p2 = new XML::Parser(Handlers => {Start => \&handle_start,
+				     End   => \&handle_end,
+				     Char  => \&handle_char});
+  $p2->parse($socket);
+
+  # Another alternative
+  $p3 = new XML::Parser(ErrorContext => 2);
+
+  $p3->setHandlers(Char    => \&text,
+		   Default => \&other);
+
+  open(FOO, 'xmlgenerator |');
+  $p3->parse(*FOO, ProtocolEncoding => 'ISO-8859-1');
+  close(FOO);
+
+  $p3->parsefile('junk.xml', ErrorContext => 3);
+
+=begin man
+.ds PI PI
+
+=end man
+
+=head1 DESCRIPTION
+
+This module provides ways to parse XML documents. It is built on top of
+L<XML::Parser::Expat>, which is a lower level interface to James Clark's
+expat library. Each call to one of the parsing methods creates a new
+instance of XML::Parser::Expat which is then used to parse the document.
+Expat options may be provided when the XML::Parser object is created.
+These options are then passed on to the Expat object on each parse call.
+They can also be given as extra arguments to the parse methods, in which
+case they override options given at XML::Parser creation time.
+
+The behavior of the parser is controlled either by C<L</Style>> and/or
+C<L</Handlers>> options, or by L</setHandlers> method. These all provide
+mechanisms for XML::Parser to set the handlers needed by XML::Parser::Expat.
+If neither C<Style> nor C<Handlers> are specified, then parsing just
+checks the document for being well-formed.
+
+When underlying handlers get called, they receive as their first parameter
+the I<Expat> object, not the Parser object.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+This is a class method, the constructor for XML::Parser. Options are passed
+as keyword value pairs. Recognized options are:
+
+=over 4
+
+=item * Style
+
+This option provides an easy way to create a given style of parser. The
+built in styles are: L<"Debug">, L<"Subs">, L<"Tree">, L<"Objects">,
+and L<"Stream">.
+Custom styles can be provided by giving a full package name containing
+at least one '::'. This package should then have subs defined for each
+handler it wishes to have installed. See L<"STYLES"> below
+for a discussion of each built in style.
+
+=item * Handlers
+
+When provided, this option should be an anonymous hash containing as
+keys the type of handler and as values a sub reference to handle that
+type of event. All the handlers get passed as their 1st parameter the
+instance of expat that is parsing the document. Further details on
+handlers can be found in L<"HANDLERS">. Any handler set here
+overrides the corresponding handler set with the Style option.
+
+=item * Pkg
+
+Some styles will refer to subs defined in this package. If not provided,
+it defaults to the package which called the constructor.
+
+=item * ErrorContext
+
+This is an Expat option. When this option is defined, errors are reported
+in context. The value should be the number of lines to show on either side
+of the line in which the error occurred.
+
+=item * ProtocolEncoding
+
+This is an Expat option. This sets the protocol encoding name. It defaults
+to none. The built-in encodings are: C<UTF-8>, C<ISO-8859-1>, C<UTF-16>, and
+C<US-ASCII>. Other encodings may be used if they have encoding maps in one
+of the directories in the @Encoding_Path list. Check L<"ENCODINGS"> for
+more information on encoding maps. Setting the protocol encoding overrides
+any encoding in the XML declaration.
+
+=item * Namespaces
+
+This is an Expat option. If this is set to a true value, then namespace
+processing is done during the parse. See L<XML::Parser::Expat/"Namespaces">
+for further discussion of namespace processing.
+
+=item * NoExpand
+
+This is an Expat option. Normally, the parser will try to expand references
+to entities defined in the internal subset. If this option is set to a true
+value, and a default handler is also set, then the default handler will be
+called when an entity reference is seen in text. This has no effect if a
+default handler has not been registered, and it has no effect on the expansion
+of entity references inside attribute values.
+
+=item * Stream_Delimiter
+
+This is an Expat option. It takes a string value. When this string is found
+alone on a line while parsing from a stream, then the parse is ended as if it
+saw an end of file. The intended use is with a stream of xml documents in a
+MIME multipart format. The string should not contain a trailing newline.
+
+=item * ParseParamEnt
+
+This is an Expat option. Unless standalone is set to "yes" in the XML
+declaration, setting this to a true value allows the external DTD to be read,
+and parameter entities to be parsed and expanded.
+
+=item * Non-Expat-Options
+
+If provided, this should be an anonymous hash whose keys are options that
+shouldn't be passed to Expat. This should only be of concern to those
+subclassing XML::Parser.
+
+=back
+
+=item  setHandlers(TYPE, HANDLER [, TYPE, HANDLER [...]])
+
+This method registers handlers for various parser events. It overrides any
+previous handlers registered through the Style or Handler options or through
+earlier calls to setHandlers. By providing a false or undefined value as
+the handler, the existing handler can be unset.
+
+This method returns a list of type, handler pairs corresponding to the
+input. The handlers returned are the ones that were in effect prior to
+the call.
+
+See a description of the handler types in L<"HANDLERS">.
+
+=item parse(SOURCE [, OPT => OPT_VALUE [...]])
+
+The SOURCE parameter should either be a string containing the whole XML
+document, or it should be an open IO::Handle. Constructor options to
+XML::Parser::Expat given as keyword-value pairs may follow the SOURCE
+parameter. These override, for this call, any options or attributes passed
+through from the XML::Parser instance.
+
+A die call is thrown if a parse error occurs. Otherwise it will return 1
+or whatever is returned from the B<Final> handler, if one is installed.
+In other words, what parse may return depends on the style.
+
+=item parsestring
+
+This is just an alias for parse for backwards compatibility.
+
+=item parsefile(FILE [, OPT => OPT_VALUE [...]])
+
+Open FILE for reading, then call parse with the open handle. The file
+is closed no matter how parse returns. Returns what parse returns.
+
+=item parse_start([ OPT => OPT_VALUE [...]])
+
+Create and return a new instance of XML::Parser::ExpatNB. Constructor
+options may be provided. If an init handler has been provided, it is
+called before returning the ExpatNB object. Documents are parsed by
+making incremental calls to the parse_more method of this object, which
+takes a string. A single call to the parse_done method of this object,
+which takes no arguments, indicates that the document is finished.
+
+If there is a final handler installed, it is executed by the parse_done
+method before returning and the parse_done method returns whatever is
+returned by the final handler.
+
+=back
+
+=head1 HANDLERS
+
+Expat is an event based parser. As the parser recognizes parts of the
+document (say the start or end tag for an XML element), then any handlers
+registered for that type of an event are called with suitable parameters.
+All handlers receive an instance of XML::Parser::Expat as their first
+argument. See L<XML::Parser::Expat/"METHODS"> for a discussion of the
+methods that can be called on this object.
+
+=head2 Init		(Expat)
+
+This is called just before the parsing of the document starts.
+
+=head2 Final		(Expat)
+
+This is called just after parsing has finished, but only if no errors
+occurred during the parse. Parse returns what this returns.
+
+=head2 Start		(Expat, Element [, Attr, Val [,...]])
+
+This event is generated when an XML start tag is recognized. Element is the
+name of the XML element type that is opened with the start tag. The Attr &
+Val pairs are generated for each attribute in the start tag.
+
+=head2 End		(Expat, Element)
+
+This event is generated when an XML end tag is recognized. Note that
+an XML empty tag (<foo/>) generates both a start and an end event.
+
+=head2 Char		(Expat, String)
+
+This event is generated when non-markup is recognized. The non-markup
+sequence of characters is in String. A single non-markup sequence of
+characters may generate multiple calls to this handler. Whatever the
+encoding of the string in the original document, this is given to the
+handler in UTF-8.
+
+=head2 Proc		(Expat, Target, Data)
+
+This event is generated when a processing instruction is recognized.
+
+=head2 Comment		(Expat, Data)
+
+This event is generated when a comment is recognized.
+
+=head2 CdataStart	(Expat)
+
+This is called at the start of a CDATA section.
+
+=head2 CdataEnd		(Expat)
+
+This is called at the end of a CDATA section.
+
+=head2 Default		(Expat, String)
+
+This is called for any characters that don't have a registered handler.
+This includes both characters that are part of markup for which no
+events are generated (markup declarations) and characters that
+could generate events, but for which no handler has been registered.
+
+Whatever the encoding in the original document, the string is returned to
+the handler in UTF-8.
+
+=head2 Unparsed		(Expat, Entity, Base, Sysid, Pubid, Notation)
+
+This is called for a declaration of an unparsed entity. Entity is the name
+of the entity. Base is the base to be used for resolving a relative URI.
+Sysid is the system id. Pubid is the public id. Notation is the notation
+name. Base and Pubid may be undefined.
+
+=head2 Notation		(Expat, Notation, Base, Sysid, Pubid)
+
+This is called for a declaration of notation. Notation is the notation name.
+Base is the base to be used for resolving a relative URI. Sysid is the system
+id. Pubid is the public id. Base, Sysid, and Pubid may all be undefined.
+
+=head2 ExternEnt	(Expat, Base, Sysid, Pubid)
+
+This is called when an external entity is referenced. Base is the base to be
+used for resolving a relative URI. Sysid is the system id. Pubid is the public
+id. Base, and Pubid may be undefined.
+
+This handler should either return a string, which represents the contents of
+the external entity, or return an open filehandle that can be read to obtain
+the contents of the external entity, or return undef, which indicates the
+external entity couldn't be found and will generate a parse error.
+
+If an open filehandle is returned, it must be returned as either a glob
+(*FOO) or as a reference to a glob (e.g. an instance of IO::Handle). The
+parser will close the filehandle after using it.
+
+A default handler, XML::Parser::default_ext_ent_handler, is installed
+for this. It only handles the file URL method and it assumes "file:" if
+it isn't there. The expat base method can be used to set a basename for
+relative pathnames. If no basename is given, or if the basename is itself
+a relative name, then it is relative to the current working directory.
+
+=head2 Entity		(Expat, Name, Val, Sysid, Pubid, Ndata)
+
+This is called when an entity is declared. For internal entities, the Val
+parameter will contain the value and the remaining three parameters will be
+undefined. For external entities, the Val parameter will be undefined, the
+Sysid parameter will have the system id, the Pubid parameter will have the
+public id if it was provided (it will be undefined otherwise), the Ndata
+parameter will contain the notation for unparsed entities. If this is a
+parameter entity declaration, then a '%' will be prefixed to the name.
+
+Note that this handler and the Unparsed handler above overlap. If both are
+set, then this handler will not be called for unparsed entities.
+
+=head2 Element		(Expat, Name, Model)
+
+The element handler is called when an element declaration is found. Name
+is the element name, and Model is the content model as a string.
+
+=head2 Attlist		(Expat, Elname, Attname, Type, Default, Fixed)
+
+This handler is called for each attribute in an ATTLIST declaration.
+So an ATTLIST declaration that has multiple attributes will generate multiple
+calls to this handler. The Elname parameter is the name of the element with
+which the attribute is being associated. The Attname parameter is the name
+of the attribute. Type is the attribute type, given as a string. Default is
+the default value, which will either be "#REQUIRED", "#IMPLIED" or a quoted
+string (i.e. the returned string will begin and end with a quote character).
+If Fixed is true, then this is a fixed attribute.
+
+=head2 Doctype		(Expat, Name, Sysid, Pubid, Internal)
+
+This handler is called for DOCTYPE declarations. Name is the document type
+name. Sysid is the system id of the document type, if it was provided,
+otherwise it's undefined. Pubid is the public id of the document type,
+which will be undefined if no public id was given. Internal is the internal
+subset, given as a string. If there was no internal subset, it will be
+undefined. Internal will contain all whitespace, comments, processing
+instructions, and declarations seen in the internal subset. The declarations
+will be there whether or not they have been processed by another handler
+(except for unparsed entities processed by the Unparsed handler). However,
+comments and processing instructions will not appear if they've been processed
+by their respective handlers.
+
+=head2 XMLDecl		(Expat, Version, Encoding, Standalone)
+
+This handler is called for xml declarations. Version is a string containg
+the version. Encoding is either undefined or contains an encoding string.
+Standalone will be either true, false, or undefined if the standalone attribute
+is yes, no, or not made respectively.
+
+=head1 STYLES
+
+=head2 Debug
+
+This just prints out the document in outline form. Nothing special is
+returned by parse.
+
+=head2 Subs
+
+Each time an element starts, a sub by that name in the package specified
+by the Pkg option is called with the same parameters that the Start
+handler gets called with.
+
+Each time an element ends, a sub with that name appended with an underscore
+("_"), is called with the same parameters that the End handler gets called
+with.
+
+Nothing special is returned by parse.
+
+=head2 Tree
+
+Parse will return a parse tree for the document. Each node in the tree
+takes the form of a tag, content pair. Text nodes are represented with
+a pseudo-tag of "0" and the string that is their content. For elements,
+the content is an array reference. The first item in the array is a
+(possibly empty) hash reference containing attributes. The remainder of
+the array is a sequence of tag-content pairs representing the content
+of the element.
+
+So for example the result of parsing:
+
+  <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
+
+would be:
+             Tag   Content
+  ==================================================================
+  [foo, [{}, head, [{id => "a"}, 0, "Hello ",  em, [{}, 0, "there"]],
+	      bar, [         {}, 0, "Howdy",  ref, [{}]],
+	        0, "do"
+	]
+  ]
+
+The root document "foo", has 3 children: a "head" element, a "bar"
+element and the text "do". After the empty attribute hash, these are
+represented in it's contents by 3 tag-content pairs.
+
+=head2 Objects
+
+This is similar to the Tree style, except that a hash object is created for
+each element. The corresponding object will be in the class whose name
+is created by appending "::" and the element name to the package set with
+the Pkg option. Non-markup text will be in the ::Characters class. The
+contents of the corresponding object will be in an anonymous array that
+is the value of the Kids property for that object.
+
+=head2 Stream
+
+This style also uses the Pkg package. If none of the subs that this
+style looks for is there, then the effect of parsing with this style is
+to print a canonical copy of the document without comments or declarations.
+All the subs receive as their 1st parameter the Expat instance for the
+document they're parsing.
+
+It looks for the following routines:
+
+=over 4
+
+=item * StartDocument
+
+Called at the start of the parse .
+
+=item * StartTag
+
+Called for every start tag with a second parameter of the element type. The $_
+variable will contain a copy of the tag and the %_ variable will contain
+attribute values supplied for that element.
+
+=item * EndTag
+
+Called for every end tag with a second parameter of the element type. The $_
+variable will contain a copy of the end tag.
+
+=item * Text
+
+Called just before start or end tags with accumulated non-markup text in
+the $_ variable.
+
+=item * PI
+
+Called for processing instructions. The $_ variable will contain a copy of
+the PI and the target and data are sent as 2nd and 3rd parameters
+respectively.
+
+=item * EndDocument
+
+Called at conclusion of the parse.
+
+=back
+
+=head1 ENCODINGS
+
+XML documents may be encoded in character sets other than Unicode as
+long as they may be mapped into the Unicode character set. Expat has
+further restrictions on encodings. Read the xmlparse.h header file in
+the expat distribution to see details on these restrictions.
+
+Expat has built-in encodings for: C<UTF-8>, C<ISO-8859-1>, C<UTF-16>, and
+C<US-ASCII>. Encodings are set either through the XML declaration
+encoding attribute or through the ProtocolEncoding option to XML::Parser
+or XML::Parser::Expat.
+
+For encodings other than the built-ins, expat calls the function
+load_encoding in the Expat package with the encoding name. This function
+looks for a file in the path list @XML::Parser::Expat::Encoding_Path, that
+matches the lower-cased name with a '.enc' extension. The first one it
+finds, it loads.
+
+If you wish to build your own encoding maps, check out the XML::Encoding
+module from CPAN.
+
+=head1 AUTHORS
+
+Larry Wall <F<larry@wall.org>> wrote version 1.0.
+
+Clark Cooper <F<coopercc@netheaven.com>> picked up support, changed the API
+for this version (2.x), provided documentation,
+and added some standard package features.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/XML/Parser/Encodings/README
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/XML/Parser/Encodings/README	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/XML/Parser/Encodings/README	(revision 14265)
@@ -0,0 +1,51 @@
+This directory contains binary encoding maps for some selected encodings.
+If they are placed in a directoy listed in @XML::Parser::Expat::Encoding_Path,
+then they are automaticly loaded by the XML::Parser::Expat::load_encoding
+function as needed. Otherwise you may load what you need directly by
+explicity calling this function.
+
+These maps were generated by a perl script that comes with the module
+XML::Encoding, compile_encoding, from XML formatted encoding maps that
+are distributed with that module. These XML encoding maps were generated
+in turn with a different script, domap, from mapping information contained
+on the Unicode version 2.0 CD-ROM. This CD-ROM comes with the Unicode
+Standard reference manual and can be ordered from the Unicode Consortium
+at http://www.unicode.org. The identical information is available on the
+internet at ftp://ftp.unicode.org/Public/MAPPINGS.
+
+See the encoding.h header in the Expat sub-directory for a description of
+the structure of these files.
+
+Clark Cooper
+December 12, 1998
+
+================================================================
+
+Contributed maps
+
+This distribution contains four contributed encodings from MURATA Makoto
+<murata@apsdc.ksp.fujixerox.co.jp> that are variations on the encoding
+commonly called Shift_JIS:
+
+x-sjis-cp932.enc
+x-sjis-jdk117.enc
+x-sjis-jisx0221.enc
+x-sjis-unicode.enc	(This is the same encoding as the shift_jis.enc that
+			 was distributed with this module in version 2.17)
+
+Please read his message (Japanese_Encodings.msg) about why these are here
+and why I've removed the shift_jis.enc encoding.
+
+We also have two contributed encodings that are variations of the EUC-JP
+encoding from Yoshida Masato <yoshidam@inse.co.jp>:
+
+x-euc-jp-jisx0221.enc
+x-euc-jp-unicode.enc
+
+The comments that MURATA Makoto made in his message apply to these
+encodings too.
+
+KangChan Lee <dolphin@comeng.chungnam.ac.kr> supplied the euc-kr encoding.
+
+Clark Cooper
+December 26, 1998
Index: /for-distributions/trunk/bin/windows/perl/lib/XML/Parser/Expat.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/XML/Parser/Expat.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/XML/Parser/Expat.pm	(revision 14265)
@@ -0,0 +1,1045 @@
+package XML::Parser::Expat;
+
+require 5.004;
+
+use strict;
+use vars qw($VERSION @ISA %Handler_Setters %Encoding_Table @Encoding_Path
+	    $have_File_Spec);
+use Carp;
+
+use IO::Handle;
+
+require DynaLoader;
+
+@ISA = qw(DynaLoader);
+$VERSION = "2.27" ;
+
+$have_File_Spec = do 'File/Spec.pm';
+
+%Encoding_Table = ();
+if ($have_File_Spec) {
+  @Encoding_Path = (grep(-d $_,
+			 map(File::Spec->catdir($_, qw(XML Parser Encodings)),
+			     @INC)),
+		    File::Spec->curdir);
+}
+else {
+  @Encoding_Path = (grep(-d $_, map($_ . '/XML/Parser/Encodings', @INC)), '.');
+}
+  
+
+bootstrap XML::Parser::Expat $VERSION;
+
+%Handler_Setters = (
+		    Start => \&SetStartElementHandler,
+		    End   => \&SetEndElementHandler,
+		    Char  => \&SetCharacterDataHandler,
+		    Proc  => \&SetProcessingInstructionHandler,
+		    Comment => \&SetCommentHandler,
+		    CdataStart => \&SetStartCdataHandler,
+		    CdataEnd   => \&SetEndCdataHandler,
+		    Default => \&SetDefaultHandler,
+		    Unparsed => \&SetUnparsedEntityDeclHandler,
+		    Notation => \&SetNotationDeclHandler,
+		    ExternEnt => \&SetExternalEntityRefHandler,
+		    Entity => \&SetEntityDeclHandler,
+		    Element => \&SetElementDeclHandler,
+		    Attlist => \&SetAttListDeclHandler,
+		    Doctype => \&SetDoctypeHandler,
+		    XMLDecl => \&SetXMLDeclHandler
+		    );
+
+sub new {
+  my ($class, %args) = @_;
+  my $self = bless \%args, $_[0];
+  $args{Used} = 0;
+  $args{Context} = [];
+  $args{Namespaces} ||= 0;
+  $args{ErrorMessage} ||= '';
+  if ($args{Namespaces}) {
+    $args{Namespace_Table} = {};
+    $args{Namespace_List} = [undef];
+    $args{Prefix_Table} = {};
+    $args{New_Prefixes} = [];
+  }
+  $args{_Setters} = \%Handler_Setters;
+  $args{Parser} = ParserCreate($self, $args{ProtocolEncoding},
+			       $args{Namespaces});
+  $self;
+}
+
+sub load_encoding {
+  my ($file) = @_;
+
+  $file =~ s!([^/]+)$!\L$1\E!;
+  $file .= '.enc' unless $file =~ /\.enc$/;
+  unless ($file =~ m!^/!) {
+    foreach (@Encoding_Path) {
+      my $tmp = ($have_File_Spec
+		 ? File::Spec->catfile($_, $file)
+		 : "$_/$file");
+      if (-e $tmp) {
+	$file = $tmp;
+	last;
+      }
+    }
+  }
+
+  local(*ENC);
+  open(ENC, $file) or croak("Couldn't open encmap $file:\n$!\n");
+  binmode(ENC);
+  my $data;
+  my $br = sysread(ENC, $data, -s $file);
+  croak("Trouble reading $file:\n$!\n")
+    unless defined($br);
+  close(ENC);
+
+  my $name = LoadEncoding($data, $br);
+  croak("$file isn't an encmap file")
+    unless defined($name);
+
+  $name;
+}  # End load_encoding
+
+sub setHandlers {
+  my ($self, @handler_pairs) = @_;
+
+  croak("Uneven number of arguments to setHandlers method")
+    if (int(@handler_pairs) & 1);
+
+  my @ret;
+
+  while (@handler_pairs) {
+    my $type = shift @handler_pairs;
+    my $handler = shift @handler_pairs;
+    croak "Handler for $type not a Code ref"
+      unless (! defined($handler) or ! $handler or ref($handler) eq 'CODE');
+
+    my $hndl = $self->{_Setters}->{$type};
+
+    unless (defined($hndl)) {
+      my @types = sort keys %{$self->{_Setters}};
+      croak("Unknown Expat handler type: $type\n Valid types: @types");
+    }
+
+    my $old = &$hndl($self->{Parser}, $handler);
+    push (@ret, $type, $old);
+  }
+
+  return @ret;
+}
+
+sub xpcroak {
+  my ($self, $message) = @_;
+
+  my $eclines = $self->{ErrorContext};
+  my $line = GetCurrentLineNumber($_[0]->{Parser});
+  $message .= " at line $line";
+  $message .= ":\n" . $self->position_in_context($eclines)
+    if defined($eclines);
+  croak $message;
+}
+
+sub xpcarp {
+  my ($self, $message) = @_;
+
+  my $eclines = $self->{ErrorContext};
+  my $line = GetCurrentLineNumber($_[0]->{Parser});
+  $message .= " at line $line";
+  $message .= ":\n" . $self->position_in_context($eclines)
+    if defined($eclines);
+  carp $message;
+}
+
+sub default_current {
+  my $self = shift;
+  DefaultCurrent($self->{Parser});
+}
+
+sub recognized_string {
+  my $self = shift;
+  RecognizedString($self->{Parser});
+}
+
+sub original_string {
+  my $self = shift;
+  OriginalString($self->{Parser});
+}
+
+sub current_line {
+  GetCurrentLineNumber($_[0]->{Parser});
+}
+
+sub current_column {
+  GetCurrentColumnNumber($_[0]->{Parser});
+}
+
+sub current_byte {
+  GetCurrentByteIndex($_[0]->{Parser});
+}
+
+sub base {
+  my ($self, $newbase) = @_;
+  my $p = $self->{Parser};
+  my $oldbase = GetBase($p);
+  SetBase($p, $newbase) if @_ > 1;
+  $oldbase;
+}
+
+sub context {
+  my $ctx = $_[0]->{Context};
+  @$ctx;
+}
+
+sub current_element {
+  my ($self) = @_;
+  @{$self->{Context}} ? $self->{Context}->[-1] : undef;
+}
+
+sub in_element {
+  my ($self, $element) = @_;
+  @{$self->{Context}} ? $self->eq_name($self->{Context}->[-1], $element)
+    : undef;
+}
+
+sub within_element {
+  my ($self, $element) = @_;
+  my $cnt = 0;
+  foreach (@{$self->{Context}}) {
+    $cnt++ if $self->eq_name($_, $element);
+  }
+  return $cnt;
+}
+
+sub depth {
+  my ($self) = @_;
+  int(@{$self->{Context}});
+}
+
+sub element_index {
+  my ($self) = @_;
+
+  ElementIndex($self->{Parser});
+}
+
+################
+# Namespace methods
+
+sub namespace {
+  my ($self, $name) = @_;
+  local($^W) = 0;
+  $self->{Namespace_List}->[int($name)];
+}
+
+sub eq_name {
+  my ($self, $nm1, $nm2) = @_;
+  local($^W) = 0;
+
+  int($nm1) == int($nm2) and $nm1 eq $nm2;
+}
+
+sub generate_ns_name {
+  my ($self, $name, $namespace) = @_;
+
+  $namespace ?
+    GenerateNSName($name, $namespace, $self->{Namespace_Table},
+		   $self->{Namespace_List})
+      : $name;
+}
+
+sub new_ns_prefixes {
+  my ($self) = @_;
+  if ($self->{Namespaces}) {
+    return @{$self->{New_Prefixes}};
+  }
+  return ();
+}
+
+sub expand_ns_prefix {
+  my ($self, $prefix) = @_;
+
+  if ($self->{Namespaces}) {
+    my $stack = $self->{Prefix_Table}->{$prefix};
+    return (defined($stack) and @$stack) ? $stack->[-1] : undef;
+  }
+
+  return undef;
+}
+
+sub current_ns_prefixes {
+  my ($self) = @_;
+
+  if ($self->{Namespaces}) {
+    my %set = %{$self->{Prefix_Table}};
+
+    if (exists $set{'#default'} and not defined($set{'#default'}->[-1])) {
+      delete $set{'#default'};
+    }
+
+    return keys %set;
+  }
+
+  return ();
+}
+
+
+################################################################
+# Namespace declaration handlers
+#
+
+sub NamespaceStart {
+  my ($self, $prefix, $uri) = @_;
+
+  $prefix = '#default' unless defined $prefix;
+  my $stack = $self->{Prefix_Table}->{$prefix}; 
+
+  if (defined $stack) {
+    push(@$stack, $uri);
+  }
+  else {
+    $self->{Prefix_Table}->{$prefix} = [$uri];
+  }
+
+  # The New_Prefixes list gets emptied at end of startElement function
+  # in Expat.xs
+
+  push(@{$self->{New_Prefixes}}, $prefix);
+}
+
+sub NamespaceEnd {
+  my ($self, $prefix) = @_;
+
+  $prefix = '#default' unless defined $prefix;
+
+  my $stack = $self->{Prefix_Table}->{$prefix};
+  if (@$stack > 1) {
+    pop(@$stack);
+  }
+  else {
+    delete $self->{Prefix_Table}->{$prefix};
+  }
+}
+
+################
+
+sub is_defaulted {
+  my ($self, $attname) = @_;
+
+  warn <<'End_of_Warning;';
+The is_defaulted method no longer works.
+Please use the specified_attr method instead. The is_defaulted method will
+be removed altogether in a future version.
+End_of_Warning;
+  return 0;
+}
+
+sub specified_attr {
+  my $self = shift;
+  
+  GetSpecifiedAttributeCount($self->{Parser});
+}
+
+sub finish {
+  my ($self) = @_;
+  my $parser = $self->{Parser};
+  UnsetAllHandlers($parser);
+}
+
+sub position_in_context {
+  my ($self, $lines) = @_;
+  my $parser = $self->{Parser};
+  my ($string, $linepos) = PositionContext($parser, $lines);
+
+  return '' unless defined($string);
+
+  my $col = GetCurrentColumnNumber($parser);
+  my $ptr = ('=' x ($col - 1)) . '^' . "\n";
+  my $ret;
+  my $dosplit = $linepos < length($string);
+  
+  $string .= "\n" unless $string =~ /\n$/;
+  
+  if ($dosplit) {
+    $ret = substr($string, 0, $linepos) . $ptr
+      . substr($string, $linepos);
+  } else {
+    $ret = $string . $ptr;
+  }
+  
+  $ret;
+}
+
+sub xml_escape {
+  my $self = shift;
+  my $text = shift;
+
+  study $text;
+  $text =~ s/\&/\&amp;/g;
+  $text =~ s/</\&lt;/g;
+  foreach (@_) {
+    if ($_ eq '>') {
+      $text =~ s/>/\&gt;/g;
+    }
+    elsif ($_ eq '"') {
+      $text =~ s/\"/\&quot;/;
+    }
+    elsif ($_ eq "'") {
+      $text =~ s/\'/\&apos;/;
+    }
+    else {
+      my $rep = '&#' . sprintf('x%X', ord($_)) . ';';
+      $text =~ s/$_/$rep/g;
+    }
+  }
+  $text;
+}
+
+sub skip_until {
+  my $self = shift;
+  SkipUntil($self->{Parser}, $_[0]);
+}
+
+sub release {
+  my $self = shift;
+  ParserRelease($self->{Parser});
+}
+
+sub DESTROY {
+  my $self = shift;
+  ParserFree($self->{Parser});
+}
+
+sub parse {
+  my $self = shift;
+  my $arg = shift;
+  croak "Parse already in progress (Expat)" if $self->{Used};
+  $self->{Used} = 1;
+  my $parser = $self->{Parser};
+  my $ioref;
+  my $result = 0;
+  
+  if (defined $arg) {
+    if (ref($arg) and UNIVERSAL::isa($arg, 'IO::Handler')) {
+      $ioref = $arg;
+    } else {
+      eval {
+	$ioref = *{$arg}{IO};
+      };
+    }
+  }
+  
+  if (defined($ioref)) {
+    my $delim = $self->{Stream_Delimiter};
+    my $prev_rs;
+    
+    $prev_rs = ref($ioref)->input_record_separator("\n$delim\n")
+      if defined($delim);
+    
+    $result = ParseStream($parser, $ioref, $delim);
+    
+    ref($ioref)->input_record_separator($prev_rs)
+      if defined($delim);
+  } else {
+    $result = ParseString($parser, $arg);
+  }
+  
+  $result or croak $self->{ErrorMessage};
+}
+
+sub parsestring {
+  my $self = shift;
+  $self->parse(@_);
+}
+
+sub parsefile {
+  my $self = shift;
+  croak "Parser has already been used" if $self->{Used};
+  local(*FILE);
+  open(FILE, $_[0]) or  croak "Couldn't open $_[0]:\n$!";
+  binmode(FILE);
+  my $ret = $self->parse(*FILE);
+  close(FILE);
+  $ret;
+}
+
+################################################################
+package XML::Parser::ExpatNB;
+
+use vars qw(@ISA);
+use Carp;
+
+@ISA = qw(XML::Parser::Expat);
+
+sub parse {
+  my $self = shift;
+  my $class = ref($self);
+  croak "parse method not supported in $class";
+}
+
+sub parsestring {
+  my $self = shift;
+  my $class = ref($self);
+  croak "parsestring method not supported in $class";
+}
+
+sub parsefile {
+  my $self = shift;
+  my $class = ref($self);
+  croak "parsefile method not supported in $class";
+}
+
+sub parse_more {
+  my ($self, $data) = @_;
+
+  my $ret = XML::Parser::Expat::ParsePartial($self->{Parser}, $data);
+
+  croak $self->{ErrorMessage} unless $ret;
+}
+
+sub parse_done {
+  my $self = shift;
+
+  my $ret = XML::Parser::Expat::ParseDone($self->{Parser});
+  unless ($ret) {
+    my $msg = $self->{ErrorMessage};
+    $self->release;
+    croak $msg;
+  }
+
+  my $result = $ret;
+  my @result = ();
+  my $final = $self->{FinalHandler};
+  if (defined $final) {
+    if (wantarray) {
+      @result = &$final($self);
+    }
+    else {
+      $result = &$final($self);
+    }
+  }
+
+  $self->release;
+
+  return unless defined wantarray;
+  return wantarray ? @result : $result;
+}
+
+################################################################
+
+package XML::Parser::Encinfo;
+
+sub DESTROY {
+  my $self = shift;
+  XML::Parser::Expat::FreeEncoding($self);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+XML::Parser::Expat - Lowlevel access to James Clark's expat XML parser
+
+=head1 SYNOPSIS
+
+ use XML::Parser::Expat;
+
+ $parser = new XML::Parser::Expat;
+ $parser->setHandlers('Start' => \&sh,
+		      'End'   => \&eh,
+                      'Char'  => \&ch);
+ open(FOO, 'info.xml') or die "Couldn't open";
+ $parser->parse(*FOO);
+ close(FOO);
+ # $parser->parse('<foo id="me"> here <em>we</em> go </foo>');
+
+ sub sh
+ {
+   my ($p, $el, %atts) = @_;
+   $p->setHandlers('Char' => \&spec)
+     if ($el eq 'special');
+   ...
+ }
+
+ sub eh
+ {
+   my ($p, $el) = @_;
+   $p->setHandlers('Char' => \&ch)  # Special elements won't contain
+     if ($el eq 'special');         # other special elements
+   ...
+ } 
+
+=head1 DESCRIPTION
+
+This module provides an interface to James Clark's XML parser, expat. As in
+expat, a single instance of the parser can only parse one document. Calls
+to parsestring after the first for a given instance will die.
+
+Expat (and XML::Parser::Expat) are event based. As the parser recognizes
+parts of the document (say the start or end of an XML element), then any
+handlers registered for that type of an event are called with suitable
+parameters.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+This is a class method, the constructor for XML::Parser::Expat. Options are
+passed as keyword value pairs. The recognized options are:
+
+=over 4
+
+=item * ProtocolEncoding
+
+The protocol encoding name. The default is none. The expat built-in
+encodings are: C<UTF-8>, C<ISO-8859-1>, C<UTF-16>, and C<US-ASCII>.
+Other encodings may be used if they have encoding maps in one of the
+directories in the @Encoding_Path list. Setting the protocol encoding
+overrides any encoding in the XML declaration.
+
+=item * Namespaces
+
+When this option is given with a true value, then the parser does namespace
+processing. By default, namespace processing is turned off. When it is
+turned on, the parser consumes I<xmlns> attributes and strips off prefixes
+from element and attributes names where those prefixes have a defined
+namespace. A name's namespace can be found using the L<"namespace"> method
+and two names can be checked for absolute equality with the L<"eq_name">
+method.
+
+=item * NoExpand
+
+Normally, the parser will try to expand references to entities defined in
+the internal subset. If this option is set to a true value, and a default
+handler is also set, then the default handler will be called when an
+entity reference is seen in text. This has no effect if a default handler
+has not been registered, and it has no effect on the expansion of entity
+references inside attribute values.
+
+=item * Stream_Delimiter
+
+This option takes a string value. When this string is found alone on a line
+while parsing from a stream, then the parse is ended as if it saw an end of
+file. The intended use is with a stream of xml documents in a MIME multipart
+format. The string should not contain a trailing newline.
+
+=item * ErrorContext
+
+When this option is defined, errors are reported in context. The value
+of ErrorContext should be the number of lines to show on either side of
+the line in which the error occurred.
+
+=item * ParseParamEnt
+
+Unless standalone is set to "yes" in the XML declaration, setting this to
+a true value allows the external DTD to be read, and parameter entities
+to be parsed and expanded.
+
+=item * Base
+
+The base to use for relative pathnames or URLs. This can also be done by
+using the base method.
+
+=back
+
+=item setHandlers(TYPE, HANDLER [, TYPE, HANDLER [...]])
+
+This method registers handlers for the various events. If no handlers are
+registered, then a call to parsestring or parsefile will only determine if
+the corresponding XML document is well formed (by returning without error.)
+This may be called from within a handler, after the parse has started.
+
+Setting a handler to something that evaluates to false unsets that
+handler.
+
+This method returns a list of type, handler pairs corresponding to the
+input. The handlers returned are the ones that were in effect before the
+call to setHandlers.
+
+The recognized events and the parameters passed to the corresponding
+handlers are:
+
+=over 4
+
+=item * Start		(Parser, Element [, Attr, Val [,...]])
+
+This event is generated when an XML start tag is recognized. Parser is
+an XML::Parser::Expat instance. Element is the name of the XML element that
+is opened with the start tag. The Attr & Val pairs are generated for each
+attribute in the start tag.
+
+=item * End		(Parser, Element)
+
+This event is generated when an XML end tag is recognized. Note that
+an XML empty tag (<foo/>) generates both a start and an end event.
+
+There is always a lower level start and end handler installed that wrap
+the corresponding callbacks. This is to handle the context mechanism.
+A consequence of this is that the default handler (see below) will not
+see a start tag or end tag unless the default_current method is called.
+
+=item * Char		(Parser, String)
+
+This event is generated when non-markup is recognized. The non-markup
+sequence of characters is in String. A single non-markup sequence of
+characters may generate multiple calls to this handler. Whatever the
+encoding of the string in the original document, this is given to the
+handler in UTF-8.
+
+=item * Proc		(Parser, Target, Data)
+
+This event is generated when a processing instruction is recognized.
+
+=item * Comment		(Parser, String)
+
+This event is generated when a comment is recognized.
+
+=item * CdataStart	(Parser)
+
+This is called at the start of a CDATA section.
+
+=item * CdataEnd	(Parser)
+
+This is called at the end of a CDATA section.
+
+=item * Default		(Parser, String)
+
+This is called for any characters that don't have a registered handler.
+This includes both characters that are part of markup for which no
+events are generated (markup declarations) and characters that
+could generate events, but for which no handler has been registered.
+
+Whatever the encoding in the original document, the string is returned to
+the handler in UTF-8.
+
+=item * Unparsed		(Parser, Entity, Base, Sysid, Pubid, Notation)
+
+This is called for a declaration of an unparsed entity. Entity is the name
+of the entity. Base is the base to be used for resolving a relative URI.
+Sysid is the system id. Pubid is the public id. Notation is the notation
+name. Base and Pubid may be undefined.
+
+=item * Notation		(Parser, Notation, Base, Sysid, Pubid)
+
+This is called for a declaration of notation. Notation is the notation name.
+Base is the base to be used for resolving a relative URI. Sysid is the system
+id. Pubid is the public id. Base, Sysid, and Pubid may all be undefined.
+
+=item * ExternEnt		(Parser, Base, Sysid, Pubid)
+
+This is called when an external entity is referenced. Base is the base to be
+used for resolving a relative URI. Sysid is the system id. Pubid is the public
+id. Base, and Pubid may be undefined.
+
+This handler should either return a string, which represents the contents of
+the external entity, or return an open filehandle that can be read to obtain
+the contents of the external entity, or return undef, which indicates the
+external entity couldn't be found and will generate a parse error.
+
+If an open filehandle is returned, it must be returned as either a glob
+(*FOO) or as a reference to a glob (e.g. an instance of IO::Handle). The
+parser will close the filehandle after using it.
+
+=item * Entity			(Parser, Name, Val, Sysid, Pubid, Ndata)
+
+This is called when an entity is declared. For internal entities, the Val
+parameter will contain the value and the remaining three parameters will
+be undefined. For external entities, the Val parameter
+will be undefined, the Sysid parameter will have the system id, the Pubid
+parameter will have the public id if it was provided (it will be undefined
+otherwise), the Ndata parameter will contain the notation for unparsed
+entities. If this is a parameter entity declaration, then a '%' will be
+prefixed to the name.
+
+Note that this handler and the Unparsed handler above overlap. If both are
+set, then this handler will not be called for unparsed entities.
+
+=item * Element			(Parser, Name, Model)
+
+The element handler is called when an element declaration is found. Name is
+the element name, and Model is the content model as a string.
+
+=item * Attlist			(Parser, Elname, Attname, Type, Default, Fixed)
+
+This handler is called for each attribute in an ATTLIST declaration.
+So an ATTLIST declaration that has multiple attributes
+will generate multiple calls to this handler. The Elname parameter is the
+name of the element with which the attribute is being associated. The Attname
+parameter is the name of the attribute. Type is the attribute type, given as
+a string. Default is the default value, which will either be "#REQUIRED",
+"#IMPLIED" or a quoted string (i.e. the returned string will begin and end
+with a quote character). If Fixed is true, then this is a fixed attribute.
+
+=item * Doctype			(Parser, Name, Sysid, Pubid, Internal)
+
+This handler is called for DOCTYPE declarations. Name is the document type
+name. Sysid is the system id of the document type, if it was provided,
+otherwise it's undefined. Pubid is the public id of the document type,
+which will be undefined if no public id was given. Internal is the internal
+subset, given as a string. If there was no internal subset, it will be
+undefined. Internal will contain all whitespace, comments, processing
+instructions, and declarations seen in the internal subset. The declarations
+will be there whether or not they have been processed by another handler
+(except for unparsed entities processed by the Unparsed handler). However,
+comments and processing instructions will not appear if they've been processed
+by their respective handlers.
+
+=item * XMLDecl			(Parser, Version, Encoding, Standalone)
+
+This handler is called for xml declarations. Version is a string containg
+the version. Encoding is either undefined or contains an encoding string.
+Standalone will be either true, false, or undefined if the standalone attribute
+is yes, no, or not made respectively.
+
+=back
+
+=item namespace(name)
+
+Return the URI of the namespace that the name belongs to. If the name doesn't
+belong to any namespace, an undef is returned. This is only valid on names
+received through the Start or End handlers from a single document, or through
+a call to the generate_ns_name method. In other words, don't use names
+generated from one instance of XML::Parser::Expat with other instances.
+
+=item eq_name(name1, name2)
+
+Return true if name1 and name2 are identical (i.e. same name and from
+the same namespace.) This is only meaningful if both names were obtained
+through the Start or End handlers from a single document, or through
+a call to the generate_ns_name method.
+
+=item generate_ns_name(name, namespace)
+
+Return a name, associated with a given namespace, good for using with the
+above 2 methods. The namespace argument should be the namespace URI, not
+a prefix.
+
+=item new_ns_prefixes
+
+When called from a start tag handler, returns namespace prefixes declared
+with this start tag. If called elsewere (or if there were no namespace
+prefixes declared), it returns an empty list. Setting of the default
+namespace is indicated with '#default' as a prefix.
+
+=item expand_ns_prefix(prefix)
+
+Return the uri to which the given prefix is currently bound. Returns
+undef if the prefix isn't currently bound. Use '#default' to find the
+current binding of the default namespace (if any).
+
+=item current_ns_prefixes
+
+Return a list of currently bound namespace prefixes. The order of the
+the prefixes in the list has no meaning. If the default namespace is
+currently bound, '#default' appears in the list.
+
+=item recognized_string
+
+Returns the string from the document that was recognized in order to call
+the current handler. For instance, when called from a start handler, it
+will give us the the start-tag string. The string is encoded in UTF-8.
+
+=item original_string
+
+Returns the verbatim string from the document that was recognized in
+order to call the current handler. The string is in the original document
+encoding.
+
+=item default_current
+
+When called from a handler, causes the sequence of characters that generated
+the corresponding event to be sent to the default handler (if one is
+registered). Use of this method is deprecated in favor the recognized_string
+method, which you can use without installing a default handler.
+
+=item xpcroak(message)
+
+Concatenate onto the given message the current line number within the
+XML document plus the message implied by ErrorContext. Then croak with
+the formed message.
+
+=item xpcarp(message)
+
+Concatenate onto the given message the current line number within the
+XML document plus the message implied by ErrorContext. Then carp with
+the formed message.
+
+=item current_line
+
+Returns the line number of the current position of the parse.
+
+=item current_column
+
+Returns the column number of the current position of the parse.
+
+=item current_byte
+
+Returns the current position of the parse.
+
+=item base([NEWBASE]);
+
+Returns the current value of the base for resolving relative URIs. If
+NEWBASE is supplied, changes the base to that value.
+
+=item context
+
+Returns a list of element names that represent open elements, with the
+last one being the innermost. Inside start and end tag handlers, this
+will be the tag of the parent element.
+
+=item current_element
+
+Returns the name of the innermost currently opened element. Inside
+start or end handlers, returns the parent of the element associated
+with those tags.
+
+=item in_element(NAME)
+
+Returns true if NAME is equal to the name of the innermost currently opened
+element. If namespace processing is being used and you want to check
+against a name that may be in a namespace, then use the generate_ns_name
+method to create the NAME argument.
+
+=item within_element(NAME)
+
+Returns the number of times the given name appears in the context list.
+If namespace processing is being used and you want to check
+against a name that may be in a namespace, then use the generate_ns_name
+method to create the NAME argument.
+
+=item depth
+
+Returns the size of the context list.
+
+=item element_index
+
+Returns an integer that is the depth-first visit order of the current
+element. This will be zero outside of the root element. For example,
+this will return 1 when called from the start handler for the root element
+start tag.
+
+=item skip_until(INDEX)
+
+INDEX is an integer that represents an element index. When this method
+is called, all handlers are suspended until the start tag for an element
+that has an index number equal to INDEX is seen. If a start handler has
+been set, then this is the first tag that the start handler will see
+after skip_until has been called.
+
+
+=item position_in_context(LINES)
+
+Returns a string that shows the current parse position. LINES should be
+an integer >= 0 that represents the number of lines on either side of the
+current parse line to place into the returned string.
+
+=item xml_escape(TEXT [, CHAR [, CHAR ...]])
+
+Returns TEXT with markup characters turned into character entities. Any
+additional characters provided as arguments are also turned into character
+references where found in TEXT.
+
+=item parse (SOURCE)
+
+The SOURCE parameter should either be a string containing the whole XML
+document, or it should be an open IO::Handle. Only a single document
+may be parsed for a given instance of XML::Parser::Expat, so this will croak
+if it's been called previously for this instance.
+
+=item parsestring(XML_DOC_STRING)
+
+Parses the given string as an XML document. Only a single document may be
+parsed for a given instance of XML::Parser::Expat, so this will die if either
+parsestring or parsefile has been called for this instance previously.
+
+This method is deprecated in favor of the parse method.
+
+=item parsefile(FILENAME)
+
+Parses the XML document in the given file. Will die if parsestring or
+parsefile has been called previously for this instance.
+
+=item is_defaulted(ATTNAME)
+
+NO LONGER WORKS. To find out if an attribute is defaulted please use
+the specified_attr method.
+
+=item specified_attr
+
+When the start handler receives lists of attributes and values, the
+non-defaulted (i.e. explicitly specified) attributes occur in the list
+first. This method returns the number of specified items in the list.
+So if this number is equal to the length of the list, there were no
+defaulted values. Otherwise the number points to the index of the
+first defaulted attribute name.
+
+=item finish
+
+Unsets all handlers (including internal ones that set context), but expat
+continues parsing to the end of the document or until it finds an error.
+It should finish up a lot faster than with the handlers set.
+
+=item release
+
+There are data structures used by XML::Parser::Expat that have circular
+references. This means that these structures will never be garbage
+collected unless these references are explicitly broken. Calling this
+method breaks those references (and makes the instance unusable.)
+
+Normally, higher level calls handle this for you, but if you are using
+XML::Parser::Expat directly, then it's your responsibility to call it.
+
+=back
+
+=head2 XML::Parser::ExpatNB Methods
+
+The class XML::Parser::ExpatNB is a subclass of XML::Parser::Expat used
+for non-blocking access to the expat library. It does not support the parse,
+parsestring, or parsefile methods, but it does have these additional methods:
+
+=over 4
+
+=item parse_more(DATA)
+
+Feed expat more text to munch on.
+
+=item parse_done
+
+Tell expat that it's gotten the whole document.
+
+=back
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item XML::Parser::Expat::load_encoding(ENCODING)
+
+Load an external encoding. ENCODING is either the name of an encoding or
+the name of a file. The basename is converted to lowercase and a '.enc'
+extension is appended unless there's one already there. Then, unless
+it's an absolute pathname (i.e. begins with '/'), the first file by that
+name discovered in the @Encoding_Path path list is used.
+
+The encoding in the file is loaded and kept in the %Encoding_Table
+table. Earlier encodings of the same name are replaced.
+
+This function is automaticly called by expat when it encounters an encoding
+it doesn't know about. Expat shouldn't call this twice for the same
+encoding name. The only reason users should use this function is to
+explicitly load an encoding not contained in the @Encoding_Path list.
+
+=back
+
+=head1 AUTHORS
+
+Larry Wall <F<larry@wall.org>> wrote version 1.0.
+
+Clark Cooper <F<coopercc@netheaven.com>> picked up support, changed the API
+for this version (2.x), provided documentation, and added some standard
+package features.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/XSLoader.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/XSLoader.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/XSLoader.pm	(revision 14265)
@@ -0,0 +1,129 @@
+# Generated from XSLoader.pm.PL (resolved %Config::Config value)
+
+package XSLoader;
+
+#   And Gandalf said: 'Many folk like to know beforehand what is to
+#   be set on the table; but those who have laboured to prepare the
+#   feast like to keep their secret; for wonder makes the words of
+#   praise louder.'
+
+#   (Quote from Tolkien sugested by Anno Siegel.)
+#
+# See pod text at end of file for documentation.
+# See also ext/DynaLoader/README in source tree for other information.
+#
+# Tim.Bunce@ig.co.uk, August 1994
+
+$VERSION = "0.01";	# avoid typo warning
+
+# enable debug/trace messages from DynaLoader perl code
+# $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
+
+  my $dl_dlext = 'dll';
+
+package DynaLoader;
+
+# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
+# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB
+boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
+                                !defined(&dl_error);
+package XSLoader;
+
+1; # End of main code
+
+# The bootstrap function cannot be autoloaded (without complications)
+# so we define it here:
+
+sub load {
+    package DynaLoader;
+
+    my($module) = $_[0];
+
+    # work with static linking too
+    my $b = "$module\::bootstrap";
+    goto &$b if defined &$b;
+
+    goto retry unless $module and defined &dl_load_file;
+
+    my @modparts = split(/::/,$module);
+    my $modfname = $modparts[-1];
+
+    my $modpname = join('/',@modparts);
+    my $modlibname = (caller())[1];
+    my $c = @modparts;
+    $modlibname =~ s,[\\/][^\\/]+$,, while $c--;	# Q&D basename
+    my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext";
+
+#   print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug;
+
+    my $bs = $file;
+    $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
+
+    goto retry if not -f $file or -s $bs;
+
+    my $bootname = "boot_$module";
+    $bootname =~ s/\W/_/g;
+    @dl_require_symbols = ($bootname);
+
+    # Many dynamic extension loading problems will appear to come from
+    # this section of code: XYZ failed at line 123 of DynaLoader.pm.
+    # Often these errors are actually occurring in the initialisation
+    # C code of the extension XS file. Perl reports the error as being
+    # in this perl code simply because this was the last perl code
+    # it executed.
+
+    my $libref = dl_load_file($file, 0) or do { 
+	require Carp;
+	Carp::croak("Can't load '$file' for module $module: " . dl_error());
+    };
+    push(@dl_librefs,$libref);  # record loaded object
+
+    my @unresolved = dl_undef_symbols();
+    if (@unresolved) {
+	require Carp;
+	Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
+    }
+
+    my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
+	require Carp;
+	Carp::croak("Can't find '$bootname' symbol in $file\n");
+    };
+
+    my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
+
+    push(@dl_modules, $module); # record loaded module
+
+    # See comment block above
+    return &$xs(@_);
+
+  retry:
+    require DynaLoader;
+    goto &DynaLoader::bootstrap_inherit;
+}
+
+__END__
+
+=head1 NAME
+
+XSLoader - Dynamically load C libraries into Perl code
+
+=head1 SYNOPSIS
+
+    package YourPackage;
+    use XSLoader;
+
+    XSLoader::load 'YourPackage', @args;
+
+=head1 DESCRIPTION
+
+This module defines a standard I<simplified> interface to the dynamic
+linking mechanisms available on many platforms.  Its primary purpose is
+to implement cheap automatic dynamic loading of Perl modules.
+
+For more complicated interface see L<DynaLoader>.
+
+=head1 AUTHOR
+
+Ilya Zakharevich: extraction from DynaLoader.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/attributes.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/attributes.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/attributes.pm	(revision 14265)
@@ -0,0 +1,399 @@
+package attributes;
+
+$VERSION = 0.03;
+
+@EXPORT_OK = qw(get reftype);
+@EXPORT = ();
+%EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]);
+
+use strict;
+
+sub croak {
+    require Carp;
+    goto &Carp::croak;
+}
+
+sub carp {
+    require Carp;
+    goto &Carp::carp;
+}
+
+## forward declaration(s) rather than wrapping the bootstrap call in BEGIN{}
+#sub reftype ($) ;
+#sub _fetch_attrs ($) ;
+#sub _guess_stash ($) ;
+#sub _modify_attrs ;
+#sub _warn_reserved () ;
+#
+# The extra trips through newATTRSUB in the interpreter wipe out any savings
+# from avoiding the BEGIN block.  Just do the bootstrap now.
+BEGIN { bootstrap }
+
+sub import {
+    @_ > 2 && ref $_[2] or do {
+	require Exporter;
+	goto &Exporter::import;
+    };
+    my (undef,$home_stash,$svref,@attrs) = @_;
+
+    my $svtype = uc reftype($svref);
+    my $pkgmeth;
+    $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES")
+	if defined $home_stash && $home_stash ne '';
+    my @badattrs;
+    if ($pkgmeth) {
+	my @pkgattrs = _modify_attrs($svref, @attrs);
+	@badattrs = $pkgmeth->($home_stash, $svref, @attrs);
+	if (!@badattrs && @pkgattrs) {
+	    return unless _warn_reserved;
+	    @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs;
+	    if (@pkgattrs) {
+		for my $attr (@pkgattrs) {
+		    $attr =~ s/\(.+\z//s;
+		}
+		my $s = ((@pkgattrs == 1) ? '' : 's');
+		carp "$svtype package attribute$s " .
+		    "may clash with future reserved word$s: " .
+		    join(' : ' , @pkgattrs);
+	    }
+	}
+    }
+    else {
+	@badattrs = _modify_attrs($svref, @attrs);
+    }
+    if (@badattrs) {
+	croak "Invalid $svtype attribute" .
+	    (( @badattrs == 1 ) ? '' : 's') .
+	    ": " .
+	    join(' : ', @badattrs);
+    }
+}
+
+sub get ($) {
+    @_ == 1  && ref $_[0] or
+	croak 'Usage: '.__PACKAGE__.'::get $ref';
+    my $svref = shift;
+    my $svtype = uc reftype $svref;
+    my $stash = _guess_stash $svref;
+    $stash = caller unless defined $stash;
+    my $pkgmeth;
+    $pkgmeth = UNIVERSAL::can($stash, "FETCH_${svtype}_ATTRIBUTES")
+	if defined $stash && $stash ne '';
+    return $pkgmeth ?
+		(_fetch_attrs($svref), $pkgmeth->($stash, $svref)) :
+		(_fetch_attrs($svref))
+	;
+}
+
+sub require_version { goto &UNIVERSAL::VERSION }
+
+1;
+__END__
+#The POD goes here
+
+=head1 NAME
+
+attributes - get/set subroutine or variable attributes
+
+=head1 SYNOPSIS
+
+  sub foo : method ;
+  my ($x,@y,%z) : Bent ;
+  my $s = sub : method { ... };
+
+  use attributes ();	# optional, to get subroutine declarations
+  my @attrlist = attributes::get(\&foo);
+
+  use attributes 'get'; # import the attributes::get subroutine
+  my @attrlist = get \&foo;
+
+=head1 DESCRIPTION
+
+Subroutine declarations and definitions may optionally have attribute lists
+associated with them.  (Variable C<my> declarations also may, but see the
+warning below.)  Perl handles these declarations by passing some information
+about the call site and the thing being declared along with the attribute
+list to this module.  In particular, the first example above is equivalent to
+the following:
+
+    use attributes __PACKAGE__, \&foo, 'method';
+
+The second example in the synopsis does something equivalent to this:
+
+    use attributes __PACKAGE__, \$x, 'Bent';
+    use attributes __PACKAGE__, \@y, 'Bent';
+    use attributes __PACKAGE__, \%z, 'Bent';
+
+Yes, that's three invocations.
+
+B<WARNING>: attribute declarations for variables are an I<experimental>
+feature.  The semantics of such declarations could change or be removed
+in future versions.  They are present for purposes of experimentation
+with what the semantics ought to be.  Do not rely on the current
+implementation of this feature.
+
+There are only a few attributes currently handled by Perl itself (or
+directly by this module, depending on how you look at it.)  However,
+package-specific attributes are allowed by an extension mechanism.
+(See L<"Package-specific Attribute Handling"> below.)
+
+The setting of attributes happens at compile time.  An attempt to set
+an unrecognized attribute is a fatal error.  (The error is trappable, but
+it still stops the compilation within that C<eval>.)  Setting an attribute
+with a name that's all lowercase letters that's not a built-in attribute
+(such as "foo")
+will result in a warning with B<-w> or C<use warnings 'reserved'>.
+
+=head2 Built-in Attributes
+
+The following are the built-in attributes for subroutines:
+
+=over 4
+
+=item locked
+
+Setting this attribute is only meaningful when the subroutine or
+method is to be called by multiple threads.  When set on a method
+subroutine (i.e., one marked with the B<method> attribute below),
+Perl ensures that any invocation of it implicitly locks its first
+argument before execution.  When set on a non-method subroutine,
+Perl ensures that a lock is taken on the subroutine itself before
+execution.  The semantics of the lock are exactly those of one
+explicitly taken with the C<lock> operator immediately after the
+subroutine is entered.
+
+=item method
+
+Indicates that the referenced subroutine is a method.
+This has a meaning when taken together with the B<locked> attribute,
+as described there.  It also means that a subroutine so marked
+will not trigger the "Ambiguous call resolved as CORE::%s" warning.
+
+=item lvalue
+
+Indicates that the referenced subroutine is a valid lvalue and can
+be assigned to. The subroutine must return a modifiable value such
+as a scalar variable, as described in L<perlsub>.
+
+=back
+
+There are no built-in attributes for anything other than subroutines.
+
+=head2 Available Subroutines
+
+The following subroutines are available for general use once this module
+has been loaded:
+
+=over 4
+
+=item get
+
+This routine expects a single parameter--a reference to a
+subroutine or variable.  It returns a list of attributes, which may be
+empty.  If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>)
+to raise a fatal exception.  If it can find an appropriate package name
+for a class method lookup, it will include the results from a
+C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in
+L<"Package-specific Attribute Handling"> below.
+Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned.
+
+=item reftype
+
+This routine expects a single parameter--a reference to a subroutine or
+variable.  It returns the built-in type of the referenced variable,
+ignoring any package into which it might have been blessed.
+This can be useful for determining the I<type> value which forms part of
+the method names described in L<"Package-specific Attribute Handling"> below.
+
+=back
+
+Note that these routines are I<not> exported by default.
+
+=head2 Package-specific Attribute Handling
+
+B<WARNING>: the mechanisms described here are still experimental.  Do not
+rely on the current implementation.  In particular, there is no provision
+for applying package attributes to 'cloned' copies of subroutines used as
+closures.  (See L<perlref/"Making References"> for information on closures.)
+Package-specific attribute handling may change incompatibly in a future
+release.
+
+When an attribute list is present in a declaration, a check is made to see
+whether an attribute 'modify' handler is present in the appropriate package
+(or its @ISA inheritance tree).  Similarly, when C<attributes::get> is
+called on a valid reference, a check is made for an appropriate attribute
+'fetch' handler.  See L<"EXAMPLES"> to see how the "appropriate package"
+determination works.
+
+The handler names are based on the underlying type of the variable being
+declared or of the reference passed.  Because these attributes are
+associated with subroutine or variable declarations, this deliberately
+ignores any possibility of being blessed into some package.  Thus, a
+subroutine declaration uses "CODE" as its I<type>, and even a blessed
+hash reference uses "HASH" as its I<type>.
+
+The class methods invoked for modifying and fetching are these:
+
+=over 4
+
+=item FETCH_I<type>_ATTRIBUTES
+
+This method receives a single argument, which is a reference to the
+variable or subroutine for which package-defined attributes are desired.
+The expected return value is a list of associated attributes.
+This list may be empty.
+
+=item MODIFY_I<type>_ATTRIBUTES
+
+This method is called with two fixed arguments, followed by the list of
+attributes from the relevant declaration.  The two fixed arguments are
+the relevant package name and a reference to the declared subroutine or
+variable.  The expected return value as a list of attributes which were
+not recognized by this handler.  Note that this allows for a derived class
+to delegate a call to its base class, and then only examine the attributes
+which the base class didn't already handle for it.
+
+The call to this method is currently made I<during> the processing of the
+declaration.  In particular, this means that a subroutine reference will
+probably be for an undefined subroutine, even if this declaration is
+actually part of the definition.
+
+=back
+
+Calling C<attributes::get()> from within the scope of a null package
+declaration C<package ;> for an unblessed variable reference will
+not provide any starting package name for the 'fetch' method lookup.
+Thus, this circumstance will not result in a method call for package-defined
+attributes.  A named subroutine knows to which symbol table entry it belongs
+(or originally belonged), and it will use the corresponding package.
+An anonymous subroutine knows the package name into which it was compiled
+(unless it was also compiled with a null package declaration), and so it
+will use that package name.
+
+=head2 Syntax of Attribute Lists
+
+An attribute list is a sequence of attribute specifications, separated by
+whitespace or a colon (with optional whitespace).
+Each attribute specification is a simple
+name, optionally followed by a parenthesised parameter list.
+If such a parameter list is present, it is scanned past as for the rules
+for the C<q()> operator.  (See L<perlop/"Quote and Quote-like Operators">.)
+The parameter list is passed as it was found, however, and not as per C<q()>.
+
+Some examples of syntactically valid attribute lists:
+
+    switch(10,foo(7,3))  :  expensive
+    Ugly('\(") :Bad
+    _5x5
+    locked method
+
+Some examples of syntactically invalid attribute lists (with annotation):
+
+    switch(10,foo()		# ()-string not balanced
+    Ugly('(')			# ()-string not balanced
+    5x5				# "5x5" not a valid identifier
+    Y2::north			# "Y2::north" not a simple identifier
+    foo + bar			# "+" neither a colon nor whitespace
+
+=head1 EXPORTS
+
+=head2 Default exports
+
+None.
+
+=head2 Available exports
+
+The routines C<get> and C<reftype> are exportable.
+
+=head2 Export tags defined
+
+The C<:ALL> tag will get all of the above exports.
+
+=head1 EXAMPLES
+
+Here are some samples of syntactically valid declarations, with annotation
+as to how they resolve internally into C<use attributes> invocations by
+perl.  These examples are primarily useful to see how the "appropriate
+package" is found for the possible method lookups for package-defined
+attributes.
+
+=over 4
+
+=item 1.
+
+Code:
+
+    package Canine;
+    package Dog;
+    my Canine $spot : Watchful ;
+
+Effect:
+
+    use attributes Canine => \$spot, "Watchful";
+
+=item 2.
+
+Code:
+
+    package Felis;
+    my $cat : Nervous;
+
+Effect:
+
+    use attributes Felis => \$cat, "Nervous";
+
+=item 3.
+
+Code:
+
+    package X;
+    sub foo : locked ;
+
+Effect:
+
+    use attributes X => \&foo, "locked";
+
+=item 4.
+
+Code:
+
+    package X;
+    sub Y::x : locked { 1 }
+
+Effect:
+
+    use attributes Y => \&Y::x, "locked";
+
+=item 5.
+
+Code:
+
+    package X;
+    sub foo { 1 }
+
+    package Y;
+    BEGIN { *bar = \&X::foo; }
+
+    package Z;
+    sub Y::bar : locked ;
+
+Effect:
+
+    use attributes X => \&X::foo, "locked";
+
+=back
+
+This last example is purely for purposes of completeness.  You should not
+be trying to mess with the attributes of something in a package that's
+not your own.
+
+=head1 SEE ALSO
+
+L<perlsub/"Private Variables via my()"> and
+L<perlsub/"Subroutine Attributes"> for details on the basic declarations;
+L<attrs> for the obsolescent form of subroutine attribute specification
+which this module replaces;
+L<perlfunc/use> for details on the normal invocation mechanism.
+
+=cut
+
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/DynaLoader/autosplit.ix
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/DynaLoader/autosplit.ix	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/DynaLoader/autosplit.ix	(revision 14265)
@@ -0,0 +1,8 @@
+# Index created by AutoSplit for ../LIB\DynaLoader.pm
+#    (file acts as timestamp)
+package DynaLoader;
+sub dl_findfile  ;
+sub dl_expandspec  ;
+sub dl_find_symbol_anywhere 
+;
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/DynaLoader/dl_expandspec.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/DynaLoader/dl_expandspec.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/DynaLoader/dl_expandspec.al	(revision 14265)
@@ -0,0 +1,34 @@
+# NOTE: Derived from ../LIB\DynaLoader.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package DynaLoader;
+
+#line 349 "../LIB\DynaLoader.pm (autosplit into ..\lib\auto\DynaLoader\dl_expandspec.al)"
+sub dl_expandspec {
+    my($spec) = @_;
+    # Optional function invoked if DynaLoader.pm sets $do_expand.
+    # Most systems do not require or use this function.
+    # Some systems may implement it in the dl_*.xs file in which case
+    # this autoload version will not be called but is harmless.
+
+    # This function is designed to deal with systems which treat some
+    # 'filenames' in a special way. For example VMS 'Logical Names'
+    # (something like unix environment variables - but different).
+    # This function should recognise such names and expand them into
+    # full file paths.
+    # Must return undef if $spec is invalid or file does not exist.
+
+    my $file = $spec; # default output to input
+
+    if ($Is_VMS) { # dl_expandspec should be defined in dl_vms.xs
+	require Carp;
+	Carp::croak("dl_expandspec: should be defined in XS file!\n");
+    } else {
+	return undef unless -f $file;
+    }
+    print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug;
+    $file;
+}
+
+# end of DynaLoader::dl_expandspec
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/DynaLoader/dl_find_symbol_anywhere.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/DynaLoader/dl_find_symbol_anywhere.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/DynaLoader/dl_find_symbol_anywhere.al	(revision 14265)
@@ -0,0 +1,19 @@
+# NOTE: Derived from ../LIB\DynaLoader.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package DynaLoader;
+
+#line 375 "../LIB\DynaLoader.pm (autosplit into ..\lib\auto\DynaLoader\dl_find_symbol_anywhere.al)"
+sub dl_find_symbol_anywhere
+{
+    my $sym = shift;
+    my $libref;
+    foreach $libref (@dl_librefs) {
+	my $symref = dl_find_symbol($libref,$sym);
+	return $symref if $symref;
+    }
+    return undef;
+}
+
+1;
+# end of DynaLoader::dl_find_symbol_anywhere
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/DynaLoader/dl_findfile.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/DynaLoader/dl_findfile.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/DynaLoader/dl_findfile.al	(revision 14265)
@@ -0,0 +1,115 @@
+# NOTE: Derived from ../LIB\DynaLoader.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package DynaLoader;
+
+#line 241 "../LIB\DynaLoader.pm (autosplit into ..\lib\auto\DynaLoader\dl_findfile.al)"
+sub dl_findfile {
+    # Read ext/DynaLoader/DynaLoader.doc for detailed information.
+    # This function does not automatically consider the architecture
+    # or the perl library auto directories.
+    my (@args) = @_;
+    my (@dirs,  $dir);   # which directories to search
+    my (@found);         # full paths to real files we have found
+    my $dl_ext= 'dll'; # $Config::Config{'dlext'} suffix for perl extensions
+    my $dl_so = 'dll'; # $Config::Config{'so'} suffix for shared libraries
+
+    print STDERR "dl_findfile(@args)\n" if $dl_debug;
+
+    # accumulate directories but process files as they appear
+    arg: foreach(@args) {
+        #  Special fast case: full filepath requires no search
+        if ($Is_VMS && m%[:>/\]]% && -f $_) {
+	    push(@found,dl_expandspec(VMS::Filespec::vmsify($_)));
+	    last arg unless wantarray;
+	    next;
+        }
+	elsif ($Is_MacOS) {
+	    if (m/:/ && -f $_) {
+	    	push(@found,$_);
+	    	last arg unless wantarray;
+	    }
+	}
+        elsif (m:/: && -f $_ && !$do_expand) {
+	    push(@found,$_);
+	    last arg unless wantarray;
+	    next;
+	}
+
+        # Deal with directories first:
+        #  Using a -L prefix is the preferred option (faster and more robust)
+        if (m:^-L:) { s/^-L//; push(@dirs, $_); next; }
+
+	if ($Is_MacOS) {
+            #  Otherwise we try to try to spot directories by a heuristic
+            #  (this is a more complicated issue than it first appears)
+	    if (m/:/ && -d $_) {   push(@dirs, $_); next; }
+            #  Only files should get this far...
+            my(@names, $name);    # what filenames to look for
+	    s/^-l//;
+	    push(@names, $_);
+            foreach $dir (@dirs, @dl_library_path) {
+            	next unless -d $dir;
+		$dir =~ s/^([^:]+)$/:$1/;
+		$dir =~ s/:$//;
+            	foreach $name (@names) {
+	    	    my($file) = "$dir:$name";
+                    print STDERR " checking in $dir for $name\n" if $dl_debug;
+		    if (-f $file) {
+                    	push(@found, $file);
+                    	next arg; # no need to look any further
+                    }
+                }
+	    }
+	    next;
+	}
+	
+        #  Otherwise we try to try to spot directories by a heuristic
+        #  (this is a more complicated issue than it first appears)
+        if (m:/: && -d $_) {   push(@dirs, $_); next; }
+
+        # VMS: we may be using native VMS directory syntax instead of
+        # Unix emulation, so check this as well
+        if ($Is_VMS && /[:>\]]/ && -d $_) {   push(@dirs, $_); next; }
+
+        #  Only files should get this far...
+        my(@names, $name);    # what filenames to look for
+        if (m:-l: ) {          # convert -lname to appropriate library name
+            s/-l//;
+            push(@names,"lib$_.$dl_so");
+            push(@names,"lib$_.a");
+        } else {                # Umm, a bare name. Try various alternatives:
+            # these should be ordered with the most likely first
+            push(@names,"$_.$dl_ext")    unless m/\.$dl_ext$/o;
+            push(@names,"$_.$dl_so")     unless m/\.$dl_so$/o;
+            push(@names,"lib$_.$dl_so")  unless m:/:;
+            push(@names,"$_.a")          if !m/\.a$/ and $dlsrc eq "dl_dld.xs";
+            push(@names, $_);
+        }
+        foreach $dir (@dirs, @dl_library_path) {
+            next unless -d $dir;
+            chop($dir = VMS::Filespec::unixpath($dir)) if $Is_VMS;
+            foreach $name (@names) {
+		my($file) = "$dir/$name";
+                print STDERR " checking in $dir for $name\n" if $dl_debug;
+		$file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file);
+		#$file = _check_file($file);
+		if ($file) {
+                    push(@found, $file);
+                    next arg; # no need to look any further
+                }
+            }
+        }
+    }
+    if ($dl_debug) {
+        foreach(@dirs) {
+            print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_;
+        }
+        print STDERR "dl_findfile found: @found\n";
+    }
+    return $found[0] unless wantarray;
+    @found;
+}
+
+# end of DynaLoader::dl_findfile
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/File/Glob/autosplit.ix
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/File/Glob/autosplit.ix	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/File/Glob/autosplit.ix	(revision 14265)
@@ -0,0 +1,3 @@
+# Index created by AutoSplit for ..\..\..\lib\File\Glob.pm
+#    (file acts as timestamp)
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/abs.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/abs.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/abs.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 397 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\abs.al)"
+sub abs {
+    usage "abs(x)" if @_ != 1;
+    CORE::abs($_[0]);
+}
+
+# end of POSIX::abs
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/alarm.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/alarm.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/alarm.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 614 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\alarm.al)"
+sub alarm {
+    usage "alarm(seconds)" if @_ != 1;
+    CORE::alarm($_[0]);
+}
+
+# end of POSIX::alarm
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/assert.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/assert.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/assert.al	(revision 14265)
@@ -0,0 +1,15 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 83 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\assert.al)"
+sub assert {
+    usage "assert(expr)" if @_ != 1;
+    if (!$_[0]) {
+	croak "Assertion failed";
+    }
+}
+
+# end of POSIX::assert
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atan2.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atan2.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atan2.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 148 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\atan2.al)"
+sub atan2 {
+    usage "atan2(x,y)" if @_ != 2;
+    CORE::atan2($_[0], $_[1]);
+}
+
+# end of POSIX::atan2
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atexit.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atexit.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atexit.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 402 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\atexit.al)"
+sub atexit {
+    unimpl "atexit() is C-specific: use END {} instead";
+}
+
+# end of POSIX::atexit
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atof.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atof.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atof.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 406 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\atof.al)"
+sub atof {
+    unimpl "atof() is C-specific, stopped";
+}
+
+# end of POSIX::atof
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atoi.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atoi.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atoi.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 410 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\atoi.al)"
+sub atoi {
+    unimpl "atoi() is C-specific, stopped";
+}
+
+# end of POSIX::atoi
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atol.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atol.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/atol.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 414 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\atol.al)"
+sub atol {
+    unimpl "atol() is C-specific, stopped";
+}
+
+# end of POSIX::atol
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/autosplit.ix
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/autosplit.ix	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/autosplit.ix	(revision 14265)
@@ -0,0 +1,154 @@
+# Index created by AutoSplit for ..\..\lib\POSIX.pm
+#    (file acts as timestamp)
+package POSIX;
+sub assert  ;
+sub tolower  ;
+sub toupper  ;
+sub closedir  ;
+sub opendir  ;
+sub readdir  ;
+sub rewinddir  ;
+sub errno  ;
+sub creat  ;
+sub fcntl  ;
+sub getgrgid  ;
+sub getgrnam  ;
+sub atan2  ;
+sub cos  ;
+sub exp  ;
+sub fabs  ;
+sub log  ;
+sub pow  ;
+sub sin  ;
+sub sqrt  ;
+sub getpwnam  ;
+sub getpwuid  ;
+sub longjmp  ;
+sub setjmp  ;
+sub siglongjmp  ;
+sub sigsetjmp  ;
+sub kill  ;
+sub raise  ;
+sub offsetof  ;
+sub clearerr  ;
+sub fclose  ;
+sub fdopen  ;
+sub feof  ;
+sub fgetc  ;
+sub fgets  ;
+sub fileno  ;
+sub fopen  ;
+sub fprintf  ;
+sub fputc  ;
+sub fputs  ;
+sub fread  ;
+sub freopen  ;
+sub fscanf  ;
+sub fseek  ;
+sub ferror  ;
+sub fflush  ;
+sub fgetpos  ;
+sub fsetpos  ;
+sub ftell  ;
+sub fwrite  ;
+sub getc  ;
+sub getchar  ;
+sub gets  ;
+sub perror  ;
+sub printf  ;
+sub putc  ;
+sub putchar  ;
+sub puts  ;
+sub remove  ;
+sub rename  ;
+sub rewind  ;
+sub scanf  ;
+sub sprintf  ;
+sub sscanf  ;
+sub tmpfile  ;
+sub ungetc  ;
+sub vfprintf  ;
+sub vprintf  ;
+sub vsprintf  ;
+sub abs  ;
+sub atexit  ;
+sub atof  ;
+sub atoi  ;
+sub atol  ;
+sub bsearch  ;
+sub calloc  ;
+sub div  ;
+sub exit  ;
+sub free  ;
+sub getenv  ;
+sub labs  ;
+sub ldiv  ;
+sub malloc  ;
+sub qsort  ;
+sub rand  ;
+sub realloc  ;
+sub srand  ;
+sub system  ;
+sub memchr  ;
+sub memcmp  ;
+sub memcpy  ;
+sub memmove  ;
+sub memset  ;
+sub strcat  ;
+sub strchr  ;
+sub strcmp  ;
+sub strcpy  ;
+sub strcspn  ;
+sub strerror  ;
+sub strlen  ;
+sub strncat  ;
+sub strncmp  ;
+sub strncpy  ;
+sub strpbrk  ;
+sub strrchr  ;
+sub strspn  ;
+sub strstr  ;
+sub strtok  ;
+sub chmod  ;
+sub fstat  ;
+sub mkdir  ;
+sub stat  ;
+sub umask  ;
+sub wait  ;
+sub waitpid  ;
+sub gmtime  ;
+sub localtime  ;
+sub time  ;
+sub alarm  ;
+sub chdir  ;
+sub chown  ;
+sub execl  ;
+sub execle  ;
+sub execlp  ;
+sub execv  ;
+sub execve  ;
+sub execvp  ;
+sub fork  ;
+sub getcwd 
+;
+sub getegid  ;
+sub geteuid  ;
+sub getgid  ;
+sub getgroups  ;
+sub getlogin  ;
+sub getpgrp  ;
+sub getpid  ;
+sub getppid  ;
+sub getuid  ;
+sub isatty  ;
+sub link  ;
+sub rmdir  ;
+sub setbuf  ;
+sub setgid  ;
+sub setuid  ;
+sub setvbuf  ;
+sub sleep  ;
+sub unlink  ;
+sub utime  ;
+sub load_imports  ;
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/bsearch.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/bsearch.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/bsearch.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 418 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\bsearch.al)"
+sub bsearch {
+    unimpl "bsearch() not supplied";
+}
+
+# end of POSIX::bsearch
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/calloc.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/calloc.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/calloc.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 422 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\calloc.al)"
+sub calloc {
+    unimpl "calloc() is C-specific, stopped";
+}
+
+# end of POSIX::calloc
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/chdir.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/chdir.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/chdir.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 619 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\chdir.al)"
+sub chdir {
+    usage "chdir(directory)" if @_ != 1;
+    CORE::chdir($_[0]);
+}
+
+# end of POSIX::chdir
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/chmod.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/chmod.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/chmod.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 560 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\chmod.al)"
+sub chmod {
+    usage "chmod(mode, filename)" if @_ != 2;
+    CORE::chmod($_[0], $_[1]);
+}
+
+# end of POSIX::chmod
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/chown.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/chown.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/chown.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 624 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\chown.al)"
+sub chown {
+    usage "chown(filename, uid, gid)" if @_ != 3;
+    CORE::chown($_[0], $_[1], $_[2]);
+}
+
+# end of POSIX::chown
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/clearerr.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/clearerr.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/clearerr.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 228 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\clearerr.al)"
+sub clearerr {
+    redef "IO::Handle::clearerr()";
+}
+
+# end of POSIX::clearerr
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/closedir.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/closedir.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/closedir.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 100 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\closedir.al)"
+sub closedir {
+    usage "closedir(dirhandle)" if @_ != 1;
+    CORE::closedir($_[0]);
+}
+
+# end of POSIX::closedir
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/cos.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/cos.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/cos.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 153 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\cos.al)"
+sub cos {
+    usage "cos(x)" if @_ != 1;
+    CORE::cos($_[0]);
+}
+
+# end of POSIX::cos
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/creat.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/creat.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/creat.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 128 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\creat.al)"
+sub creat {
+    usage "creat(filename, mode)" if @_ != 2;
+    &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[1]);
+}
+
+# end of POSIX::creat
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/div.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/div.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/div.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 426 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\div.al)"
+sub div {
+    unimpl "div() is C-specific, stopped";
+}
+
+# end of POSIX::div
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/errno.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/errno.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/errno.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 123 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\errno.al)"
+sub errno {
+    usage "errno()" if @_ != 0;
+    $! + 0;
+}
+
+# end of POSIX::errno
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execl.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execl.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execl.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 629 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\execl.al)"
+sub execl {
+    unimpl "execl() is C-specific, stopped";
+}
+
+# end of POSIX::execl
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execle.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execle.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execle.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 633 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\execle.al)"
+sub execle {
+    unimpl "execle() is C-specific, stopped";
+}
+
+# end of POSIX::execle
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execlp.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execlp.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execlp.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 637 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\execlp.al)"
+sub execlp {
+    unimpl "execlp() is C-specific, stopped";
+}
+
+# end of POSIX::execlp
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execv.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execv.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execv.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 641 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\execv.al)"
+sub execv {
+    unimpl "execv() is C-specific, stopped";
+}
+
+# end of POSIX::execv
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execve.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execve.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execve.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 645 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\execve.al)"
+sub execve {
+    unimpl "execve() is C-specific, stopped";
+}
+
+# end of POSIX::execve
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execvp.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execvp.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/execvp.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 649 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\execvp.al)"
+sub execvp {
+    unimpl "execvp() is C-specific, stopped";
+}
+
+# end of POSIX::execvp
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/exit.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/exit.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/exit.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 430 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\exit.al)"
+sub exit {
+    usage "exit(status)" if @_ != 1;
+    CORE::exit($_[0]);
+}
+
+# end of POSIX::exit
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/exp.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/exp.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/exp.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 158 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\exp.al)"
+sub exp {
+    usage "exp(x)" if @_ != 1;
+    CORE::exp($_[0]);
+}
+
+# end of POSIX::exp
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fabs.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fabs.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fabs.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 163 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fabs.al)"
+sub fabs {
+    usage "fabs(x)" if @_ != 1;
+    CORE::abs($_[0]);
+}
+
+# end of POSIX::fabs
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fclose.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fclose.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fclose.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 232 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fclose.al)"
+sub fclose {
+    redef "IO::Handle::close()";
+}
+
+# end of POSIX::fclose
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fcntl.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fcntl.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fcntl.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 133 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fcntl.al)"
+sub fcntl {
+    usage "fcntl(filehandle, cmd, arg)" if @_ != 3;
+    CORE::fcntl($_[0], $_[1], $_[2]);
+}
+
+# end of POSIX::fcntl
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fdopen.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fdopen.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fdopen.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 236 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fdopen.al)"
+sub fdopen {
+    redef "IO::Handle::new_from_fd()";
+}
+
+# end of POSIX::fdopen
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/feof.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/feof.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/feof.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 240 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\feof.al)"
+sub feof {
+    redef "IO::Handle::eof()";
+}
+
+# end of POSIX::feof
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/ferror.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/ferror.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/ferror.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 288 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\ferror.al)"
+sub ferror {
+    redef "IO::Handle::error()";
+}
+
+# end of POSIX::ferror
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fflush.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fflush.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fflush.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 292 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fflush.al)"
+sub fflush {
+    redef "IO::Handle::flush()";
+}
+
+# end of POSIX::fflush
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fgetc.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fgetc.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fgetc.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 244 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fgetc.al)"
+sub fgetc {
+    redef "IO::Handle::getc()";
+}
+
+# end of POSIX::fgetc
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fgetpos.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fgetpos.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fgetpos.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 296 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fgetpos.al)"
+sub fgetpos {
+    redef "IO::Seekable::getpos()";
+}
+
+# end of POSIX::fgetpos
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fgets.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fgets.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fgets.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 248 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fgets.al)"
+sub fgets {
+    redef "IO::Handle::gets()";
+}
+
+# end of POSIX::fgets
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fileno.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fileno.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fileno.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 252 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fileno.al)"
+sub fileno {
+    redef "IO::Handle::fileno()";
+}
+
+# end of POSIX::fileno
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fopen.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fopen.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fopen.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 256 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fopen.al)"
+sub fopen {
+    redef "IO::File::open()";
+}
+
+# end of POSIX::fopen
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fork.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fork.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fork.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 653 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fork.al)"
+sub fork {
+    usage "fork()" if @_ != 0;
+    CORE::fork;
+}
+
+# end of POSIX::fork
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fprintf.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fprintf.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fprintf.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 260 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fprintf.al)"
+sub fprintf {
+    unimpl "fprintf() is C-specific--use printf instead";
+}
+
+# end of POSIX::fprintf
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fputc.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fputc.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fputc.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 264 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fputc.al)"
+sub fputc {
+    unimpl "fputc() is C-specific--use print instead";
+}
+
+# end of POSIX::fputc
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fputs.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fputs.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fputs.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 268 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fputs.al)"
+sub fputs {
+    unimpl "fputs() is C-specific--use print instead";
+}
+
+# end of POSIX::fputs
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fread.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fread.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fread.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 272 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fread.al)"
+sub fread {
+    unimpl "fread() is C-specific--use read instead";
+}
+
+# end of POSIX::fread
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/free.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/free.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/free.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 435 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\free.al)"
+sub free {
+    unimpl "free() is C-specific, stopped";
+}
+
+# end of POSIX::free
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/freopen.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/freopen.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/freopen.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 276 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\freopen.al)"
+sub freopen {
+    unimpl "freopen() is C-specific--use open instead";
+}
+
+# end of POSIX::freopen
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fscanf.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fscanf.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fscanf.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 280 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fscanf.al)"
+sub fscanf {
+    unimpl "fscanf() is C-specific--use <> and regular expressions instead";
+}
+
+# end of POSIX::fscanf
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fseek.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fseek.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fseek.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 284 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fseek.al)"
+sub fseek {
+    redef "IO::Seekable::seek()";
+}
+
+# end of POSIX::fseek
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fsetpos.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fsetpos.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fsetpos.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 300 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fsetpos.al)"
+sub fsetpos {
+    redef "IO::Seekable::setpos()";
+}
+
+# end of POSIX::fsetpos
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fstat.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fstat.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fstat.al	(revision 14265)
@@ -0,0 +1,17 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 565 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fstat.al)"
+sub fstat {
+    usage "fstat(fd)" if @_ != 1;
+    local *TMP;
+    CORE::open(TMP, "<&$_[0]");		# Gross.
+    my @l = CORE::stat(TMP);
+    CORE::close(TMP);
+    @l;
+}
+
+# end of POSIX::fstat
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/ftell.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/ftell.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/ftell.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 304 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\ftell.al)"
+sub ftell {
+    redef "IO::Seekable::tell()";
+}
+
+# end of POSIX::ftell
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fwrite.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fwrite.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/fwrite.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 308 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\fwrite.al)"
+sub fwrite {
+    unimpl "fwrite() is C-specific--use print instead";
+}
+
+# end of POSIX::fwrite
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getc.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getc.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getc.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 312 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getc.al)"
+sub getc {
+    usage "getc(handle)" if @_ != 1;
+    CORE::getc($_[0]);
+}
+
+# end of POSIX::getc
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getchar.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getchar.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getchar.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 317 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getchar.al)"
+sub getchar {
+    usage "getchar()" if @_ != 0;
+    CORE::getc(STDIN);
+}
+
+# end of POSIX::getchar
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getcwd.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getcwd.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getcwd.al	(revision 14265)
@@ -0,0 +1,22 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 658 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getcwd.al)"
+sub getcwd
+{
+    usage "getcwd()" if @_ != 0;
+    if ($^O eq 'MSWin32') {
+	# this perhaps applies to everyone else also?
+	require Cwd;
+	$cwd = &Cwd::cwd;
+    }
+    else {
+	chop($cwd = `pwd`);
+    }
+    $cwd;
+}
+
+# end of POSIX::getcwd
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getegid.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getegid.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getegid.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 672 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getegid.al)"
+sub getegid {
+    usage "getegid()" if @_ != 0;
+    $) + 0;
+}
+
+# end of POSIX::getegid
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getenv.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getenv.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getenv.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 439 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getenv.al)"
+sub getenv {
+    usage "getenv(name)" if @_ != 1;
+    $ENV{$_[0]};
+}
+
+# end of POSIX::getenv
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/geteuid.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/geteuid.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/geteuid.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 677 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\geteuid.al)"
+sub geteuid {
+    usage "geteuid()" if @_ != 0;
+    $> + 0;
+}
+
+# end of POSIX::geteuid
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getgid.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getgid.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getgid.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 682 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getgid.al)"
+sub getgid {
+    usage "getgid()" if @_ != 0;
+    $( + 0;
+}
+
+# end of POSIX::getgid
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getgrgid.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getgrgid.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getgrgid.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 138 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getgrgid.al)"
+sub getgrgid {
+    usage "getgrgid(gid)" if @_ != 1;
+    CORE::getgrgid($_[0]);
+}
+
+# end of POSIX::getgrgid
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getgrnam.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getgrnam.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getgrnam.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 143 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getgrnam.al)"
+sub getgrnam {
+    usage "getgrnam(name)" if @_ != 1;
+    CORE::getgrnam($_[0]);
+}
+
+# end of POSIX::getgrnam
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getgroups.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getgroups.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getgroups.al	(revision 14265)
@@ -0,0 +1,14 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 687 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getgroups.al)"
+sub getgroups {
+    usage "getgroups()" if @_ != 0;
+    my %seen;
+    grep(!$seen{$_}++, split(' ', $) ));
+}
+
+# end of POSIX::getgroups
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getlogin.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getlogin.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getlogin.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 693 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getlogin.al)"
+sub getlogin {
+    usage "getlogin()" if @_ != 0;
+    CORE::getlogin();
+}
+
+# end of POSIX::getlogin
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getpgrp.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getpgrp.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getpgrp.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 698 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getpgrp.al)"
+sub getpgrp {
+    usage "getpgrp()" if @_ != 0;
+    CORE::getpgrp;
+}
+
+# end of POSIX::getpgrp
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getpid.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getpid.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getpid.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 703 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getpid.al)"
+sub getpid {
+    usage "getpid()" if @_ != 0;
+    $$;
+}
+
+# end of POSIX::getpid
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getppid.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getppid.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getppid.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 708 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getppid.al)"
+sub getppid {
+    usage "getppid()" if @_ != 0;
+    CORE::getppid;
+}
+
+# end of POSIX::getppid
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getpwnam.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getpwnam.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getpwnam.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 188 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getpwnam.al)"
+sub getpwnam {
+    usage "getpwnam(name)" if @_ != 1;
+    CORE::getpwnam($_[0]);
+}
+
+# end of POSIX::getpwnam
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getpwuid.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getpwuid.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getpwuid.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 193 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getpwuid.al)"
+sub getpwuid {
+    usage "getpwuid(uid)" if @_ != 1;
+    CORE::getpwuid($_[0]);
+}
+
+# end of POSIX::getpwuid
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/gets.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/gets.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/gets.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 322 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\gets.al)"
+sub gets {
+    usage "gets()" if @_ != 0;
+    scalar <STDIN>;
+}
+
+# end of POSIX::gets
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getuid.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getuid.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/getuid.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 713 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\getuid.al)"
+sub getuid {
+    usage "getuid()" if @_ != 0;
+    $<;
+}
+
+# end of POSIX::getuid
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/gmtime.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/gmtime.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/gmtime.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 599 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\gmtime.al)"
+sub gmtime {
+    usage "gmtime(time)" if @_ != 1;
+    CORE::gmtime($_[0]);
+}
+
+# end of POSIX::gmtime
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/isatty.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/isatty.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/isatty.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 718 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\isatty.al)"
+sub isatty {
+    usage "isatty(filehandle)" if @_ != 1;
+    -t $_[0];
+}
+
+# end of POSIX::isatty
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/kill.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/kill.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/kill.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 214 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\kill.al)"
+sub kill {
+    usage "kill(pid, sig)" if @_ != 2;
+    CORE::kill $_[1], $_[0];
+}
+
+# end of POSIX::kill
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/labs.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/labs.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/labs.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 444 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\labs.al)"
+sub labs {
+    unimpl "labs() is C-specific, use abs instead";
+}
+
+# end of POSIX::labs
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/ldiv.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/ldiv.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/ldiv.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 448 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\ldiv.al)"
+sub ldiv {
+    unimpl "ldiv() is C-specific, use / and int instead";
+}
+
+# end of POSIX::ldiv
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/link.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/link.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/link.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 723 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\link.al)"
+sub link {
+    usage "link(oldfilename, newfilename)" if @_ != 2;
+    CORE::link($_[0], $_[1]);
+}
+
+# end of POSIX::link
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/load_imports.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/load_imports.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/load_imports.al	(revision 14265)
@@ -0,0 +1,184 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 766 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\load_imports.al)"
+sub load_imports {
+%EXPORT_TAGS = (
+
+    assert_h =>	[qw(assert NDEBUG)],
+
+    ctype_h =>	[qw(isalnum isalpha iscntrl isdigit isgraph islower
+		isprint ispunct isspace isupper isxdigit tolower toupper)],
+
+    dirent_h =>	[qw()],
+
+    errno_h =>	[qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
+		EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
+		ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
+		EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
+		EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
+		EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
+		ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
+		ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
+		ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
+		EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
+		ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
+		ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
+		EUSERS EWOULDBLOCK EXDEV errno)],
+
+    fcntl_h =>	[qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK
+		F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK
+		O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK
+		O_RDONLY O_RDWR O_TRUNC O_WRONLY
+		creat
+		SEEK_CUR SEEK_END SEEK_SET
+		S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
+		S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG S_ISUID
+		S_IWGRP S_IWOTH S_IWUSR)],
+
+    float_h =>	[qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG
+		DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP
+		DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP
+		FLT_DIG FLT_EPSILON FLT_MANT_DIG
+		FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP
+		FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP
+		FLT_RADIX FLT_ROUNDS
+		LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG
+		LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP
+		LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)],
+
+    grp_h =>	[qw()],
+
+    limits_h =>	[qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX
+		INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON
+		MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX
+		PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN
+		SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX
+		ULONG_MAX USHRT_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX
+		_POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT
+		_POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX
+		_POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX
+		_POSIX_STREAM_MAX _POSIX_TZNAME_MAX)],
+
+    locale_h =>	[qw(LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC
+		LC_TIME NULL localeconv setlocale)],
+
+    math_h =>	[qw(HUGE_VAL acos asin atan ceil cosh fabs floor fmod
+		frexp ldexp log10 modf pow sinh tan tanh)],
+
+    pwd_h =>	[qw()],
+
+    setjmp_h =>	[qw(longjmp setjmp siglongjmp sigsetjmp)],
+
+    signal_h =>	[qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK
+		SA_RESETHAND SA_RESTART SA_SIGINFO SIGABRT SIGALRM
+		SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL
+		SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN
+		SIGTTOU SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR
+		SIG_IGN SIG_SETMASK SIG_UNBLOCK raise sigaction signal
+		sigpending sigprocmask sigsuspend)],
+
+    stdarg_h =>	[qw()],
+
+    stddef_h =>	[qw(NULL offsetof)],
+
+    stdio_h =>	[qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid
+		L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET
+		STREAM_MAX TMP_MAX stderr stdin stdout
+		clearerr fclose fdopen feof ferror fflush fgetc fgetpos
+		fgets fopen fprintf fputc fputs fread freopen
+		fscanf fseek fsetpos ftell fwrite getchar gets
+		perror putc putchar puts remove rewind
+		scanf setbuf setvbuf sscanf tmpfile tmpnam
+		ungetc vfprintf vprintf vsprintf)],
+
+    stdlib_h =>	[qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX
+		abort atexit atof atoi atol bsearch calloc div
+		free getenv labs ldiv malloc mblen mbstowcs mbtowc
+		qsort realloc strtod strtol strtoul wcstombs wctomb)],
+
+    string_h =>	[qw(NULL memchr memcmp memcpy memmove memset strcat
+		strchr strcmp strcoll strcpy strcspn strerror strlen
+		strncat strncmp strncpy strpbrk strrchr strspn strstr
+		strtok strxfrm)],
+
+    sys_stat_h => [qw(S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
+		S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG
+		S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR
+		fstat mkfifo)],
+
+    sys_times_h => [qw()],
+
+    sys_types_h => [qw()],
+
+    sys_utsname_h => [qw(uname)],
+
+    sys_wait_h => [qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED
+		WNOHANG WSTOPSIG WTERMSIG WUNTRACED)],
+
+    termios_h => [qw( B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400
+		B300 B38400 B4800 B50 B600 B75 B9600 BRKINT CLOCAL
+		CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB ECHO ECHOE ECHOK
+		ECHONL HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR
+		INLCR INPCK ISIG ISTRIP IXOFF IXON NCCS NOFLSH OPOST
+		PARENB PARMRK PARODD TCIFLUSH TCIOFF TCIOFLUSH TCION
+		TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW
+		TOSTOP VEOF VEOL VERASE VINTR VKILL VMIN VQUIT VSTART
+		VSTOP VSUSP VTIME
+		cfgetispeed cfgetospeed cfsetispeed cfsetospeed tcdrain
+		tcflow tcflush tcgetattr tcsendbreak tcsetattr )],
+
+    time_h =>	[qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime
+		difftime mktime strftime tzset tzname)],
+
+    unistd_h =>	[qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET
+		STDERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK
+		_PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON
+		_PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX
+		_PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED
+		_POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS
+		_POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX
+		_SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL
+		_SC_NGROUPS_MAX _SC_OPEN_MAX _SC_SAVED_IDS
+		_SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION
+		_exit access ctermid cuserid
+		dup2 dup execl execle execlp execv execve execvp
+		fpathconf getcwd getegid geteuid getgid getgroups
+		getpid getuid isatty lseek pathconf pause setgid setpgid
+		setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)],
+
+    utime_h =>	[qw()],
+
+);
+
+# Exporter::export_tags();
+for (values %EXPORT_TAGS) {
+  push @EXPORT, @$_;
+}
+
+@EXPORT_OK = qw(
+    closedir opendir readdir rewinddir
+    fcntl open
+    getgrgid getgrnam
+    atan2 cos exp log sin sqrt
+    getpwnam getpwuid
+    kill
+    fileno getc printf rename sprintf
+    abs exit rand srand system
+    chmod mkdir stat umask
+    times
+    wait waitpid
+    gmtime localtime time 
+    alarm chdir chown close fork getlogin getppid getpgrp link
+	pipe read rmdir sleep unlink write
+    utime
+    nice
+);
+
+require Exporter;
+}
+
+1;
+# end of POSIX::load_imports
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/localtime.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/localtime.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/localtime.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 604 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\localtime.al)"
+sub localtime {
+    usage "localtime(time)" if @_ != 1;
+    CORE::localtime($_[0]);
+}
+
+# end of POSIX::localtime
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/log.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/log.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/log.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 168 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\log.al)"
+sub log {
+    usage "log(x)" if @_ != 1;
+    CORE::log($_[0]);
+}
+
+# end of POSIX::log
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/longjmp.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/longjmp.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/longjmp.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 198 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\longjmp.al)"
+sub longjmp {
+    unimpl "longjmp() is C-specific: use die instead";
+}
+
+# end of POSIX::longjmp
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/malloc.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/malloc.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/malloc.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 452 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\malloc.al)"
+sub malloc {
+    unimpl "malloc() is C-specific, stopped";
+}
+
+# end of POSIX::malloc
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memchr.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memchr.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memchr.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 477 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\memchr.al)"
+sub memchr {
+    unimpl "memchr() is C-specific, use index() instead";
+}
+
+# end of POSIX::memchr
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memcmp.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memcmp.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memcmp.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 481 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\memcmp.al)"
+sub memcmp {
+    unimpl "memcmp() is C-specific, use eq instead";
+}
+
+# end of POSIX::memcmp
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memcpy.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memcpy.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memcpy.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 485 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\memcpy.al)"
+sub memcpy {
+    unimpl "memcpy() is C-specific, use = instead";
+}
+
+# end of POSIX::memcpy
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memmove.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memmove.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memmove.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 489 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\memmove.al)"
+sub memmove {
+    unimpl "memmove() is C-specific, use = instead";
+}
+
+# end of POSIX::memmove
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memset.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memset.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/memset.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 493 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\memset.al)"
+sub memset {
+    unimpl "memset() is C-specific, use x instead";
+}
+
+# end of POSIX::memset
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/mkdir.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/mkdir.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/mkdir.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 574 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\mkdir.al)"
+sub mkdir {
+    usage "mkdir(directoryname, mode)" if @_ != 2;
+    CORE::mkdir($_[0], $_[1]);
+}
+
+# end of POSIX::mkdir
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/offsetof.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/offsetof.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/offsetof.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 224 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\offsetof.al)"
+sub offsetof {
+    unimpl "offsetof() is C-specific, stopped";
+}
+
+# end of POSIX::offsetof
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/opendir.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/opendir.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/opendir.al	(revision 14265)
@@ -0,0 +1,16 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 105 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\opendir.al)"
+sub opendir {
+    usage "opendir(directory)" if @_ != 1;
+    my $dirhandle;
+    CORE::opendir($dirhandle, $_[0])
+	? $dirhandle
+	: undef;
+}
+
+# end of POSIX::opendir
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/perror.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/perror.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/perror.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 327 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\perror.al)"
+sub perror {
+    print STDERR "@_: " if @_;
+    print STDERR $!,"\n";
+}
+
+# end of POSIX::perror
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/pow.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/pow.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/pow.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 173 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\pow.al)"
+sub pow {
+    usage "pow(x,exponent)" if @_ != 2;
+    $_[0] ** $_[1];
+}
+
+# end of POSIX::pow
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/printf.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/printf.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/printf.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 332 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\printf.al)"
+sub printf {
+    usage "printf(pattern, args...)" if @_ < 1;
+    CORE::printf STDOUT @_;
+}
+
+# end of POSIX::printf
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/putc.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/putc.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/putc.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 337 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\putc.al)"
+sub putc {
+    unimpl "putc() is C-specific--use print instead";
+}
+
+# end of POSIX::putc
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/putchar.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/putchar.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/putchar.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 341 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\putchar.al)"
+sub putchar {
+    unimpl "putchar() is C-specific--use print instead";
+}
+
+# end of POSIX::putchar
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/puts.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/puts.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/puts.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 345 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\puts.al)"
+sub puts {
+    unimpl "puts() is C-specific--use print instead";
+}
+
+# end of POSIX::puts
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/qsort.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/qsort.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/qsort.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 456 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\qsort.al)"
+sub qsort {
+    unimpl "qsort() is C-specific, use sort instead";
+}
+
+# end of POSIX::qsort
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/raise.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/raise.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/raise.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 219 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\raise.al)"
+sub raise {
+    usage "raise(sig)" if @_ != 1;
+    CORE::kill $_[0], $$;	# Is this good enough?
+}
+
+# end of POSIX::raise
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rand.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rand.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rand.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 460 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\rand.al)"
+sub rand {
+    unimpl "rand() is non-portable, use Perl's rand instead";
+}
+
+# end of POSIX::rand
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/readdir.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/readdir.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/readdir.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 113 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\readdir.al)"
+sub readdir {
+    usage "readdir(dirhandle)" if @_ != 1;
+    CORE::readdir($_[0]);
+}
+
+# end of POSIX::readdir
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/realloc.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/realloc.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/realloc.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 464 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\realloc.al)"
+sub realloc {
+    unimpl "realloc() is C-specific, stopped";
+}
+
+# end of POSIX::realloc
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/remove.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/remove.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/remove.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 349 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\remove.al)"
+sub remove {
+    usage "remove(filename)" if @_ != 1;
+    CORE::unlink($_[0]);
+}
+
+# end of POSIX::remove
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rename.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rename.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rename.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 354 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\rename.al)"
+sub rename {
+    usage "rename(oldfilename, newfilename)" if @_ != 2;
+    CORE::rename($_[0], $_[1]);
+}
+
+# end of POSIX::rename
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rewind.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rewind.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rewind.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 359 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\rewind.al)"
+sub rewind {
+    usage "rewind(filehandle)" if @_ != 1;
+    CORE::seek($_[0],0,0);
+}
+
+# end of POSIX::rewind
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rewinddir.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rewinddir.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rewinddir.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 118 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\rewinddir.al)"
+sub rewinddir {
+    usage "rewinddir(dirhandle)" if @_ != 1;
+    CORE::rewinddir($_[0]);
+}
+
+# end of POSIX::rewinddir
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rmdir.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rmdir.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/rmdir.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 728 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\rmdir.al)"
+sub rmdir {
+    usage "rmdir(directoryname)" if @_ != 1;
+    CORE::rmdir($_[0]);
+}
+
+# end of POSIX::rmdir
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/scanf.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/scanf.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/scanf.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 364 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\scanf.al)"
+sub scanf {
+    unimpl "scanf() is C-specific--use <> and regular expressions instead";
+}
+
+# end of POSIX::scanf
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setbuf.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setbuf.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setbuf.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 733 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\setbuf.al)"
+sub setbuf {
+    redef "IO::Handle::setbuf()";
+}
+
+# end of POSIX::setbuf
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setgid.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setgid.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setgid.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 737 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\setgid.al)"
+sub setgid {
+    usage "setgid(gid)" if @_ != 1;
+    $( = $_[0];
+}
+
+# end of POSIX::setgid
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setjmp.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setjmp.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setjmp.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 202 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\setjmp.al)"
+sub setjmp {
+    unimpl "setjmp() is C-specific: use eval {} instead";
+}
+
+# end of POSIX::setjmp
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setuid.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setuid.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setuid.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 742 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\setuid.al)"
+sub setuid {
+    usage "setuid(uid)" if @_ != 1;
+    $< = $_[0];
+}
+
+# end of POSIX::setuid
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setvbuf.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setvbuf.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/setvbuf.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 747 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\setvbuf.al)"
+sub setvbuf {
+    redef "IO::Handle::setvbuf()";
+}
+
+# end of POSIX::setvbuf
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/siglongjmp.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/siglongjmp.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/siglongjmp.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 206 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\siglongjmp.al)"
+sub siglongjmp {
+    unimpl "siglongjmp() is C-specific: use die instead";
+}
+
+# end of POSIX::siglongjmp
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sigsetjmp.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sigsetjmp.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sigsetjmp.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 210 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\sigsetjmp.al)"
+sub sigsetjmp {
+    unimpl "sigsetjmp() is C-specific: use eval {} instead";
+}
+
+# end of POSIX::sigsetjmp
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sin.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sin.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sin.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 178 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\sin.al)"
+sub sin {
+    usage "sin(x)" if @_ != 1;
+    CORE::sin($_[0]);
+}
+
+# end of POSIX::sin
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sleep.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sleep.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sleep.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 751 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\sleep.al)"
+sub sleep {
+    usage "sleep(seconds)" if @_ != 1;
+    CORE::sleep($_[0]);
+}
+
+# end of POSIX::sleep
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sprintf.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sprintf.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sprintf.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 368 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\sprintf.al)"
+sub sprintf {
+    usage "sprintf(pattern,args)" if @_ == 0;
+    CORE::sprintf(shift,@_);
+}
+
+# end of POSIX::sprintf
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sqrt.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sqrt.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sqrt.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 183 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\sqrt.al)"
+sub sqrt {
+    usage "sqrt(x)" if @_ != 1;
+    CORE::sqrt($_[0]);
+}
+
+# end of POSIX::sqrt
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/srand.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/srand.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/srand.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 468 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\srand.al)"
+sub srand {
+    unimpl "srand()";
+}
+
+# end of POSIX::srand
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sscanf.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sscanf.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/sscanf.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 373 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\sscanf.al)"
+sub sscanf {
+    unimpl "sscanf() is C-specific--use regular expressions instead";
+}
+
+# end of POSIX::sscanf
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/stat.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/stat.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/stat.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 579 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\stat.al)"
+sub stat {
+    usage "stat(filename)" if @_ != 1;
+    CORE::stat($_[0]);
+}
+
+# end of POSIX::stat
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strcat.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strcat.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strcat.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 497 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strcat.al)"
+sub strcat {
+    unimpl "strcat() is C-specific, use .= instead";
+}
+
+# end of POSIX::strcat
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strchr.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strchr.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strchr.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 501 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strchr.al)"
+sub strchr {
+    unimpl "strchr() is C-specific, use index() instead";
+}
+
+# end of POSIX::strchr
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strcmp.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strcmp.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strcmp.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 505 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strcmp.al)"
+sub strcmp {
+    unimpl "strcmp() is C-specific, use eq instead";
+}
+
+# end of POSIX::strcmp
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strcpy.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strcpy.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strcpy.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 509 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strcpy.al)"
+sub strcpy {
+    unimpl "strcpy() is C-specific, use = instead";
+}
+
+# end of POSIX::strcpy
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strcspn.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strcspn.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strcspn.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 513 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strcspn.al)"
+sub strcspn {
+    unimpl "strcspn() is C-specific, use regular expressions instead";
+}
+
+# end of POSIX::strcspn
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strerror.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strerror.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strerror.al	(revision 14265)
@@ -0,0 +1,14 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 517 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strerror.al)"
+sub strerror {
+    usage "strerror(errno)" if @_ != 1;
+    local $! = $_[0];
+    $! . "";
+}
+
+# end of POSIX::strerror
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strlen.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strlen.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strlen.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 523 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strlen.al)"
+sub strlen {
+    unimpl "strlen() is C-specific, use length instead";
+}
+
+# end of POSIX::strlen
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strncat.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strncat.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strncat.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 527 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strncat.al)"
+sub strncat {
+    unimpl "strncat() is C-specific, use .= instead";
+}
+
+# end of POSIX::strncat
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strncmp.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strncmp.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strncmp.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 531 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strncmp.al)"
+sub strncmp {
+    unimpl "strncmp() is C-specific, use eq instead";
+}
+
+# end of POSIX::strncmp
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strncpy.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strncpy.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strncpy.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 535 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strncpy.al)"
+sub strncpy {
+    unimpl "strncpy() is C-specific, use = instead";
+}
+
+# end of POSIX::strncpy
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strpbrk.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strpbrk.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strpbrk.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 539 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strpbrk.al)"
+sub strpbrk {
+    unimpl "strpbrk() is C-specific, stopped";
+}
+
+# end of POSIX::strpbrk
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strrchr.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strrchr.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strrchr.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 543 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strrchr.al)"
+sub strrchr {
+    unimpl "strrchr() is C-specific, use rindex() instead";
+}
+
+# end of POSIX::strrchr
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strspn.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strspn.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strspn.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 547 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strspn.al)"
+sub strspn {
+    unimpl "strspn() is C-specific, stopped";
+}
+
+# end of POSIX::strspn
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strstr.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strstr.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strstr.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 551 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strstr.al)"
+sub strstr {
+    usage "strstr(big, little)" if @_ != 2;
+    CORE::index($_[0], $_[1]);
+}
+
+# end of POSIX::strstr
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strtok.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strtok.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/strtok.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 556 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\strtok.al)"
+sub strtok {
+    unimpl "strtok() is C-specific, stopped";
+}
+
+# end of POSIX::strtok
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/system.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/system.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/system.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 472 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\system.al)"
+sub system {
+    usage "system(command)" if @_ != 1;
+    CORE::system($_[0]);
+}
+
+# end of POSIX::system
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/time.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/time.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/time.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 609 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\time.al)"
+sub time {
+    usage "time()" if @_ != 0;
+    CORE::time;
+}
+
+# end of POSIX::time
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/tmpfile.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/tmpfile.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/tmpfile.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 377 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\tmpfile.al)"
+sub tmpfile {
+    redef "IO::File::new_tmpfile()";
+}
+
+# end of POSIX::tmpfile
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/tolower.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/tolower.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/tolower.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 90 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\tolower.al)"
+sub tolower {
+    usage "tolower(string)" if @_ != 1;
+    lc($_[0]);
+}
+
+# end of POSIX::tolower
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/toupper.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/toupper.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/toupper.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 95 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\toupper.al)"
+sub toupper {
+    usage "toupper(string)" if @_ != 1;
+    uc($_[0]);
+}
+
+# end of POSIX::toupper
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/umask.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/umask.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/umask.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 584 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\umask.al)"
+sub umask {
+    usage "umask(mask)" if @_ != 1;
+    CORE::umask($_[0]);
+}
+
+# end of POSIX::umask
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/ungetc.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/ungetc.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/ungetc.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 381 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\ungetc.al)"
+sub ungetc {
+    redef "IO::Handle::ungetc()";
+}
+
+# end of POSIX::ungetc
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/unlink.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/unlink.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/unlink.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 756 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\unlink.al)"
+sub unlink {
+    usage "unlink(filename)" if @_ != 1;
+    CORE::unlink($_[0]);
+}
+
+# end of POSIX::unlink
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/utime.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/utime.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/utime.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 761 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\utime.al)"
+sub utime {
+    usage "utime(filename, atime, mtime)" if @_ != 3;
+    CORE::utime($_[1], $_[2], $_[0]);
+}
+
+# end of POSIX::utime
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/vfprintf.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/vfprintf.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/vfprintf.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 385 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\vfprintf.al)"
+sub vfprintf {
+    unimpl "vfprintf() is C-specific";
+}
+
+# end of POSIX::vfprintf
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/vprintf.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/vprintf.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/vprintf.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 389 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\vprintf.al)"
+sub vprintf {
+    unimpl "vprintf() is C-specific";
+}
+
+# end of POSIX::vprintf
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/vsprintf.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/vsprintf.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/vsprintf.al	(revision 14265)
@@ -0,0 +1,12 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 393 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\vsprintf.al)"
+sub vsprintf {
+    unimpl "vsprintf() is C-specific";
+}
+
+# end of POSIX::vsprintf
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/wait.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/wait.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/wait.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 589 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\wait.al)"
+sub wait {
+    usage "wait()" if @_ != 0;
+    CORE::wait();
+}
+
+# end of POSIX::wait
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/waitpid.al
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/waitpid.al	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/POSIX/waitpid.al	(revision 14265)
@@ -0,0 +1,13 @@
+# NOTE: Derived from ..\..\lib\POSIX.pm.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package POSIX;
+
+#line 594 "..\..\lib\POSIX.pm (autosplit into ..\..\lib\auto\POSIX\waitpid.al)"
+sub waitpid {
+    usage "waitpid(pid, options)" if @_ != 2;
+    CORE::waitpid($_[0], $_[1]);
+}
+
+# end of POSIX::waitpid
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/auto/XML/Parser/.packlist
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/auto/XML/Parser/.packlist	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/auto/XML/Parser/.packlist	(revision 14265)
@@ -0,0 +1,37 @@
+Expat.bs
+Expat.dll
+Expat.exp
+Expat.lib
+Expat.pm
+Parser.pm
+README
+asciitab.h
+dllmain.c
+hashtable.c
+hashtable.h
+iasciitab.h
+iso-8859-2.enc
+iso-8859-3.enc
+iso-8859-4.enc
+iso-8859-5.enc
+iso-8859-7.enc
+iso-8859-8.enc
+iso-8859-9.enc
+latin1tab.h
+nametab.h
+utf8tab.h
+windows-1250.enc
+xmldef.h
+xmlparse.c
+xmlparse.c.orig
+xmlparse.dsp
+xmlparse.h
+xmlparse.h.orig
+xmlrole.c
+xmlrole.h
+xmltok.c
+xmltok.dsp
+xmltok.h
+xmltok_impl.c
+xmltok_impl.h
+xmltok_ns.c
Index: /for-distributions/trunk/bin/windows/perl/lib/autouse.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/autouse.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/autouse.pm	(revision 14265)
@@ -0,0 +1,157 @@
+package autouse;
+
+#use strict;		# debugging only
+use 5.003_90;		# ->can, for my $var
+
+$autouse::VERSION = '1.02';
+
+$autouse::DEBUG ||= 0;
+
+sub vet_import ($);
+
+sub croak {
+    require Carp;
+    Carp::croak(@_);
+}
+
+sub import {
+    my $class = @_ ? shift : 'autouse';
+    croak "usage: use $class MODULE [,SUBS...]" unless @_;
+    my $module = shift;
+
+    (my $pm = $module) =~ s{::}{/}g;
+    $pm .= '.pm';
+    if (exists $INC{$pm}) {
+	vet_import $module;
+	local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
+	# $Exporter::Verbose = 1;
+	return $module->import(map { (my $f = $_) =~ s/\(.*?\)$//; $f } @_);
+    }
+
+    # It is not loaded: need to do real work.
+    my $callpkg = caller(0);
+    print "autouse called from $callpkg\n" if $autouse::DEBUG;
+
+    my $index;
+    for my $f (@_) {
+	my $proto;
+	$proto = $1 if (my $func = $f) =~ s/\((.*)\)$//;
+
+	my $closure_import_func = $func;	# Full name
+	my $closure_func = $func;		# Name inside package
+	my $index = index($func, '::');
+	if ($index == -1) {
+	    $closure_import_func = "${callpkg}::$func";
+	} else {
+	    $closure_func = substr $func, $index + 2;
+	    croak "autouse into different package attempted"
+		unless substr($func, 0, $index) eq $module;
+	}
+
+	my $load_sub = sub {
+	    unless ($INC{$pm}) {
+		eval {require $pm};
+		die if $@;
+		vet_import $module;
+	    }
+	    *$closure_import_func = \&{"${module}::$closure_func"};
+	    print "autousing $module; "
+		  ."imported $closure_func as $closure_import_func\n"
+		if $autouse::DEBUG;
+	    goto &$closure_import_func;
+	};
+
+	if (defined $proto) {
+	    *$closure_import_func = eval "sub ($proto) { &\$load_sub }";
+	} else {
+	    *$closure_import_func = $load_sub;
+	}
+    }
+}
+
+sub vet_import ($) {
+    my $module = shift;
+    if (my $import = $module->can('import')) {
+	croak "autoused module has unique import() method"
+	    unless defined(&Exporter::import)
+		   && $import == \&Exporter::import;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+autouse - postpone load of modules until a function is used
+
+=head1 SYNOPSIS
+
+  use autouse 'Carp' => qw(carp croak);
+  carp "this carp was predeclared and autoused ";
+
+=head1 DESCRIPTION
+
+If the module C<Module> is already loaded, then the declaration
+
+  use autouse 'Module' => qw(func1 func2($;$) Module::func3);
+
+is equivalent to
+
+  use Module qw(func1 func2);
+
+if C<Module> defines func2() with prototype C<($;$)>, and func1() and
+func3() have no prototypes.  (At least if C<Module> uses C<Exporter>'s
+C<import>, otherwise it is a fatal error.)
+
+If the module C<Module> is not loaded yet, then the above declaration
+declares functions func1() and func2() in the current package, and
+declares a function Module::func3().  When these functions are called,
+they load the package C<Module> if needed, and substitute themselves
+with the correct definitions.
+
+=head1 WARNING
+
+Using C<autouse> will move important steps of your program's execution
+from compile time to runtime.  This can
+
+=over
+
+=item *
+
+Break the execution of your program if the module you C<autouse>d has
+some initialization which it expects to be done early.
+
+=item *
+
+hide bugs in your code since important checks (like correctness of
+prototypes) is moved from compile time to runtime.  In particular, if
+the prototype you specified on C<autouse> line is wrong, you will not
+find it out until the corresponding function is executed.  This will be
+very unfortunate for functions which are not always called (note that
+for such functions C<autouse>ing gives biggest win, for a workaround
+see below).
+
+=back
+
+To alleviate the second problem (partially) it is advised to write
+your scripts like this:
+
+  use Module;
+  use autouse Module => qw(carp($) croak(&$));
+  carp "this carp was predeclared and autoused ";
+
+The first line ensures that the errors in your argument specification
+are found early.  When you ship your application you should comment
+out the first line, since it makes the second one useless.
+
+=head1 AUTHOR
+
+Ilya Zakharevich (ilya@math.ohio-state.edu)
+
+=head1 SEE ALSO
+
+perl(1).
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/base.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/base.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/base.pm	(revision 14265)
@@ -0,0 +1,92 @@
+=head1 NAME
+
+base - Establish IS-A relationship with base class at compile time
+
+=head1 SYNOPSIS
+
+    package Baz;
+    use base qw(Foo Bar);
+
+=head1 DESCRIPTION
+
+Roughly similar in effect to
+
+    BEGIN {
+	require Foo;
+	require Bar;
+	push @ISA, qw(Foo Bar);
+    }
+
+Will also initialize the %FIELDS hash if one of the base classes has
+it.  Multiple inheritance of %FIELDS is not supported.  The 'base'
+pragma will croak if multiple base classes have a %FIELDS hash.  See
+L<fields> for a description of this feature.
+
+When strict 'vars' is in scope I<base> also let you assign to @ISA
+without having to declare @ISA with the 'vars' pragma first.
+
+If any of the base classes are not loaded yet, I<base> silently
+C<require>s them.  Whether to C<require> a base class package is
+determined by the absence of a global $VERSION in the base package.
+If $VERSION is not detected even after loading it, <base> will
+define $VERSION in the base package, setting it to the string
+C<-1, set by base.pm>.
+
+=head1 HISTORY
+
+This module was introduced with Perl 5.004_04.
+
+=head1 SEE ALSO
+
+L<fields>
+
+=cut
+
+package base;
+
+use 5.005_64;
+our $VERSION = "1.01";
+
+sub import {
+    my $class = shift;
+    my $fields_base;
+    my $pkg = caller(0);
+
+    foreach my $base (@_) {
+	next if $pkg->isa($base);
+	push @{"$pkg\::ISA"}, $base;
+	unless (exists ${"$base\::"}{VERSION}) {
+	    eval "require $base";
+	    # Only ignore "Can't locate" errors from our eval require.
+	    # Other fatal errors (syntax etc) must be reported.
+	    die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
+	    unless (%{"$base\::"}) {
+		require Carp;
+		Carp::croak("Base class package \"$base\" is empty.\n",
+			    "\t(Perhaps you need to 'use' the module ",
+			    "which defines that package first.)");
+	    }
+	    ${"$base\::VERSION"} = "-1, set by base.pm"
+		unless exists ${"$base\::"}{VERSION};
+	}
+
+	# A simple test like (defined %{"$base\::FIELDS"}) will
+	# sometimes produce typo warnings because it would create
+	# the hash if it was not present before.
+	my $fglob;
+	if ($fglob = ${"$base\::"}{"FIELDS"} and *$fglob{HASH}) {
+	    if ($fields_base) {
+		require Carp;
+		Carp::croak("Can't multiply inherit %FIELDS");
+	    } else {
+		$fields_base = $base;
+	    }
+	}
+    }
+    if ($fields_base) {
+	require fields;
+	fields::inherit($pkg, $fields_base);
+    }
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/blib.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/blib.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/blib.pm	(revision 14265)
@@ -0,0 +1,72 @@
+package blib;
+
+=head1 NAME
+
+blib - Use MakeMaker's uninstalled version of a package
+
+=head1 SYNOPSIS
+
+ perl -Mblib script [args...]
+
+ perl -Mblib=dir script [args...]
+
+=head1 DESCRIPTION
+
+Looks for MakeMaker-like I<'blib'> directory structure starting in 
+I<dir> (or current directory) and working back up to five levels of '..'.
+
+Intended for use on command line with B<-M> option as a way of testing
+arbitary scripts against an uninstalled version of a package.
+
+However it is possible to : 
+
+ use blib; 
+ or 
+ use blib '..';
+
+etc. if you really must.
+
+=head1 BUGS
+
+Pollutes global name space for development only task.
+
+=head1 AUTHOR
+
+Nick Ing-Simmons nik@tiuk.ti.com
+
+=cut 
+
+use Cwd;
+
+use vars qw($VERSION);
+$VERSION = '1.00';
+
+sub import
+{
+ my $package = shift;
+ my $dir = getcwd;
+ if ($^O eq 'VMS') { ($dir = VMS::Filespec::unixify($dir)) =~ s-/\z--; }
+ if (@_)
+  {
+   $dir = shift;
+   $dir =~ s/blib\z//;
+   $dir =~ s,/+\z,,;
+   $dir = '.' unless ($dir);
+   die "$dir is not a directory\n" unless (-d $dir);
+  }
+ my $i   = 5;
+ while ($i--)
+  {
+   my $blib = "${dir}/blib";
+   if (-d $blib && -d "$blib/arch" && -d "$blib/lib")
+    {
+     unshift(@INC,"$blib/arch","$blib/lib");
+     warn "Using $blib\n";
+     return;
+    }
+   $dir .= "/..";
+  }
+ die "Cannot find blib even in $dir\n";
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/bytes.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/bytes.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/bytes.pm	(revision 14265)
@@ -0,0 +1,69 @@
+package bytes;
+
+$bytes::hint_bits = 0x00000008;
+
+sub import {
+    $^H |= $bytes::hint_bits;
+}
+
+sub unimport {
+    $^H &= ~$bytes::hint_bits;
+}
+
+sub AUTOLOAD {
+    require "bytes_heavy.pl";
+    goto &$AUTOLOAD;
+}
+
+sub length ($);
+
+1;
+__END__
+
+=head1 NAME
+
+bytes - Perl pragma to force byte semantics rather than character semantics
+
+=head1 SYNOPSIS
+
+    use bytes;
+    no bytes;
+
+=head1 DESCRIPTION
+
+WARNING: The implementation of Unicode support in Perl is incomplete.
+See L<perlunicode> for the exact details.
+
+The C<use bytes> pragma disables character semantics for the rest of the
+lexical scope in which it appears.  C<no bytes> can be used to reverse
+the effect of C<use bytes> within the current lexical scope.
+
+Perl normally assumes character semantics in the presence of character
+data (i.e. data that has come from a source that has been marked as
+being of a particular character encoding). When C<use bytes> is in
+effect, the encoding is temporarily ignored, and each string is treated
+as a series of bytes. 
+
+As an example, when Perl sees C<$x = chr(400)>, it encodes the character
+in UTF8 and stores it in $x. Then it is marked as character data, so,
+for instance, C<length $x> returns C<1>. However, in the scope of the
+C<bytes> pragma, $x is treated as a series of bytes - the bytes that make
+up the UTF8 encoding - and C<length $x> returns C<2>:
+
+    $x = chr(400);
+    print "Length is ", length $x, "\n";     # "Length is 1"
+    printf "Contents are %vd\n", $x;         # "Contents are 400"
+    { 
+        use bytes;
+        print "Length is ", length $x, "\n"; # "Length is 2"
+        printf "Contents are %vd\n", $x;     # "Contents are 198.144"
+    }
+
+For more on the implications and differences between character
+semantics and byte semantics, see L<perlunicode>.
+
+=head1 SEE ALSO
+
+L<perlunicode>, L<utf8>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/charnames.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/charnames.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/charnames.pm	(revision 14265)
@@ -0,0 +1,146 @@
+package charnames;
+use bytes ();		# for $bytes::hint_bits
+use warnings();
+$charnames::hint_bits = 0x20000;
+
+my $txt;
+
+# This is not optimized in any way yet
+sub charnames {
+  $name = shift;
+  $txt = do "unicode/Name.pl" unless $txt;
+  my @off;
+  if ($^H{charnames_full} and $txt =~ /\t\t$name$/m) {
+    @off = ($-[0], $+[0]);
+  }
+  unless (@off) {
+    if ($^H{charnames_short} and $name =~ /^(.*?):(.*)/s) {
+      my ($script, $cname) = ($1,$2);
+      my $case = ( $cname =~ /[[:upper:]]/ ? "CAPITAL" : "SMALL");
+      if ($txt =~ m/\t\t\U$script\E (?:$case )?LETTER \U$cname$/m) {
+	@off = ($-[0], $+[0]);
+      }
+    }
+  }
+  unless (@off) {
+    my $case = ( $name =~ /[[:upper:]]/ ? "CAPITAL" : "SMALL");
+    for ( @{$^H{charnames_scripts}} ) {
+      (@off = ($-[0], $+[0])), last 
+	if $txt =~ m/\t\t$_ (?:$case )?LETTER \U$name$/m;
+    }
+  }
+  die "Unknown charname '$name'" unless @off;
+
+  my $hexlen = 4; # Unicode guarantees 4-, 5-, or 6-digit format
+  $hexlen++ while
+      $hexlen < 6 && substr($txt, $off[0] - $hexlen - 1, 1) =~ /[0-9a-f]/;
+  my $ord = hex substr $txt, $off[0] - $hexlen, $hexlen;
+  if ($^H & $bytes::hint_bits) {	# "use bytes" in effect?
+    use bytes;
+    return chr $ord if $ord <= 255;
+    my $hex = sprintf '%X=0%o', $ord, $ord;
+    my $fname = substr $txt, $off[0] + 2, $off[1] - $off[0] - 2;
+    die "Character 0x$hex with name '$fname' is above 0xFF";
+  }
+  return chr $ord;
+}
+
+sub import {
+  shift;
+  die "`use charnames' needs explicit imports list" unless @_;
+  $^H |= $charnames::hint_bits;
+  $^H{charnames} = \&charnames ;
+  my %h;
+  @h{@_} = (1) x @_;
+  $^H{charnames_full} = delete $h{':full'};
+  $^H{charnames_short} = delete $h{':short'};
+  $^H{charnames_scripts} = [map uc, keys %h];
+  if (warnings::enabled('utf8') && @{$^H{charnames_scripts}}) {
+	$txt = do "unicode/Name.pl" unless $txt;
+    for (@{$^H{charnames_scripts}}) {
+        warnings::warn('utf8',  "No such script: '$_'") unless
+	    $txt =~ m/\t\t$_ (?:CAPITAL |SMALL )?LETTER /;
+	}
+  }
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+charnames - define character names for C<\N{named}> string literal escape.
+
+=head1 SYNOPSIS
+
+  use charnames ':full';
+  print "\N{GREEK SMALL LETTER SIGMA} is called sigma.\n";
+
+  use charnames ':short';
+  print "\N{greek:Sigma} is an upper-case sigma.\n";
+
+  use charnames qw(cyrillic greek);
+  print "\N{sigma} is Greek sigma, and \N{be} is Cyrillic b.\n";
+
+=head1 DESCRIPTION
+
+Pragma C<use charnames> supports arguments C<:full>, C<:short> and
+script names.  If C<:full> is present, for expansion of
+C<\N{CHARNAME}}> string C<CHARNAME> is first looked in the list of
+standard Unicode names of chars.  If C<:short> is present, and
+C<CHARNAME> has the form C<SCRIPT:CNAME>, then C<CNAME> is looked up
+as a letter in script C<SCRIPT>.  If pragma C<use charnames> is used
+with script name arguments, then for C<\N{CHARNAME}}> the name
+C<CHARNAME> is looked up as a letter in the given scripts (in the
+specified order).
+
+For lookup of C<CHARNAME> inside a given script C<SCRIPTNAME>
+this pragma looks for the names
+
+  SCRIPTNAME CAPITAL LETTER CHARNAME
+  SCRIPTNAME SMALL LETTER CHARNAME
+  SCRIPTNAME LETTER CHARNAME
+
+in the table of standard Unicode names.  If C<CHARNAME> is lowercase,
+then the C<CAPITAL> variant is ignored, otherwise the C<SMALL> variant is
+ignored.
+
+=head1 CUSTOM TRANSLATORS
+
+The mechanism of translation of C<\N{...}> escapes is general and not
+hardwired into F<charnames.pm>.  A module can install custom
+translations (inside the scope which C<use>s the module) with the
+following magic incantation:
+
+    use charnames ();		# for $charnames::hint_bits
+    sub import {
+	shift;
+	$^H |= $charnames::hint_bits;
+	$^H{charnames} = \&translator;
+    }
+
+Here translator() is a subroutine which takes C<CHARNAME> as an
+argument, and returns text to insert into the string instead of the
+C<\N{CHARNAME}> escape.  Since the text to insert should be different
+in C<bytes> mode and out of it, the function should check the current
+state of C<bytes>-flag as in:
+
+    use bytes ();			# for $bytes::hint_bits
+    sub translator {
+	if ($^H & $bytes::hint_bits) {
+	    return bytes_translator(@_);
+	}
+	else {
+	    return utf8_translator(@_);
+	}
+    }
+
+=head1 BUGS
+
+Since evaluation of the translation function happens in a middle of
+compilation (of a string literal), the translation function should not
+do any C<eval>s or C<require>s.  This restriction should be lifted in
+a future version of Perl.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/constant.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/constant.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/constant.pm	(revision 14265)
@@ -0,0 +1,278 @@
+package constant;
+
+use strict;
+use 5.005_64;
+use warnings::register;
+
+our($VERSION, %declared);
+$VERSION = '1.02';
+
+#=======================================================================
+
+# Some names are evil choices.
+my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD };
+
+my %forced_into_main = map +($_, 1),
+    qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG };
+
+my %forbidden = (%keywords, %forced_into_main);
+
+#=======================================================================
+# import() - import symbols into user's namespace
+#
+# What we actually do is define a function in the caller's namespace
+# which returns the value. The function we create will normally
+# be inlined as a constant, thereby avoiding further sub calling 
+# overhead.
+#=======================================================================
+sub import {
+    my $class = shift;
+    return unless @_;			# Ignore 'use constant;'
+    my $name = shift;
+    unless (defined $name) {
+        require Carp;
+	Carp::croak("Can't use undef as constant name");
+    }
+    my $pkg = caller;
+
+    # Normal constant name
+    if ($name =~ /^_?[^\W_0-9]\w*\z/ and !$forbidden{$name}) {
+        # Everything is okay
+
+    # Name forced into main, but we're not in main. Fatal.
+    } elsif ($forced_into_main{$name} and $pkg ne 'main') {
+	require Carp;
+	Carp::croak("Constant name '$name' is forced into main::");
+
+    # Starts with double underscore. Fatal.
+    } elsif ($name =~ /^__/) {
+	require Carp;
+	Carp::croak("Constant name '$name' begins with '__'");
+
+    # Maybe the name is tolerable
+    } elsif ($name =~ /^[A-Za-z_]\w*\z/) {
+	# Then we'll warn only if you've asked for warnings
+	if (warnings::enabled()) {
+	    if ($keywords{$name}) {
+		warnings::warn("Constant name '$name' is a Perl keyword");
+	    } elsif ($forced_into_main{$name}) {
+		warnings::warn("Constant name '$name' is " .
+		    "forced into package main::");
+	    } else {
+		# Catch-all - what did I miss? If you get this error,
+		# please let me know what your constant's name was.
+		# Write to <rootbeer@redcat.com>. Thanks!
+		warnings::warn("Constant name '$name' has unknown problems");
+	    }
+	}
+
+    # Looks like a boolean
+    # 		use constant FRED == fred;
+    } elsif ($name =~ /^[01]?\z/) {
+        require Carp;
+	if (@_) {
+	    Carp::croak("Constant name '$name' is invalid");
+	} else {
+	    Carp::croak("Constant name looks like boolean value");
+	}
+
+    } else {
+	# Must have bad characters
+        require Carp;
+	Carp::croak("Constant name '$name' has invalid characters");
+    }
+
+    {
+	no strict 'refs';
+	my $full_name = "${pkg}::$name";
+	$declared{$full_name}++;
+	if (@_ == 1) {
+	    my $scalar = $_[0];
+	    *$full_name = sub () { $scalar };
+	} elsif (@_) {
+	    my @list = @_;
+	    *$full_name = sub () { @list };
+	} else {
+	    *$full_name = sub () { };
+	}
+    }
+
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+constant - Perl pragma to declare constants
+
+=head1 SYNOPSIS
+
+    use constant BUFFER_SIZE	=> 4096;
+    use constant ONE_YEAR	=> 365.2425 * 24 * 60 * 60;
+    use constant PI		=> 4 * atan2 1, 1;
+    use constant DEBUGGING	=> 0;
+    use constant ORACLE		=> 'oracle@cs.indiana.edu';
+    use constant USERNAME	=> scalar getpwuid($<);
+    use constant USERINFO	=> getpwuid($<);
+
+    sub deg2rad { PI * $_[0] / 180 }
+
+    print "This line does nothing"		unless DEBUGGING;
+
+    # references can be constants
+    use constant CHASH		=> { foo => 42 };
+    use constant CARRAY		=> [ 1,2,3,4 ];
+    use constant CPSEUDOHASH	=> [ { foo => 1}, 42 ];
+    use constant CCODE		=> sub { "bite $_[0]\n" };
+
+    print CHASH->{foo};
+    print CARRAY->[$i];
+    print CPSEUDOHASH->{foo};
+    print CCODE->("me");
+    print CHASH->[10];			# compile-time error
+
+=head1 DESCRIPTION
+
+This will declare a symbol to be a constant with the given scalar
+or list value.
+
+When you declare a constant such as C<PI> using the method shown
+above, each machine your script runs upon can have as many digits
+of accuracy as it can use. Also, your program will be easier to
+read, more likely to be maintained (and maintained correctly), and
+far less likely to send a space probe to the wrong planet because
+nobody noticed the one equation in which you wrote C<3.14195>.
+
+=head1 NOTES
+
+The value or values are evaluated in a list context. You may override
+this with C<scalar> as shown above.
+
+These constants do not directly interpolate into double-quotish
+strings, although you may do so indirectly. (See L<perlref> for
+details about how this works.)
+
+    print "The value of PI is @{[ PI ]}.\n";
+
+List constants are returned as lists, not as arrays.
+
+    $homedir = USERINFO[7];		# WRONG
+    $homedir = (USERINFO)[7];		# Right
+
+The use of all caps for constant names is merely a convention,
+although it is recommended in order to make constants stand out
+and to help avoid collisions with other barewords, keywords, and
+subroutine names. Constant names must begin with a letter or
+underscore. Names beginning with a double underscore are reserved. Some
+poor choices for names will generate warnings, if warnings are enabled at
+compile time.
+
+Constant symbols are package scoped (rather than block scoped, as
+C<use strict> is). That is, you can refer to a constant from package
+Other as C<Other::CONST>.
+
+As with all C<use> directives, defining a constant happens at
+compile time. Thus, it's probably not correct to put a constant
+declaration inside of a conditional statement (like C<if ($foo)
+{ use constant ... }>).
+
+Omitting the value for a symbol gives it the value of C<undef> in
+a scalar context or the empty list, C<()>, in a list context. This
+isn't so nice as it may sound, though, because in this case you
+must either quote the symbol name, or use a big arrow, (C<=E<gt>>),
+with nothing to point to. It is probably best to declare these
+explicitly.
+
+    use constant UNICORNS	=> ();
+    use constant LOGFILE	=> undef;
+
+The result from evaluating a list constant in a scalar context is
+not documented, and is B<not> guaranteed to be any particular value
+in the future. In particular, you should not rely upon it being
+the number of elements in the list, especially since it is not
+B<necessarily> that value in the current implementation.
+
+Magical values, tied values, and references can be made into
+constants at compile time, allowing for way cool stuff like this.
+(These error numbers aren't totally portable, alas.)
+
+    use constant E2BIG => ($! = 7);
+    print   E2BIG, "\n";	# something like "Arg list too long"
+    print 0+E2BIG, "\n";	# "7"
+
+Dereferencing constant references incorrectly (such as using an array
+subscript on a constant hash reference, or vice versa) will be trapped at
+compile time.
+
+In the rare case in which you need to discover at run time whether a
+particular constant has been declared via this module, you may use
+this function to examine the hash C<%constant::declared>. If the given
+constant name does not include a package name, the current package is
+used.
+
+    sub declared ($) {
+	use constant 1.01;		# don't omit this!
+	my $name = shift;
+	$name =~ s/^::/main::/;
+	my $pkg = caller;
+	my $full_name = $name =~ /::/ ? $name : "${pkg}::$name";
+	$constant::declared{$full_name};
+    }
+
+=head1 TECHNICAL NOTE
+
+In the current implementation, scalar constants are actually
+inlinable subroutines. As of version 5.004 of Perl, the appropriate
+scalar constant is inserted directly in place of some subroutine
+calls, thereby saving the overhead of a subroutine call. See
+L<perlsub/"Constant Functions"> for details about how and when this
+happens.
+
+=head1 BUGS
+
+In the current version of Perl, list constants are not inlined
+and some symbols may be redefined without generating a warning.
+
+It is not possible to have a subroutine or keyword with the same
+name as a constant in the same package. This is probably a Good Thing.
+
+A constant with a name in the list C<STDIN STDOUT STDERR ARGV ARGVOUT
+ENV INC SIG> is not allowed anywhere but in package C<main::>, for
+technical reasons. 
+
+Even though a reference may be declared as a constant, the reference may
+point to data which may be changed, as this code shows.
+
+    use constant CARRAY		=> [ 1,2,3,4 ];
+    print CARRAY->[1];
+    CARRAY->[1] = " be changed";
+    print CARRAY->[1];
+
+Unlike constants in some languages, these cannot be overridden
+on the command line or via environment variables.
+
+You can get into trouble if you use constants in a context which
+automatically quotes barewords (as is true for any subroutine call).
+For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will
+be interpreted as a string.  Use C<$hash{CONSTANT()}> or
+C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from
+kicking in.  Similarly, since the C<=E<gt>> operator quotes a bareword
+immediately to its left, you have to say C<CONSTANT() =E<gt> 'value'>
+(or simply use a comma in place of the big arrow) instead of
+C<CONSTANT =E<gt> 'value'>.
+
+=head1 AUTHOR
+
+Tom Phoenix, E<lt>F<rootbeer@redcat.com>E<gt>, with help from
+many other folks.
+
+=head1 COPYRIGHT
+
+Copyright (C) 1997, 1999 Tom Phoenix
+
+This module is free software; you can redistribute it or modify it
+under the same terms as Perl itself.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/diagnostics.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/diagnostics.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/diagnostics.pm	(revision 14265)
@@ -0,0 +1,6 @@
+package diagnostics;
+
+# do nothing - diagnostics package is disabled for this dodgy
+# Greenstone version of perl
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/fields.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/fields.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/fields.pm	(revision 14265)
@@ -0,0 +1,285 @@
+package fields;
+
+=head1 NAME
+
+fields - compile-time class fields
+
+=head1 SYNOPSIS
+
+    {
+        package Foo;
+        use fields qw(foo bar _Foo_private);
+	sub new {
+	    my Foo $self = shift;
+	    unless (ref $self) {
+		$self = fields::new($self);
+		$self->{_Foo_private} = "this is Foo's secret";
+	    }
+	    $self->{foo} = 10;
+	    $self->{bar} = 20;
+	    return $self;
+	}
+    }
+
+    my Foo $var = Foo::->new;
+    $var->{foo} = 42;
+
+    # this will generate a compile-time error
+    $var->{zap} = 42;
+
+    # subclassing
+    {
+        package Bar;
+        use base 'Foo';
+        use fields qw(baz _Bar_private);	# not shared with Foo
+	sub new {
+	    my $class = shift;
+	    my $self = fields::new($class);
+	    $self->SUPER::new();		# init base fields
+	    $self->{baz} = 10;			# init own fields
+	    $self->{_Bar_private} = "this is Bar's secret";
+	    return $self;
+	}
+    }
+
+=head1 DESCRIPTION
+
+The C<fields> pragma enables compile-time verified class fields.
+
+NOTE: The current implementation keeps the declared fields in the %FIELDS
+hash of the calling package, but this may change in future versions.
+Do B<not> update the %FIELDS hash directly, because it must be created
+at compile-time for it to be fully useful, as is done by this pragma.
+
+If a typed lexical variable holding a reference is used to access a
+hash element and a package with the same name as the type has declared
+class fields using this pragma, then the operation is turned into an
+array access at compile time.
+
+The related C<base> pragma will combine fields from base classes and any
+fields declared using the C<fields> pragma.  This enables field
+inheritance to work properly.
+
+Field names that start with an underscore character are made private to
+the class and are not visible to subclasses.  Inherited fields can be
+overridden but will generate a warning if used together with the C<-w>
+switch.
+
+The effect of all this is that you can have objects with named fields
+which are as compact and as fast arrays to access.  This only works
+as long as the objects are accessed through properly typed variables.
+If the objects are not typed, access is only checked at run time.
+
+The following functions are supported:
+
+=over 8
+
+=item new
+
+fields::new() creates and blesses a pseudo-hash comprised of the fields
+declared using the C<fields> pragma into the specified class.
+This makes it possible to write a constructor like this:
+
+    package Critter::Sounds;
+    use fields qw(cat dog bird);
+
+    sub new {
+	my Critter::Sounds $self = shift;
+	$self = fields::new($self) unless ref $self;
+	$self->{cat} = 'meow';				# scalar element
+	@$self{'dog','bird'} = ('bark','tweet');	# slice
+	return $self;
+    }
+
+=item phash
+
+fields::phash() can be used to create and initialize a plain (unblessed)
+pseudo-hash.  This function should always be used instead of creating
+pseudo-hashes directly.
+
+If the first argument is a reference to an array, the pseudo-hash will
+be created with keys from that array.  If a second argument is supplied,
+it must also be a reference to an array whose elements will be used as
+the values.  If the second array contains less elements than the first,
+the trailing elements of the pseudo-hash will not be initialized.
+This makes it particularly useful for creating a pseudo-hash from
+subroutine arguments:
+
+    sub dogtag {
+	my $tag = fields::phash([qw(name rank ser_num)], [@_]);
+    }
+
+fields::phash() also accepts a list of key-value pairs that will
+be used to construct the pseudo hash.  Examples:
+
+    my $tag = fields::phash(name => "Joe",
+			    rank => "captain",
+			    ser_num => 42);
+
+    my $pseudohash = fields::phash(%args);
+
+=back
+
+=head1 SEE ALSO
+
+L<base>,
+L<perlref/Pseudo-hashes: Using an array as a hash>
+
+=cut
+
+use 5.005_64;
+use strict;
+no strict 'refs';
+use warnings::register;
+our(%attr, $VERSION);
+
+$VERSION = "1.01";
+
+# some constants
+sub _PUBLIC    () { 1 }
+sub _PRIVATE   () { 2 }
+
+# The %attr hash holds the attributes of the currently assigned fields
+# per class.  The hash is indexed by class names and the hash value is
+# an array reference.  The first element in the array is the lowest field
+# number not belonging to a base class.  The remaining elements' indices
+# are the field numbers.  The values are integer bit masks, or undef
+# in the case of base class private fields (which occupy a slot but are
+# otherwise irrelevant to the class).
+
+sub import {
+    my $class = shift;
+    return unless @_;
+    my $package = caller(0);
+    # avoid possible typo warnings
+    %{"$package\::FIELDS"} = () unless %{"$package\::FIELDS"};
+    my $fields = \%{"$package\::FIELDS"};
+    my $fattr = ($attr{$package} ||= [1]);
+    my $next = @$fattr;
+
+    if ($next > $fattr->[0]
+	and ($fields->{$_[0]} || 0) >= $fattr->[0])
+    {
+	# There are already fields not belonging to base classes.
+	# Looks like a possible module reload...
+	$next = $fattr->[0];
+    }
+    foreach my $f (@_) {
+	my $fno = $fields->{$f};
+
+	# Allow the module to be reloaded so long as field positions
+	# have not changed.
+	if ($fno and $fno != $next) {
+	    require Carp;
+            if ($fno < $fattr->[0]) {
+                warnings::warnif("Hides field '$f' in base class") ;
+            } else {
+                Carp::croak("Field name '$f' already in use");
+            }
+	}
+	$fields->{$f} = $next;
+        $fattr->[$next] = ($f =~ /^_/) ? _PRIVATE : _PUBLIC;
+	$next += 1;
+    }
+    if (@$fattr > $next) {
+	# Well, we gave them the benefit of the doubt by guessing the
+	# module was reloaded, but they appear to be declaring fields
+	# in more than one place.  We can't be sure (without some extra
+	# bookkeeping) that the rest of the fields will be declared or
+	# have the same positions, so punt.
+	require Carp;
+	Carp::croak ("Reloaded module must declare all fields at once");
+    }
+}
+
+sub inherit  { # called by base.pm when $base_fields is nonempty
+    my($derived, $base) = @_;
+    my $base_attr = $attr{$base};
+    my $derived_attr = $attr{$derived} ||= [];
+    # avoid possible typo warnings
+    %{"$base\::FIELDS"} = () unless %{"$base\::FIELDS"};
+    %{"$derived\::FIELDS"} = () unless %{"$derived\::FIELDS"};
+    my $base_fields    = \%{"$base\::FIELDS"};
+    my $derived_fields = \%{"$derived\::FIELDS"};
+
+    $derived_attr->[0] = $base_attr ? scalar(@$base_attr) : 1;
+    while (my($k,$v) = each %$base_fields) {
+	my($fno);
+	if ($fno = $derived_fields->{$k} and $fno != $v) {
+	    require Carp;
+	    Carp::croak ("Inherited %FIELDS can't override existing %FIELDS");
+	}
+	if ($base_attr->[$v] & _PRIVATE) {
+	    $derived_attr->[$v] = undef;
+	} else {
+	    $derived_attr->[$v] = $base_attr->[$v];
+	    $derived_fields->{$k} = $v;
+	}
+     }
+}
+
+sub _dump  # sometimes useful for debugging
+{
+    for my $pkg (sort keys %attr) {
+	print "\n$pkg";
+	if (@{"$pkg\::ISA"}) {
+	    print " (", join(", ", @{"$pkg\::ISA"}), ")";
+	}
+	print "\n";
+	my $fields = \%{"$pkg\::FIELDS"};
+	for my $f (sort {$fields->{$a} <=> $fields->{$b}} keys %$fields) {
+	    my $no = $fields->{$f};
+	    print "   $no: $f";
+	    my $fattr = $attr{$pkg}[$no];
+	    if (defined $fattr) {
+		my @a;
+		push(@a, "public")    if $fattr & _PUBLIC;
+		push(@a, "private")   if $fattr & _PRIVATE;
+		push(@a, "inherited") if $no < $attr{$pkg}[0];
+		print "\t(", join(", ", @a), ")";
+	    }
+	    print "\n";
+	}
+    }
+}
+
+sub new {
+    my $class = shift;
+    $class = ref $class if ref $class;
+    return bless [\%{$class . "::FIELDS"}], $class;
+}
+
+sub phash {
+    my $h;
+    my $v;
+    if (@_) {
+	if (ref $_[0] eq 'ARRAY') {
+	    my $a = shift;
+	    @$h{@$a} = 1 .. @$a;
+	    if (@_) {
+		$v = shift;
+		unless (! @_ and ref $v eq 'ARRAY') {
+		    require Carp;
+		    Carp::croak ("Expected at most two array refs\n");
+		}
+	    }
+	}
+	else {
+	    if (@_ % 2) {
+		require Carp;
+		Carp::croak ("Odd number of elements initializing pseudo-hash\n");
+	    }
+	    my $i = 0;
+	    @$h{grep ++$i % 2, @_} = 1 .. @_ / 2;
+	    $i = 0;
+	    $v = [grep $i++ % 2, @_];
+	}
+    }
+    else {
+	$h = {};
+	$v = [];
+    }
+    [ $h, @$v ];
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/filetest.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/filetest.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/filetest.pm	(revision 14265)
@@ -0,0 +1,68 @@
+package filetest;
+
+=head1 NAME
+
+filetest - Perl pragma to control the filetest permission operators
+
+=head1 SYNOPSIS
+
+    $can_perhaps_read = -r "file";	# use the mode bits
+    {
+        use filetest 'access';		# intuit harder
+        $can_really_read = -r "file";
+    }
+    $can_perhaps_read = -r "file";	# use the mode bits again
+
+=head1 DESCRIPTION
+
+This pragma tells the compiler to change the behaviour of the filetest
+permissions operators, the C<-r> C<-w> C<-x> C<-R> C<-W> C<-X>
+(see L<perlfunc>).
+
+The default behaviour to use the mode bits as returned by the stat()
+family of calls.  This, however, may not be the right thing to do if
+for example various ACL (access control lists) schemes are in use.
+For such environments, C<use filetest> may help the permission
+operators to return results more consistent with other tools.
+
+Each "use filetest" or "no filetest" affects statements to the end of
+the enclosing block.
+
+There may be a slight performance decrease in the filetests
+when C<use filetest> is in effect, because in some systems
+the extended functionality needs to be emulated.
+
+B<NOTE>: using the file tests for security purposes is a lost cause
+from the start: there is a window open for race conditions (who is to
+say that the permissions will not change between the test and the real
+operation?).  Therefore if you are serious about security, just try
+the real operation and test for its success.  Think atomicity.
+
+=head2 subpragma access
+
+Currently only one subpragma, C<access> is implemented.  It enables
+(or disables) the use of access() or similar system calls.  This
+extended filetest functionality is used only when the argument of the
+operators is a filename, not when it is a filehandle.
+
+=cut
+
+$filetest::hint_bits = 0x00400000;
+
+sub import {
+    if ( $_[1] eq 'access' ) {
+	$^H |= $filetest::hint_bits;
+    } else {
+	die "filetest: the only implemented subpragma is 'access'.\n";
+    }
+}
+
+sub unimport {
+    if ( $_[1] eq 'access' ) {
+	$^H &= ~$filetest::hint_bits;
+    } else {
+	die "filetest: the only implemented subpragma is 'access'.\n";
+    }
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/integer.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/integer.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/integer.pm	(revision 14265)
@@ -0,0 +1,91 @@
+package integer;
+
+=head1 NAME
+
+integer - Perl pragma to use integer arithmetic instead of floating point
+
+=head1 SYNOPSIS
+
+    use integer;
+    $x = 10/3;
+    # $x is now 3, not 3.33333333333333333
+
+=head1 DESCRIPTION
+
+This tells the compiler to use integer operations from here to the end
+of the enclosing BLOCK.  On many machines, this doesn't matter a great
+deal for most computations, but on those without floating point
+hardware, it can make a big difference in performance.
+
+Note that this only affects how most of the arithmetic and relational
+B<operators> handle their operands and results, and B<not> how all
+numbers everywhere are treated.  Specifically, C<use integer;> has the
+effect that before computing the results of the arithmetic operators
+(+, -, *, /, %, +=, -=, *=, /=, %=, and unary minus), the comparison
+operators (<, <=, >, >=, ==, !=, <=>), and the bitwise operators (|, &,
+^, <<, >>, |=, &=, ^=, <<=, >>=), the operands have their fractional
+portions truncated (or floored), and the result will have its
+fractional portion truncated as well.  In addition, the range of
+operands and results is restricted to that of familiar two's complement
+integers, i.e., -(2**31) .. (2**31-1) on 32-bit architectures, and
+-(2**63) .. (2**63-1) on 64-bit architectures.  For example, this code
+
+    use integer;
+    $x = 5.8;
+    $y = 2.5;
+    $z = 2.7;
+    $a = 2**31 - 1;  # Largest positive integer on 32-bit machines
+    $, = ", ";
+    print $x, -$x, $x + $y, $x - $y, $x / $y, $x * $y, $y == $z, $a, $a + 1;
+
+will print:  5.8, -5, 7, 3, 2, 10, 1, 2147483647, -2147483648
+
+Note that $x is still printed as having its true non-integer value of
+5.8 since it wasn't operated on.  And note too the wrap-around from the
+largest positive integer to the largest negative one.   Also, arguments
+passed to functions and the values returned by them are B<not> affected
+by C<use integer;>.  E.g.,
+
+    srand(1.5);
+    $, = ", ";
+    print sin(.5), cos(.5), atan2(1,2), sqrt(2), rand(10);
+
+will give the same result with or without C<use integer;>  The power
+operator C<**> is also not affected, so that 2 ** .5 is always the
+square root of 2.  Now, it so happens that the pre- and post- increment
+and decrement operators, ++ and --, are not affected by C<use integer;>
+either.  Some may rightly consider this to be a bug -- but at least it's
+a long-standing one.
+
+Finally, C<use integer;> also has an additional affect on the bitwise
+operators.  Normally, the operands and results are treated as
+B<unsigned> integers, but with C<use integer;> the operands and results
+are B<signed>.  This means, among other things, that ~0 is -1, and -2 &
+-5 is -6.
+
+Internally, native integer arithmetic (as provided by your C compiler)
+is used.  This means that Perl's own semantics for arithmetic
+operations may not be preserved.  One common source of trouble is the
+modulus of negative numbers, which Perl does one way, but your hardware
+may do another.
+
+    % perl -le 'print (4 % -3)'
+    -2
+    % perl -Minteger -le 'print (4 % -3)'
+    1
+
+See L<perlmodlib/"Pragmatic Modules">, L<perlop/"Integer Arithmetic">
+
+=cut
+
+$integer::hint_bits = 0x1;
+
+sub import {
+    $^H |= $integer::hint_bits;
+}
+
+sub unimport {
+    $^H &= ~$integer::hint_bits;
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/less.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/less.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/less.pm	(revision 14265)
@@ -0,0 +1,23 @@
+package less;
+
+=head1 NAME
+
+less - perl pragma to request less of something from the compiler
+
+=head1 SYNOPSIS
+
+    use less;  # unimplemented
+
+=head1 DESCRIPTION
+
+Currently unimplemented, this may someday be a compiler directive
+to make certain trade-offs, such as perhaps
+
+    use less 'memory';
+    use less 'CPU';
+    use less 'fat';
+
+
+=cut
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/lib.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/lib.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/lib.pm	(revision 14265)
@@ -0,0 +1,136 @@
+package lib;
+
+use 5.005_64;
+use Config;
+
+my $archname = defined($Config{'archname'}) ? $Config{'archname'} : '';
+my $ver = defined($Config{'version'}) ? $Config{'version'} : '';
+my @inc_version_list = defined($Config{'inc_version_list'}) ?
+   reverse split / /, $Config{'inc_version_list'} : ();
+
+our @ORIG_INC = @INC;	# take a handy copy of 'original' value
+our $VERSION = '0.5564';
+
+sub import {
+    shift;
+
+    my %names;
+    foreach (reverse @_) {
+	if ($_ eq '') {
+	    require Carp;
+	    Carp::carp("Empty compile time value given to use lib");
+	}
+	if (-e && ! -d _) {
+	    require Carp;
+	    Carp::carp("Parameter to use lib must be directory, not file");
+	}
+	unshift(@INC, $_);
+        # Add any previous version directories we found at configure time
+        foreach my $incver (@inc_version_list)
+        {
+            unshift(@INC, "$_/$incver") if -d "$_/$incver";
+        }
+	# Put a corresponding archlib directory infront of $_ if it
+	# looks like $_ has an archlib directory below it.
+	unshift(@INC, "$_/$archname") if -d "$_/$archname/auto";
+	unshift(@INC, "$_/$ver") if -d "$_/$ver";
+	unshift(@INC, "$_/$ver/$archname") if -d "$_/$ver/$archname";
+    }
+
+    # remove trailing duplicates
+    @INC = grep { ++$names{$_} == 1 } @INC;
+    return;
+}
+
+
+sub unimport {
+    shift;
+
+    my %names;
+    foreach (@_) {
+	++$names{$_};
+	++$names{"$_/$archname"} if -d "$_/$archname/auto";
+	++$names{"$_/$ver"} if -d "$_/$ver";
+	++$names{"$_/$ver/$archname"} if -d "$_/$ver/$archname";
+    }
+
+    # Remove ALL instances of each named directory.
+    @INC = grep { !exists $names{$_} } @INC;
+    return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+lib - manipulate @INC at compile time
+
+=head1 SYNOPSIS
+
+    use lib LIST;
+
+    no lib LIST;
+
+=head1 DESCRIPTION
+
+This is a small simple module which simplifies the manipulation of @INC
+at compile time.
+
+It is typically used to add extra directories to perl's search path so
+that later C<use> or C<require> statements will find modules which are
+not located on perl's default search path.
+
+=head2 Adding directories to @INC
+
+The parameters to C<use lib> are added to the start of the perl search
+path. Saying
+
+    use lib LIST;
+
+is I<almost> the same as saying
+
+    BEGIN { unshift(@INC, LIST) }
+
+For each directory in LIST (called $dir here) the lib module also
+checks to see if a directory called $dir/$archname/auto exists.
+If so the $dir/$archname directory is assumed to be a corresponding
+architecture specific directory and is added to @INC in front of $dir.
+
+To avoid memory leaks, all trailing duplicate entries in @INC are
+removed.
+
+=head2 Deleting directories from @INC
+
+You should normally only add directories to @INC.  If you need to
+delete directories from @INC take care to only delete those which you
+added yourself or which you are certain are not needed by other modules
+in your script.  Other modules may have added directories which they
+need for correct operation.
+
+The C<no lib> statement deletes all instances of each named directory
+from @INC.
+
+For each directory in LIST (called $dir here) the lib module also
+checks to see if a directory called $dir/$archname/auto exists.
+If so the $dir/$archname directory is assumed to be a corresponding
+architecture specific directory and is also deleted from @INC.
+
+=head2 Restoring original @INC
+
+When the lib module is first loaded it records the current value of @INC
+in an array C<@lib::ORIG_INC>. To restore @INC to that value you
+can say
+
+    @INC = @lib::ORIG_INC;
+
+
+=head1 SEE ALSO
+
+FindBin - optional module which deals with paths relative to the source file.
+
+=head1 AUTHOR
+
+Tim Bunce, 2nd June 1995.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/locale.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/locale.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/locale.pm	(revision 14265)
@@ -0,0 +1,38 @@
+package locale;
+
+=head1 NAME
+
+locale - Perl pragma to use and avoid POSIX locales for built-in operations
+
+=head1 SYNOPSIS
+
+    @x = sort @y;	# ASCII sorting order
+    {
+        use locale;
+        @x = sort @y;   # Locale-defined sorting order
+    }
+    @x = sort @y;	# ASCII sorting order again
+
+=head1 DESCRIPTION
+
+This pragma tells the compiler to enable (or disable) the use of POSIX
+locales for built-in operations (LC_CTYPE for regular expressions, and
+LC_COLLATE for string comparison).  Each "use locale" or "no locale"
+affects statements to the end of the enclosing BLOCK.
+
+See L<perllocale> for more detailed information on how Perl supports
+locales.
+
+=cut
+
+$locale::hint_bits = 0x800;
+
+sub import {
+    $^H |= $locale::hint_bits;
+}
+
+sub unimport {
+    $^H &= ~$locale::hint_bits;
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/open.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/open.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/open.pm	(revision 14265)
@@ -0,0 +1,76 @@
+package open;
+$open::hint_bits = 0x20000;
+
+sub import {
+    shift;
+    die "`use open' needs explicit list of disciplines" unless @_;
+    $^H |= $open::hint_bits;
+    while (@_) {
+	my $type = shift;
+	if ($type =~ /^(IN|OUT)\z/s) {
+	    my $discp = shift;
+	    unless ($discp =~ /^\s*:(raw|crlf)\s*\z/s) {
+		die "Unknown discipline '$discp'";
+	    }
+	    $^H{"open_$type"} = $discp;
+	}
+	else {
+	    die "Unknown discipline class '$type'";
+	}
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+open - perl pragma to set default disciplines for input and output
+
+=head1 SYNOPSIS
+
+    use open IN => ":crlf", OUT => ":raw";
+
+=head1 DESCRIPTION
+
+The open pragma is used to declare one or more default disciplines for
+I/O operations.  Any open() and readpipe() (aka qx//) operators found
+within the lexical scope of this pragma will use the declared defaults.
+Neither open() with an explicit set of disciplines, nor sysopen() are
+influenced by this pragma.
+
+Only the two pseudo-disciplines ":raw" and ":crlf" are currently
+available.
+
+The ":raw" discipline corresponds to "binary mode" and the ":crlf"
+discipline corresponds to "text mode" on platforms that distinguish
+between the two modes when opening files (which is many DOS-like
+platforms, including Windows).  These two disciplines are currently
+no-ops on platforms where binmode() is a no-op, but will be
+supported everywhere in future.
+
+=head1 UNIMPLEMENTED FUNCTIONALITY
+
+Full-fledged support for I/O disciplines is currently unimplemented.
+When they are eventually supported, this pragma will serve as one of
+the interfaces to declare default disciplines for all I/O.
+
+In future, any default disciplines declared by this pragma will be
+available by the special discipline name ":DEFAULT", and could be used
+within handle constructors that allow disciplines to be specified.
+This would make it possible to stack new disciplines over the default
+ones.
+
+    open FH, "<:para :DEFAULT", $file or die "can't open $file: $!";
+
+Socket and directory handles will also support disciplines in
+future.
+
+Full support for I/O disciplines will enable all of the supported
+disciplines to work on all platforms.
+
+=head1 SEE ALSO
+
+L<perlfunc/"binmode">, L<perlfunc/"open">, L<perlunicode>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/ops.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/ops.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/ops.pm	(revision 14265)
@@ -0,0 +1,45 @@
+package ops;
+
+use Opcode qw(opmask_add opset invert_opset);
+
+sub import {
+    shift;
+    # Not that unimport is the prefered form since import's don't
+	# accumulate well owing to the 'only ever add opmask' rule.
+	# E.g., perl -Mops=:set1 -Mops=:setb is unlikely to do as expected.
+    opmask_add(invert_opset opset(@_)) if @_;
+}
+
+sub unimport {
+    shift;
+    opmask_add(opset(@_)) if @_;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ops - Perl pragma to restrict unsafe operations when compiling
+
+=head1 SYNOPSIS  
+
+  perl -Mops=:default ...    # only allow reasonably safe operations
+
+  perl -M-ops=system ...     # disable the 'system' opcode
+
+=head1 DESCRIPTION
+
+Since the ops pragma currently has an irreversible global effect, it is
+only of significant practical use with the C<-M> option on the command line.
+
+See the L<Opcode> module for information about opcodes, optags, opmasks
+and important information about safety.
+
+=head1 SEE ALSO
+
+Opcode(3), Safe(3), perlrun(3)
+
+=cut
+
Index: /for-distributions/trunk/bin/windows/perl/lib/overload.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/overload.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/overload.pm	(revision 14265)
@@ -0,0 +1,1422 @@
+package overload;
+
+$overload::hint_bits = 0x20000;
+
+sub nil {}
+
+sub OVERLOAD {
+  $package = shift;
+  my %arg = @_;
+  my ($sub, $fb);
+  $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
+  *{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
+  for (keys %arg) {
+    if ($_ eq 'fallback') {
+      $fb = $arg{$_};
+    } else {
+      $sub = $arg{$_};
+      if (not ref $sub and $sub !~ /::/) {
+	$ {$package . "::(" . $_} = $sub;
+	$sub = \&nil;
+      }
+      #print STDERR "Setting `$ {'package'}::\cO$_' to \\&`$sub'.\n";
+      *{$package . "::(" . $_} = \&{ $sub };
+    }
+  }
+  ${$package . "::()"} = $fb; # Make it findable too (fallback only).
+}
+
+sub import {
+  $package = (caller())[0];
+  # *{$package . "::OVERLOAD"} = \&OVERLOAD;
+  shift;
+  $package->overload::OVERLOAD(@_);
+}
+
+sub unimport {
+  $package = (caller())[0];
+  ${$package . "::OVERLOAD"}{dummy}++; # Upgrade the table
+  shift;
+  for (@_) {
+    if ($_ eq 'fallback') {
+      undef $ {$package . "::()"};
+    } else {
+      delete $ {$package . "::"}{"(" . $_};
+    }
+  }
+}
+
+sub Overloaded {
+  my $package = shift;
+  $package = ref $package if ref $package;
+  $package->can('()');
+}
+
+sub ov_method {
+  my $globref = shift;
+  return undef unless $globref;
+  my $sub = \&{*$globref};
+  return $sub if $sub ne \&nil;
+  return shift->can($ {*$globref});
+}
+
+sub OverloadedStringify {
+  my $package = shift;
+  $package = ref $package if ref $package;
+  #$package->can('(""')
+  ov_method mycan($package, '(""'), $package
+    or ov_method mycan($package, '(0+'), $package
+    or ov_method mycan($package, '(bool'), $package
+    or ov_method mycan($package, '(nomethod'), $package;
+}
+
+sub Method {
+  my $package = shift;
+  $package = ref $package if ref $package;
+  #my $meth = $package->can('(' . shift);
+  ov_method mycan($package, '(' . shift), $package;
+  #return $meth if $meth ne \&nil;
+  #return $ {*{$meth}};
+}
+
+sub AddrRef {
+  my $package = ref $_[0];
+  return "$_[0]" unless $package;
+  bless $_[0], overload::Fake;	# Non-overloaded package
+  my $str = "$_[0]";
+  bless $_[0], $package;	# Back
+  $package . substr $str, index $str, '=';
+}
+
+sub StrVal {
+  (OverloadedStringify($_[0]) or ref($_[0]) eq 'Regexp') ?
+    (AddrRef(shift)) :
+    "$_[0]";
+}
+
+sub mycan {				# Real can would leave stubs.
+  my ($package, $meth) = @_;
+  return \*{$package . "::$meth"} if defined &{$package . "::$meth"};
+  my $p;
+  foreach $p (@{$package . "::ISA"}) {
+    my $out = mycan($p, $meth);
+    return $out if $out;
+  }
+  return undef;
+}
+
+%constants = (
+	      'integer'	  =>  0x1000,
+	      'float'	  =>  0x2000,
+	      'binary'	  =>  0x4000,
+	      'q'	  =>  0x8000,
+	      'qr'	  => 0x10000,
+	     );
+
+%ops = ( with_assign	  => "+ - * / % ** << >> x .",
+	 assign		  => "+= -= *= /= %= **= <<= >>= x= .=",
+	 num_comparison	  => "< <= >  >= == !=",
+	 '3way_comparison'=> "<=> cmp",
+	 str_comparison	  => "lt le gt ge eq ne",
+	 binary		  => "& | ^",
+	 unary		  => "neg ! ~",
+	 mutators	  => '++ --',
+	 func		  => "atan2 cos sin exp abs log sqrt",
+	 conversion	  => 'bool "" 0+',
+	 iterators	  => '<>',
+	 dereferencing	  => '${} @{} %{} &{} *{}',
+	 special	  => 'nomethod fallback =');
+
+use warnings::register;
+sub constant {
+  # Arguments: what, sub
+  while (@_) {
+    if (@_ == 1) {
+        warnings::warnif ("Odd number of arguments for overload::constant");
+        last;
+    }
+    elsif (!exists $constants {$_ [0]}) {
+        warnings::warnif ("`$_[0]' is not an overloadable type");
+    }
+    elsif (!ref $_ [1] || "$_[1]" !~ /CODE\(0x[\da-f]+\)$/) {
+        # Can't use C<ref $_[1] eq "CODE"> above as code references can be
+        # blessed, and C<ref> would return the package the ref is blessed into.
+        if (warnings::enabled) {
+            $_ [1] = "undef" unless defined $_ [1];
+            warnings::warn ("`$_[1]' is not a code reference");
+        }
+    }
+    else {
+        $^H{$_[0]} = $_[1];
+        $^H |= $constants{$_[0]} | $overload::hint_bits;
+    }
+    shift, shift;
+  }
+}
+
+sub remove_constant {
+  # Arguments: what, sub
+  while (@_) {
+    delete $^H{$_[0]};
+    $^H &= ~ $constants{$_[0]};
+    shift, shift;
+  }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+overload - Package for overloading perl operations
+
+=head1 SYNOPSIS
+
+    package SomeThing;
+
+    use overload
+	'+' => \&myadd,
+	'-' => \&mysub;
+	# etc
+    ...
+
+    package main;
+    $a = new SomeThing 57;
+    $b=5+$a;
+    ...
+    if (overload::Overloaded $b) {...}
+    ...
+    $strval = overload::StrVal $b;
+
+=head1 DESCRIPTION
+
+=head2 Declaration of overloaded functions
+
+The compilation directive
+
+    package Number;
+    use overload
+	"+" => \&add,
+	"*=" => "muas";
+
+declares function Number::add() for addition, and method muas() in
+the "class" C<Number> (or one of its base classes)
+for the assignment form C<*=> of multiplication.
+
+Arguments of this directive come in (key, value) pairs.  Legal values
+are values legal inside a C<&{ ... }> call, so the name of a
+subroutine, a reference to a subroutine, or an anonymous subroutine
+will all work.  Note that values specified as strings are
+interpreted as methods, not subroutines.  Legal keys are listed below.
+
+The subroutine C<add> will be called to execute C<$a+$b> if $a
+is a reference to an object blessed into the package C<Number>, or if $a is
+not an object from a package with defined mathemagic addition, but $b is a
+reference to a C<Number>.  It can also be called in other situations, like
+C<$a+=7>, or C<$a++>.  See L<MAGIC AUTOGENERATION>.  (Mathemagical
+methods refer to methods triggered by an overloaded mathematical
+operator.)
+
+Since overloading respects inheritance via the @ISA hierarchy, the
+above declaration would also trigger overloading of C<+> and C<*=> in
+all the packages which inherit from C<Number>.
+
+=head2 Calling Conventions for Binary Operations
+
+The functions specified in the C<use overload ...> directive are called
+with three (in one particular case with four, see L<Last Resort>)
+arguments.  If the corresponding operation is binary, then the first
+two arguments are the two arguments of the operation.  However, due to
+general object calling conventions, the first argument should always be
+an object in the package, so in the situation of C<7+$a>, the
+order of the arguments is interchanged.  It probably does not matter
+when implementing the addition method, but whether the arguments
+are reversed is vital to the subtraction method.  The method can
+query this information by examining the third argument, which can take
+three different values:
+
+=over 7
+
+=item FALSE
+
+the order of arguments is as in the current operation.
+
+=item TRUE
+
+the arguments are reversed.
+
+=item C<undef>
+
+the current operation is an assignment variant (as in
+C<$a+=7>), but the usual function is called instead.  This additional
+information can be used to generate some optimizations.  Compare
+L<Calling Conventions for Mutators>.
+
+=back
+
+=head2 Calling Conventions for Unary Operations
+
+Unary operation are considered binary operations with the second
+argument being C<undef>.  Thus the functions that overloads C<{"++"}>
+is called with arguments C<($a,undef,'')> when $a++ is executed.
+
+=head2 Calling Conventions for Mutators
+
+Two types of mutators have different calling conventions:
+
+=over
+
+=item C<++> and C<-->
+
+The routines which implement these operators are expected to actually
+I<mutate> their arguments.  So, assuming that $obj is a reference to a
+number,
+
+  sub incr { my $n = $ {$_[0]}; ++$n; $_[0] = bless \$n}
+
+is an appropriate implementation of overloaded C<++>.  Note that
+
+  sub incr { ++$ {$_[0]} ; shift }
+
+is OK if used with preincrement and with postincrement. (In the case
+of postincrement a copying will be performed, see L<Copy Constructor>.)
+
+=item C<x=> and other assignment versions
+
+There is nothing special about these methods.  They may change the
+value of their arguments, and may leave it as is.  The result is going
+to be assigned to the value in the left-hand-side if different from
+this value.
+
+This allows for the same method to be used as overloaded C<+=> and
+C<+>.  Note that this is I<allowed>, but not recommended, since by the
+semantic of L<"Fallback"> Perl will call the method for C<+> anyway,
+if C<+=> is not overloaded.
+
+=back
+
+B<Warning.>  Due to the presense of assignment versions of operations,
+routines which may be called in assignment context may create
+self-referential structures.  Currently Perl will not free self-referential
+structures until cycles are C<explicitly> broken.  You may get problems
+when traversing your structures too.
+
+Say,
+
+  use overload '+' => sub { bless [ \$_[0], \$_[1] ] };
+
+is asking for trouble, since for code C<$obj += $foo> the subroutine
+is called as C<$obj = add($obj, $foo, undef)>, or C<$obj = [\$obj,
+\$foo]>.  If using such a subroutine is an important optimization, one
+can overload C<+=> explicitly by a non-"optimized" version, or switch
+to non-optimized version if C<not defined $_[2]> (see
+L<Calling Conventions for Binary Operations>).
+
+Even if no I<explicit> assignment-variants of operators are present in
+the script, they may be generated by the optimizer.  Say, C<",$obj,"> or
+C<',' . $obj . ','> may be both optimized to
+
+  my $tmp = ',' . $obj;    $tmp .= ',';
+
+=head2 Overloadable Operations
+
+The following symbols can be specified in C<use overload> directive:
+
+=over 5
+
+=item * I<Arithmetic operations>
+
+    "+", "+=", "-", "-=", "*", "*=", "/", "/=", "%", "%=",
+    "**", "**=", "<<", "<<=", ">>", ">>=", "x", "x=", ".", ".=",
+
+For these operations a substituted non-assignment variant can be called if
+the assignment variant is not available.  Methods for operations "C<+>",
+"C<->", "C<+=>", and "C<-=>" can be called to automatically generate
+increment and decrement methods.  The operation "C<->" can be used to
+autogenerate missing methods for unary minus or C<abs>.
+
+See L<"MAGIC AUTOGENERATION">, L<"Calling Conventions for Mutators"> and
+L<"Calling Conventions for Binary Operations">) for details of these
+substitutions.
+
+=item * I<Comparison operations>
+
+    "<",  "<=", ">",  ">=", "==", "!=", "<=>",
+    "lt", "le", "gt", "ge", "eq", "ne", "cmp",
+
+If the corresponding "spaceship" variant is available, it can be
+used to substitute for the missing operation.  During C<sort>ing
+arrays, C<cmp> is used to compare values subject to C<use overload>.
+
+=item * I<Bit operations>
+
+    "&", "^", "|", "neg", "!", "~",
+
+"C<neg>" stands for unary minus.  If the method for C<neg> is not
+specified, it can be autogenerated using the method for
+subtraction. If the method for "C<!>" is not specified, it can be
+autogenerated using the methods for "C<bool>", or "C<\"\">", or "C<0+>".
+
+=item * I<Increment and decrement>
+
+    "++", "--",
+
+If undefined, addition and subtraction methods can be
+used instead.  These operations are called both in prefix and
+postfix form.
+
+=item * I<Transcendental functions>
+
+    "atan2", "cos", "sin", "exp", "abs", "log", "sqrt",
+
+If C<abs> is unavailable, it can be autogenerated using methods
+for "E<lt>" or "E<lt>=E<gt>" combined with either unary minus or subtraction.
+
+=item * I<Boolean, string and numeric conversion>
+
+    "bool", "\"\"", "0+",
+
+If one or two of these operations are not overloaded, the remaining ones can
+be used instead.  C<bool> is used in the flow control operators
+(like C<while>) and for the ternary "C<?:>" operation.  These functions can
+return any arbitrary Perl value.  If the corresponding operation for this value
+is overloaded too, that operation will be called again with this value.
+
+As a special case if the overload returns the object itself then it will
+be used directly. An overloaded conversion returning the object is
+probably a bug, because you're likely to get something that looks like
+C<YourPackage=HASH(0x8172b34)>.
+
+=item * I<Iteration>
+
+    "<>"
+
+If not overloaded, the argument will be converted to a filehandle or
+glob (which may require a stringification).  The same overloading
+happens both for the I<read-filehandle> syntax C<E<lt>$varE<gt>> and
+I<globbing> syntax C<E<lt>${var}E<gt>>.
+
+=item * I<Dereferencing>
+
+    '${}', '@{}', '%{}', '&{}', '*{}'.
+
+If not overloaded, the argument will be dereferenced I<as is>, thus
+should be of correct type.  These functions should return a reference
+of correct type, or another object with overloaded dereferencing.
+
+As a special case if the overload returns the object itself then it
+will be used directly (provided it is the correct type).
+
+The dereference operators must be specified explicitly they will not be passed to
+"nomethod".
+
+=item * I<Special>
+
+    "nomethod", "fallback", "=",
+
+see L<SPECIAL SYMBOLS FOR C<use overload>>.
+
+=back
+
+See L<"Fallback"> for an explanation of when a missing method can be
+autogenerated.
+
+A computer-readable form of the above table is available in the hash
+%overload::ops, with values being space-separated lists of names:
+
+ with_assign	  => '+ - * / % ** << >> x .',
+ assign		  => '+= -= *= /= %= **= <<= >>= x= .=',
+ num_comparison	  => '< <= > >= == !=',
+ '3way_comparison'=> '<=> cmp',
+ str_comparison	  => 'lt le gt ge eq ne',
+ binary		  => '& | ^',
+ unary		  => 'neg ! ~',
+ mutators	  => '++ --',
+ func		  => 'atan2 cos sin exp abs log sqrt',
+ conversion	  => 'bool "" 0+',
+ iterators	  => '<>',
+ dereferencing	  => '${} @{} %{} &{} *{}',
+ special	  => 'nomethod fallback ='
+
+=head2 Inheritance and overloading
+
+Inheritance interacts with overloading in two ways.
+
+=over
+
+=item Strings as values of C<use overload> directive
+
+If C<value> in
+
+  use overload key => value;
+
+is a string, it is interpreted as a method name.
+
+=item Overloading of an operation is inherited by derived classes
+
+Any class derived from an overloaded class is also overloaded.  The
+set of overloaded methods is the union of overloaded methods of all
+the ancestors. If some method is overloaded in several ancestor, then
+which description will be used is decided by the usual inheritance
+rules:
+
+If C<A> inherits from C<B> and C<C> (in this order), C<B> overloads
+C<+> with C<\&D::plus_sub>, and C<C> overloads C<+> by C<"plus_meth">,
+then the subroutine C<D::plus_sub> will be called to implement
+operation C<+> for an object in package C<A>.
+
+=back
+
+Note that since the value of the C<fallback> key is not a subroutine,
+its inheritance is not governed by the above rules.  In the current
+implementation, the value of C<fallback> in the first overloaded
+ancestor is used, but this is accidental and subject to change.
+
+=head1 SPECIAL SYMBOLS FOR C<use overload>
+
+Three keys are recognized by Perl that are not covered by the above
+description.
+
+=head2 Last Resort
+
+C<"nomethod"> should be followed by a reference to a function of four
+parameters.  If defined, it is called when the overloading mechanism
+cannot find a method for some operation.  The first three arguments of
+this function coincide with the arguments for the corresponding method if
+it were found, the fourth argument is the symbol
+corresponding to the missing method.  If several methods are tried,
+the last one is used.  Say, C<1-$a> can be equivalent to
+
+	&nomethodMethod($a,1,1,"-")
+
+if the pair C<"nomethod" =E<gt> "nomethodMethod"> was specified in the
+C<use overload> directive.
+
+The C<"nomethod"> mechanism is I<not> used for the dereference operators
+( ${} @{} %{} &{} *{} ).
+
+
+If some operation cannot be resolved, and there is no function
+assigned to C<"nomethod">, then an exception will be raised via die()--
+unless C<"fallback"> was specified as a key in C<use overload> directive.
+
+
+=head2 Fallback
+
+The key C<"fallback"> governs what to do if a method for a particular
+operation is not found.  Three different cases are possible depending on
+the value of C<"fallback">:
+
+=over 16
+
+=item * C<undef>
+
+Perl tries to use a
+substituted method (see L<MAGIC AUTOGENERATION>).  If this fails, it
+then tries to calls C<"nomethod"> value; if missing, an exception
+will be raised.
+
+=item * TRUE
+
+The same as for the C<undef> value, but no exception is raised.  Instead,
+it silently reverts to what it would have done were there no C<use overload>
+present.
+
+=item * defined, but FALSE
+
+No autogeneration is tried.  Perl tries to call
+C<"nomethod"> value, and if this is missing, raises an exception.
+
+=back
+
+B<Note.> C<"fallback"> inheritance via @ISA is not carved in stone
+yet, see L<"Inheritance and overloading">.
+
+=head2 Copy Constructor
+
+The value for C<"="> is a reference to a function with three
+arguments, i.e., it looks like the other values in C<use
+overload>. However, it does not overload the Perl assignment
+operator. This would go against Camel hair.
+
+This operation is called in the situations when a mutator is applied
+to a reference that shares its object with some other reference, such
+as
+
+	$a=$b;
+	++$a;
+
+To make this change $a and not change $b, a copy of C<$$a> is made,
+and $a is assigned a reference to this new object.  This operation is
+done during execution of the C<++$a>, and not during the assignment,
+(so before the increment C<$$a> coincides with C<$$b>).  This is only
+done if C<++> is expressed via a method for C<'++'> or C<'+='> (or
+C<nomethod>).  Note that if this operation is expressed via C<'+'>
+a nonmutator, i.e., as in
+
+	$a=$b;
+	$a=$a+1;
+
+then C<$a> does not reference a new copy of C<$$a>, since $$a does not
+appear as lvalue when the above code is executed.
+
+If the copy constructor is required during the execution of some mutator,
+but a method for C<'='> was not specified, it can be autogenerated as a
+string copy if the object is a plain scalar.
+
+=over 5
+
+=item B<Example>
+
+The actually executed code for
+
+	$a=$b;
+        Something else which does not modify $a or $b....
+	++$a;
+
+may be
+
+	$a=$b;
+        Something else which does not modify $a or $b....
+	$a = $a->clone(undef,"");
+        $a->incr(undef,"");
+
+if $b was mathemagical, and C<'++'> was overloaded with C<\&incr>,
+C<'='> was overloaded with C<\&clone>.
+
+=back
+
+Same behaviour is triggered by C<$b = $a++>, which is consider a synonym for
+C<$b = $a; ++$a>.
+
+=head1 MAGIC AUTOGENERATION
+
+If a method for an operation is not found, and the value for  C<"fallback"> is
+TRUE or undefined, Perl tries to autogenerate a substitute method for
+the missing operation based on the defined operations.  Autogenerated method
+substitutions are possible for the following operations:
+
+=over 16
+
+=item I<Assignment forms of arithmetic operations>
+
+C<$a+=$b> can use the method for C<"+"> if the method for C<"+=">
+is not defined.
+
+=item I<Conversion operations>
+
+String, numeric, and boolean conversion are calculated in terms of one
+another if not all of them are defined.
+
+=item I<Increment and decrement>
+
+The C<++$a> operation can be expressed in terms of C<$a+=1> or C<$a+1>,
+and C<$a--> in terms of C<$a-=1> and C<$a-1>.
+
+=item C<abs($a)>
+
+can be expressed in terms of C<$aE<lt>0> and C<-$a> (or C<0-$a>).
+
+=item I<Unary minus>
+
+can be expressed in terms of subtraction.
+
+=item I<Negation>
+
+C<!> and C<not> can be expressed in terms of boolean conversion, or
+string or numerical conversion.
+
+=item I<Concatenation>
+
+can be expressed in terms of string conversion.
+
+=item I<Comparison operations>
+
+can be expressed in terms of its "spaceship" counterpart: either
+C<E<lt>=E<gt>> or C<cmp>:
+
+    <, >, <=, >=, ==, != 	in terms of <=>
+    lt, gt, le, ge, eq, ne 	in terms of cmp
+
+=item I<Iterator>
+
+    <>				in terms of builtin operations
+
+=item I<Dereferencing>
+
+    ${} @{} %{} &{} *{}		in terms of builtin operations
+
+=item I<Copy operator>
+
+can be expressed in terms of an assignment to the dereferenced value, if this
+value is a scalar and not a reference.
+
+=back
+
+=head1 Losing overloading
+
+The restriction for the comparison operation is that even if, for example,
+`C<cmp>' should return a blessed reference, the autogenerated `C<lt>'
+function will produce only a standard logical value based on the
+numerical value of the result of `C<cmp>'.  In particular, a working
+numeric conversion is needed in this case (possibly expressed in terms of
+other conversions).
+
+Similarly, C<.=>  and C<x=> operators lose their mathemagical properties
+if the string conversion substitution is applied.
+
+When you chop() a mathemagical object it is promoted to a string and its
+mathemagical properties are lost.  The same can happen with other
+operations as well.
+
+=head1 Run-time Overloading
+
+Since all C<use> directives are executed at compile-time, the only way to
+change overloading during run-time is to
+
+    eval 'use overload "+" => \&addmethod';
+
+You can also use
+
+    eval 'no overload "+", "--", "<="';
+
+though the use of these constructs during run-time is questionable.
+
+=head1 Public functions
+
+Package C<overload.pm> provides the following public functions:
+
+=over 5
+
+=item overload::StrVal(arg)
+
+Gives string value of C<arg> as in absence of stringify overloading.
+
+=item overload::Overloaded(arg)
+
+Returns true if C<arg> is subject to overloading of some operations.
+
+=item overload::Method(obj,op)
+
+Returns C<undef> or a reference to the method that implements C<op>.
+
+=back
+
+=head1 Overloading constants
+
+For some application Perl parser mangles constants too much.  It is possible
+to hook into this process via overload::constant() and overload::remove_constant()
+functions.
+
+These functions take a hash as an argument.  The recognized keys of this hash
+are
+
+=over 8
+
+=item integer
+
+to overload integer constants,
+
+=item float
+
+to overload floating point constants,
+
+=item binary
+
+to overload octal and hexadecimal constants,
+
+=item q
+
+to overload C<q>-quoted strings, constant pieces of C<qq>- and C<qx>-quoted
+strings and here-documents,
+
+=item qr
+
+to overload constant pieces of regular expressions.
+
+=back
+
+The corresponding values are references to functions which take three arguments:
+the first one is the I<initial> string form of the constant, the second one
+is how Perl interprets this constant, the third one is how the constant is used.
+Note that the initial string form does not
+contain string delimiters, and has backslashes in backslash-delimiter
+combinations stripped (thus the value of delimiter is not relevant for
+processing of this string).  The return value of this function is how this
+constant is going to be interpreted by Perl.  The third argument is undefined
+unless for overloaded C<q>- and C<qr>- constants, it is C<q> in single-quote
+context (comes from strings, regular expressions, and single-quote HERE
+documents), it is C<tr> for arguments of C<tr>/C<y> operators,
+it is C<s> for right-hand side of C<s>-operator, and it is C<qq> otherwise.
+
+Since an expression C<"ab$cd,,"> is just a shortcut for C<'ab' . $cd . ',,'>,
+it is expected that overloaded constant strings are equipped with reasonable
+overloaded catenation operator, otherwise absurd results will result.
+Similarly, negative numbers are considered as negations of positive constants.
+
+Note that it is probably meaningless to call the functions overload::constant()
+and overload::remove_constant() from anywhere but import() and unimport() methods.
+From these methods they may be called as
+
+	sub import {
+	  shift;
+	  return unless @_;
+	  die "unknown import: @_" unless @_ == 1 and $_[0] eq ':constant';
+	  overload::constant integer => sub {Math::BigInt->new(shift)};
+	}
+
+B<BUGS> Currently overloaded-ness of constants does not propagate
+into C<eval '...'>.
+
+=head1 IMPLEMENTATION
+
+What follows is subject to change RSN.
+
+The table of methods for all operations is cached in magic for the
+symbol table hash for the package.  The cache is invalidated during
+processing of C<use overload>, C<no overload>, new function
+definitions, and changes in @ISA. However, this invalidation remains
+unprocessed until the next C<bless>ing into the package. Hence if you
+want to change overloading structure dynamically, you'll need an
+additional (fake) C<bless>ing to update the table.
+
+(Every SVish thing has a magic queue, and magic is an entry in that
+queue.  This is how a single variable may participate in multiple
+forms of magic simultaneously.  For instance, environment variables
+regularly have two forms at once: their %ENV magic and their taint
+magic. However, the magic which implements overloading is applied to
+the stashes, which are rarely used directly, thus should not slow down
+Perl.)
+
+If an object belongs to a package using overload, it carries a special
+flag.  Thus the only speed penalty during arithmetic operations without
+overloading is the checking of this flag.
+
+In fact, if C<use overload> is not present, there is almost no overhead
+for overloadable operations, so most programs should not suffer
+measurable performance penalties.  A considerable effort was made to
+minimize the overhead when overload is used in some package, but the
+arguments in question do not belong to packages using overload.  When
+in doubt, test your speed with C<use overload> and without it.  So far
+there have been no reports of substantial speed degradation if Perl is
+compiled with optimization turned on.
+
+There is no size penalty for data if overload is not used. The only
+size penalty if overload is used in some package is that I<all> the
+packages acquire a magic during the next C<bless>ing into the
+package. This magic is three-words-long for packages without
+overloading, and carries the cache table if the package is overloaded.
+
+Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is
+carried out before any operation that can imply an assignment to the
+object $a (or $b) refers to, like C<$a++>.  You can override this
+behavior by defining your own copy constructor (see L<"Copy Constructor">).
+
+It is expected that arguments to methods that are not explicitly supposed
+to be changed are constant (but this is not enforced).
+
+=head1 Metaphor clash
+
+One may wonder why the semantic of overloaded C<=> is so counter intuitive.
+If it I<looks> counter intuitive to you, you are subject to a metaphor
+clash.
+
+Here is a Perl object metaphor:
+
+I<  object is a reference to blessed data>
+
+and an arithmetic metaphor:
+
+I<  object is a thing by itself>.
+
+The I<main> problem of overloading C<=> is the fact that these metaphors
+imply different actions on the assignment C<$a = $b> if $a and $b are
+objects.  Perl-think implies that $a becomes a reference to whatever
+$b was referencing.  Arithmetic-think implies that the value of "object"
+$a is changed to become the value of the object $b, preserving the fact
+that $a and $b are separate entities.
+
+The difference is not relevant in the absence of mutators.  After
+a Perl-way assignment an operation which mutates the data referenced by $a
+would change the data referenced by $b too.  Effectively, after
+C<$a = $b> values of $a and $b become I<indistinguishable>.
+
+On the other hand, anyone who has used algebraic notation knows the
+expressive power of the arithmetic metaphor.  Overloading works hard
+to enable this metaphor while preserving the Perlian way as far as
+possible.  Since it is not not possible to freely mix two contradicting
+metaphors, overloading allows the arithmetic way to write things I<as
+far as all the mutators are called via overloaded access only>.  The
+way it is done is described in L<Copy Constructor>.
+
+If some mutator methods are directly applied to the overloaded values,
+one may need to I<explicitly unlink> other values which references the
+same value:
+
+    $a = new Data 23;
+    ...
+    $b = $a;		# $b is "linked" to $a
+    ...
+    $a = $a->clone;	# Unlink $b from $a
+    $a->increment_by(4);
+
+Note that overloaded access makes this transparent:
+
+    $a = new Data 23;
+    $b = $a;		# $b is "linked" to $a
+    $a += 4;		# would unlink $b automagically
+
+However, it would not make
+
+    $a = new Data 23;
+    $a = 4;		# Now $a is a plain 4, not 'Data'
+
+preserve "objectness" of $a.  But Perl I<has> a way to make assignments
+to an object do whatever you want.  It is just not the overload, but
+tie()ing interface (see L<perlfunc/tie>).  Adding a FETCH() method
+which returns the object itself, and STORE() method which changes the
+value of the object, one can reproduce the arithmetic metaphor in its
+completeness, at least for variables which were tie()d from the start.
+
+(Note that a workaround for a bug may be needed, see L<"BUGS">.)
+
+=head1 Cookbook
+
+Please add examples to what follows!
+
+=head2 Two-face scalars
+
+Put this in F<two_face.pm> in your Perl library directory:
+
+  package two_face;		# Scalars with separate string and
+                                # numeric values.
+  sub new { my $p = shift; bless [@_], $p }
+  use overload '""' => \&str, '0+' => \&num, fallback => 1;
+  sub num {shift->[1]}
+  sub str {shift->[0]}
+
+Use it as follows:
+
+  require two_face;
+  my $seven = new two_face ("vii", 7);
+  printf "seven=$seven, seven=%d, eight=%d\n", $seven, $seven+1;
+  print "seven contains `i'\n" if $seven =~ /i/;
+
+(The second line creates a scalar which has both a string value, and a
+numeric value.)  This prints:
+
+  seven=vii, seven=7, eight=8
+  seven contains `i'
+
+=head2 Two-face references
+
+Suppose you want to create an object which is accessible as both an
+array reference and a hash reference, similar to the
+L<pseudo-hash|perlref/"Pseudo-hashes: Using an array as a hash">
+builtin Perl type.  Let's make it better than a pseudo-hash by
+allowing index 0 to be treated as a normal element.
+
+  package two_refs;
+  use overload '%{}' => \&gethash, '@{}' => sub { $ {shift()} };
+  sub new {
+    my $p = shift;
+    bless \ [@_], $p;
+  }
+  sub gethash {
+    my %h;
+    my $self = shift;
+    tie %h, ref $self, $self;
+    \%h;
+  }
+
+  sub TIEHASH { my $p = shift; bless \ shift, $p }
+  my %fields;
+  my $i = 0;
+  $fields{$_} = $i++ foreach qw{zero one two three};
+  sub STORE {
+    my $self = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $$self->[$key] = shift;
+  }
+  sub FETCH {
+    my $self = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $$self->[$key];
+  }
+
+Now one can access an object using both the array and hash syntax:
+
+  my $bar = new two_refs 3,4,5,6;
+  $bar->[2] = 11;
+  $bar->{two} == 11 or die 'bad hash fetch';
+
+Note several important features of this example.  First of all, the
+I<actual> type of $bar is a scalar reference, and we do not overload
+the scalar dereference.  Thus we can get the I<actual> non-overloaded
+contents of $bar by just using C<$$bar> (what we do in functions which
+overload dereference).  Similarly, the object returned by the
+TIEHASH() method is a scalar reference.
+
+Second, we create a new tied hash each time the hash syntax is used.
+This allows us not to worry about a possibility of a reference loop,
+would would lead to a memory leak.
+
+Both these problems can be cured.  Say, if we want to overload hash
+dereference on a reference to an object which is I<implemented> as a
+hash itself, the only problem one has to circumvent is how to access
+this I<actual> hash (as opposed to the I<virtual> hash exhibited by the
+overloaded dereference operator).  Here is one possible fetching routine:
+
+  sub access_hash {
+    my ($self, $key) = (shift, shift);
+    my $class = ref $self;
+    bless $self, 'overload::dummy'; # Disable overloading of %{}
+    my $out = $self->{$key};
+    bless $self, $class;	# Restore overloading
+    $out;
+  }
+
+To remove creation of the tied hash on each access, one may an extra
+level of indirection which allows a non-circular structure of references:
+
+  package two_refs1;
+  use overload '%{}' => sub { ${shift()}->[1] },
+               '@{}' => sub { ${shift()}->[0] };
+  sub new {
+    my $p = shift;
+    my $a = [@_];
+    my %h;
+    tie %h, $p, $a;
+    bless \ [$a, \%h], $p;
+  }
+  sub gethash {
+    my %h;
+    my $self = shift;
+    tie %h, ref $self, $self;
+    \%h;
+  }
+
+  sub TIEHASH { my $p = shift; bless \ shift, $p }
+  my %fields;
+  my $i = 0;
+  $fields{$_} = $i++ foreach qw{zero one two three};
+  sub STORE {
+    my $a = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $a->[$key] = shift;
+  }
+  sub FETCH {
+    my $a = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $a->[$key];
+  }
+
+Now if $baz is overloaded like this, then C<$baz> is a reference to a
+reference to the intermediate array, which keeps a reference to an
+actual array, and the access hash.  The tie()ing object for the access
+hash is a reference to a reference to the actual array, so
+
+=over
+
+=item *
+
+There are no loops of references.
+
+=item *
+
+Both "objects" which are blessed into the class C<two_refs1> are
+references to a reference to an array, thus references to a I<scalar>.
+Thus the accessor expression C<$$foo-E<gt>[$ind]> involves no
+overloaded operations.
+
+=back
+
+=head2 Symbolic calculator
+
+Put this in F<symbolic.pm> in your Perl library directory:
+
+  package symbolic;		# Primitive symbolic calculator
+  use overload nomethod => \&wrap;
+
+  sub new { shift; bless ['n', @_] }
+  sub wrap {
+    my ($obj, $other, $inv, $meth) = @_;
+    ($obj, $other) = ($other, $obj) if $inv;
+    bless [$meth, $obj, $other];
+  }
+
+This module is very unusual as overloaded modules go: it does not
+provide any usual overloaded operators, instead it provides the L<Last
+Resort> operator C<nomethod>.  In this example the corresponding
+subroutine returns an object which encapsulates operations done over
+the objects: C<new symbolic 3> contains C<['n', 3]>, C<2 + new
+symbolic 3> contains C<['+', 2, ['n', 3]]>.
+
+Here is an example of the script which "calculates" the side of
+circumscribed octagon using the above package:
+
+  require symbolic;
+  my $iter = 1;			# 2**($iter+2) = 8
+  my $side = new symbolic 1;
+  my $cnt = $iter;
+
+  while ($cnt--) {
+    $side = (sqrt(1 + $side**2) - 1)/$side;
+  }
+  print "OK\n";
+
+The value of $side is
+
+  ['/', ['-', ['sqrt', ['+', 1, ['**', ['n', 1], 2]],
+	               undef], 1], ['n', 1]]
+
+Note that while we obtained this value using a nice little script,
+there is no simple way to I<use> this value.  In fact this value may
+be inspected in debugger (see L<perldebug>), but ony if
+C<bareStringify> B<O>ption is set, and not via C<p> command.
+
+If one attempts to print this value, then the overloaded operator
+C<""> will be called, which will call C<nomethod> operator.  The
+result of this operator will be stringified again, but this result is
+again of type C<symbolic>, which will lead to an infinite loop.
+
+Add a pretty-printer method to the module F<symbolic.pm>:
+
+  sub pretty {
+    my ($meth, $a, $b) = @{+shift};
+    $a = 'u' unless defined $a;
+    $b = 'u' unless defined $b;
+    $a = $a->pretty if ref $a;
+    $b = $b->pretty if ref $b;
+    "[$meth $a $b]";
+  }
+
+Now one can finish the script by
+
+  print "side = ", $side->pretty, "\n";
+
+The method C<pretty> is doing object-to-string conversion, so it
+is natural to overload the operator C<""> using this method.  However,
+inside such a method it is not necessary to pretty-print the
+I<components> $a and $b of an object.  In the above subroutine
+C<"[$meth $a $b]"> is a catenation of some strings and components $a
+and $b.  If these components use overloading, the catenation operator
+will look for an overloaded operator C<.>; if not present, it will
+look for an overloaded operator C<"">.  Thus it is enough to use
+
+  use overload nomethod => \&wrap, '""' => \&str;
+  sub str {
+    my ($meth, $a, $b) = @{+shift};
+    $a = 'u' unless defined $a;
+    $b = 'u' unless defined $b;
+    "[$meth $a $b]";
+  }
+
+Now one can change the last line of the script to
+
+  print "side = $side\n";
+
+which outputs
+
+  side = [/ [- [sqrt [+ 1 [** [n 1 u] 2]] u] 1] [n 1 u]]
+
+and one can inspect the value in debugger using all the possible
+methods.
+
+Something is is still amiss: consider the loop variable $cnt of the
+script.  It was a number, not an object.  We cannot make this value of
+type C<symbolic>, since then the loop will not terminate.
+
+Indeed, to terminate the cycle, the $cnt should become false.
+However, the operator C<bool> for checking falsity is overloaded (this
+time via overloaded C<"">), and returns a long string, thus any object
+of type C<symbolic> is true.  To overcome this, we need a way to
+compare an object to 0.  In fact, it is easier to write a numeric
+conversion routine.
+
+Here is the text of F<symbolic.pm> with such a routine added (and
+slightly modified str()):
+
+  package symbolic;		# Primitive symbolic calculator
+  use overload
+    nomethod => \&wrap, '""' => \&str, '0+' => \&num;
+
+  sub new { shift; bless ['n', @_] }
+  sub wrap {
+    my ($obj, $other, $inv, $meth) = @_;
+    ($obj, $other) = ($other, $obj) if $inv;
+    bless [$meth, $obj, $other];
+  }
+  sub str {
+    my ($meth, $a, $b) = @{+shift};
+    $a = 'u' unless defined $a;
+    if (defined $b) {
+      "[$meth $a $b]";
+    } else {
+      "[$meth $a]";
+    }
+  }
+  my %subr = ( n => sub {$_[0]},
+	       sqrt => sub {sqrt $_[0]},
+	       '-' => sub {shift() - shift()},
+	       '+' => sub {shift() + shift()},
+	       '/' => sub {shift() / shift()},
+	       '*' => sub {shift() * shift()},
+	       '**' => sub {shift() ** shift()},
+	     );
+  sub num {
+    my ($meth, $a, $b) = @{+shift};
+    my $subr = $subr{$meth}
+      or die "Do not know how to ($meth) in symbolic";
+    $a = $a->num if ref $a eq __PACKAGE__;
+    $b = $b->num if ref $b eq __PACKAGE__;
+    $subr->($a,$b);
+  }
+
+All the work of numeric conversion is done in %subr and num().  Of
+course, %subr is not complete, it contains only operators used in the
+example below.  Here is the extra-credit question: why do we need an
+explicit recursion in num()?  (Answer is at the end of this section.)
+
+Use this module like this:
+
+  require symbolic;
+  my $iter = new symbolic 2;	# 16-gon
+  my $side = new symbolic 1;
+  my $cnt = $iter;
+
+  while ($cnt) {
+    $cnt = $cnt - 1;		# Mutator `--' not implemented
+    $side = (sqrt(1 + $side**2) - 1)/$side;
+  }
+  printf "%s=%f\n", $side, $side;
+  printf "pi=%f\n", $side*(2**($iter+2));
+
+It prints (without so many line breaks)
+
+  [/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1]
+			  [n 1]] 2]]] 1]
+     [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]=0.198912
+  pi=3.182598
+
+The above module is very primitive.  It does not implement
+mutator methods (C<++>, C<-=> and so on), does not do deep copying
+(not required without mutators!), and implements only those arithmetic
+operations which are used in the example.
+
+To implement most arithmetic operations is easy; one should just use
+the tables of operations, and change the code which fills %subr to
+
+  my %subr = ( 'n' => sub {$_[0]} );
+  foreach my $op (split " ", $overload::ops{with_assign}) {
+    $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
+  }
+  my @bins = qw(binary 3way_comparison num_comparison str_comparison);
+  foreach my $op (split " ", "@overload::ops{ @bins }") {
+    $subr{$op} = eval "sub {shift() $op shift()}";
+  }
+  foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
+    print "defining `$op'\n";
+    $subr{$op} = eval "sub {$op shift()}";
+  }
+
+Due to L<Calling Conventions for Mutators>, we do not need anything
+special to make C<+=> and friends work, except filling C<+=> entry of
+%subr, and defining a copy constructor (needed since Perl has no
+way to know that the implementation of C<'+='> does not mutate
+the argument, compare L<Copy Constructor>).
+
+To implement a copy constructor, add C<< '=' => \&cpy >> to C<use overload>
+line, and code (this code assumes that mutators change things one level
+deep only, so recursive copying is not needed):
+
+  sub cpy {
+    my $self = shift;
+    bless [@$self], ref $self;
+  }
+
+To make C<++> and C<--> work, we need to implement actual mutators,
+either directly, or in C<nomethod>.  We continue to do things inside
+C<nomethod>, thus add
+
+    if ($meth eq '++' or $meth eq '--') {
+      @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
+      return $obj;
+    }
+
+after the first line of wrap().  This is not a most effective
+implementation, one may consider
+
+  sub inc { $_[0] = bless ['++', shift, 1]; }
+
+instead.
+
+As a final remark, note that one can fill %subr by
+
+  my %subr = ( 'n' => sub {$_[0]} );
+  foreach my $op (split " ", $overload::ops{with_assign}) {
+    $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
+  }
+  my @bins = qw(binary 3way_comparison num_comparison str_comparison);
+  foreach my $op (split " ", "@overload::ops{ @bins }") {
+    $subr{$op} = eval "sub {shift() $op shift()}";
+  }
+  foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
+    $subr{$op} = eval "sub {$op shift()}";
+  }
+  $subr{'++'} = $subr{'+'};
+  $subr{'--'} = $subr{'-'};
+
+This finishes implementation of a primitive symbolic calculator in
+50 lines of Perl code.  Since the numeric values of subexpressions
+are not cached, the calculator is very slow.
+
+Here is the answer for the exercise: In the case of str(), we need no
+explicit recursion since the overloaded C<.>-operator will fall back
+to an existing overloaded operator C<"">.  Overloaded arithmetic
+operators I<do not> fall back to numeric conversion if C<fallback> is
+not explicitly requested.  Thus without an explicit recursion num()
+would convert C<['+', $a, $b]> to C<$a + $b>, which would just rebuild
+the argument of num().
+
+If you wonder why defaults for conversion are different for str() and
+num(), note how easy it was to write the symbolic calculator.  This
+simplicity is due to an appropriate choice of defaults.  One extra
+note: due to the explicit recursion num() is more fragile than sym():
+we need to explicitly check for the type of $a and $b.  If components
+$a and $b happen to be of some related type, this may lead to problems.
+
+=head2 I<Really> symbolic calculator
+
+One may wonder why we call the above calculator symbolic.  The reason
+is that the actual calculation of the value of expression is postponed
+until the value is I<used>.
+
+To see it in action, add a method
+
+  sub STORE {
+    my $obj = shift;
+    $#$obj = 1;
+    @$obj->[0,1] = ('=', shift);
+  }
+
+to the package C<symbolic>.  After this change one can do
+
+  my $a = new symbolic 3;
+  my $b = new symbolic 4;
+  my $c = sqrt($a**2 + $b**2);
+
+and the numeric value of $c becomes 5.  However, after calling
+
+  $a->STORE(12);  $b->STORE(5);
+
+the numeric value of $c becomes 13.  There is no doubt now that the module
+symbolic provides a I<symbolic> calculator indeed.
+
+To hide the rough edges under the hood, provide a tie()d interface to the
+package C<symbolic> (compare with L<Metaphor clash>).  Add methods
+
+  sub TIESCALAR { my $pack = shift; $pack->new(@_) }
+  sub FETCH { shift }
+  sub nop {  }		# Around a bug
+
+(the bug is described in L<"BUGS">).  One can use this new interface as
+
+  tie $a, 'symbolic', 3;
+  tie $b, 'symbolic', 4;
+  $a->nop;  $b->nop;	# Around a bug
+
+  my $c = sqrt($a**2 + $b**2);
+
+Now numeric value of $c is 5.  After C<$a = 12; $b = 5> the numeric value
+of $c becomes 13.  To insulate the user of the module add a method
+
+  sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
+
+Now
+
+  my ($a, $b);
+  symbolic->vars($a, $b);
+  my $c = sqrt($a**2 + $b**2);
+
+  $a = 3; $b = 4;
+  printf "c5  %s=%f\n", $c, $c;
+
+  $a = 12; $b = 5;
+  printf "c13  %s=%f\n", $c, $c;
+
+shows that the numeric value of $c follows changes to the values of $a
+and $b.
+
+=head1 AUTHOR
+
+Ilya Zakharevich E<lt>F<ilya@math.mps.ohio-state.edu>E<gt>.
+
+=head1 DIAGNOSTICS
+
+When Perl is run with the B<-Do> switch or its equivalent, overloading
+induces diagnostic messages.
+
+Using the C<m> command of Perl debugger (see L<perldebug>) one can
+deduce which operations are overloaded (and which ancestor triggers
+this overloading). Say, if C<eq> is overloaded, then the method C<(eq>
+is shown by debugger. The method C<()> corresponds to the C<fallback>
+key (in fact a presence of this method shows that this package has
+overloading enabled, and it is what is used by the C<Overloaded>
+function of module C<overload>).
+
+The module might issue the following warnings:
+
+=over 4
+
+=item Odd number of arguments for overload::constant
+
+(W) The call to overload::constant contained an odd number of arguments.
+The arguments should come in pairs.
+
+=item `%s' is not an overloadable type
+
+(W) You tried to overload a constant type the overload package is unaware of.
+
+=item `%s' is not a code reference
+
+(W) The second (fourth, sixth, ...) argument of overload::constant needs
+to be a code reference. Either an anonymous subroutine, or a reference
+to a subroutine.
+
+=back
+
+=head1 BUGS
+
+Because it is used for overloading, the per-package hash %OVERLOAD now
+has a special meaning in Perl. The symbol table is filled with names
+looking like line-noise.
+
+For the purpose of inheritance every overloaded package behaves as if
+C<fallback> is present (possibly undefined). This may create
+interesting effects if some package is not overloaded, but inherits
+from two overloaded packages.
+
+Relation between overloading and tie()ing is broken.  Overloading is
+triggered or not basing on the I<previous> class of tie()d value.
+
+This happens because the presence of overloading is checked too early,
+before any tie()d access is attempted.  If the FETCH()ed class of the
+tie()d value does not change, a simple workaround is to access the value
+immediately after tie()ing, so that after this call the I<previous> class
+coincides with the current one.
+
+B<Needed:> a way to fix this without a speed penalty.
+
+Barewords are not covered by overloaded string constants.
+
+This document is confusing.  There are grammos and misleading language
+used in places.  It would seem a total rewrite is needed.
+
+=cut
+
Index: /for-distributions/trunk/bin/windows/perl/lib/sigtrap.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/sigtrap.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/sigtrap.pm	(revision 14265)
@@ -0,0 +1,289 @@
+package sigtrap;
+
+=head1 NAME
+
+sigtrap - Perl pragma to enable simple signal handling
+
+=cut
+
+use Carp;
+
+$VERSION = 1.02;
+$Verbose ||= 0;
+
+sub import {
+    my $pkg = shift;
+    my $handler = \&handler_traceback;
+    my $saw_sig = 0;
+    my $untrapped = 0;
+    local $_;
+
+  Arg_loop:
+    while (@_) {
+	$_ = shift;
+	if (/^[A-Z][A-Z0-9]*$/) {
+	    $saw_sig++;
+	    unless ($untrapped and $SIG{$_} and $SIG{$_} ne 'DEFAULT') {
+		print "Installing handler $handler for $_\n" if $Verbose;
+		$SIG{$_} = $handler;
+	    }
+	}
+	elsif ($_ eq 'normal-signals') {
+	    unshift @_, grep(exists $SIG{$_}, qw(HUP INT PIPE TERM));
+	}
+	elsif ($_ eq 'error-signals') {
+	    unshift @_, grep(exists $SIG{$_},
+			     qw(ABRT BUS EMT FPE ILL QUIT SEGV SYS TRAP));
+	}
+	elsif ($_ eq 'old-interface-signals') {
+	    unshift @_,
+	    grep(exists $SIG{$_},
+		 qw(ABRT BUS EMT FPE ILL PIPE QUIT SEGV SYS TERM TRAP));
+	}
+    	elsif ($_ eq 'stack-trace') {
+	    $handler = \&handler_traceback;
+	}
+	elsif ($_ eq 'die') {
+	    $handler = \&handler_die;
+	}
+	elsif ($_ eq 'handler') {
+	    @_ or croak "No argument specified after 'handler'";
+	    $handler = shift;
+	    unless (ref $handler or $handler eq 'IGNORE'
+			or $handler eq 'DEFAULT') {
+    	    	require Symbol;
+		$handler = Symbol::qualify($handler, (caller)[0]);
+	    }
+	}
+	elsif ($_ eq 'untrapped') {
+	    $untrapped = 1;
+	}
+	elsif ($_ eq 'any') {
+	    $untrapped = 0;
+	}
+	elsif ($_ =~ /^\d/) {
+	    $VERSION >= $_ or croak "sigtrap.pm version $_ required,"
+		    	    	    	. " but this is only version $VERSION";
+	}
+	else {
+	    croak "Unrecognized argument $_";
+	}
+    }
+    unless ($saw_sig) {
+	@_ = qw(old-interface-signals);
+	goto Arg_loop;
+    }
+}
+
+sub handler_die {
+    croak "Caught a SIG$_[0]";
+}
+
+sub handler_traceback {
+    package DB;		# To get subroutine args.
+    $SIG{'ABRT'} = DEFAULT;
+    kill 'ABRT', $$ if $panic++;
+    syswrite(STDERR, 'Caught a SIG', 12);
+    syswrite(STDERR, $_[0], length($_[0]));
+    syswrite(STDERR, ' at ', 4);
+    ($pack,$file,$line) = caller;
+    syswrite(STDERR, $file, length($file));
+    syswrite(STDERR, ' line ', 6);
+    syswrite(STDERR, $line, length($line));
+    syswrite(STDERR, "\n", 1);
+
+    # Now go for broke.
+    for ($i = 1; ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); $i++) {
+        @a = ();
+	for $arg (@args) {
+	    $_ = "$arg";
+	    s/([\'\\])/\\$1/g;
+	    s/([^\0]*)/'$1'/
+	      unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
+	    s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+	    s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+	    push(@a, $_);
+	}
+	$w = $w ? '@ = ' : '$ = ';
+	$a = $h ? '(' . join(', ', @a) . ')' : '';
+	$e =~ s/\n\s*\;\s*\Z// if $e;
+	$e =~ s/[\\\']/\\$1/g if $e;
+	if ($r) {
+	    $s = "require '$e'";
+	} elsif (defined $r) {
+	    $s = "eval '$e'";
+	} elsif ($s eq '(eval)') {
+	    $s = "eval {...}";
+	}
+	$f = "file `$f'" unless $f eq '-e';
+	$mess = "$w$s$a called from $f line $l\n";
+	syswrite(STDERR, $mess, length($mess));
+    }
+    kill 'ABRT', $$;
+}
+
+1;
+
+__END__
+
+=head1 SYNOPSIS
+
+    use sigtrap;
+    use sigtrap qw(stack-trace old-interface-signals);	# equivalent
+    use sigtrap qw(BUS SEGV PIPE ABRT);
+    use sigtrap qw(die INT QUIT);
+    use sigtrap qw(die normal-signals);
+    use sigtrap qw(die untrapped normal-signals);
+    use sigtrap qw(die untrapped normal-signals
+		    stack-trace any error-signals);
+    use sigtrap 'handler' => \&my_handler, 'normal-signals';
+    use sigtrap qw(handler my_handler normal-signals
+    	    	    stack-trace error-signals);
+
+=head1 DESCRIPTION
+
+The B<sigtrap> pragma is a simple interface to installing signal
+handlers.  You can have it install one of two handlers supplied by
+B<sigtrap> itself (one which provides a Perl stack trace and one which
+simply C<die()>s), or alternately you can supply your own handler for it
+to install.  It can be told only to install a handler for signals which
+are either untrapped or ignored.  It has a couple of lists of signals to
+trap, plus you can supply your own list of signals.
+
+The arguments passed to the C<use> statement which invokes B<sigtrap>
+are processed in order.  When a signal name or the name of one of
+B<sigtrap>'s signal lists is encountered a handler is immediately
+installed, when an option is encountered it affects subsequently
+installed handlers.
+
+=head1 OPTIONS
+
+=head2 SIGNAL HANDLERS
+
+These options affect which handler will be used for subsequently
+installed signals.
+
+=over 4
+
+=item B<stack-trace>
+
+The handler used for subsequently installed signals outputs a Perl stack
+trace to STDERR and then tries to dump core.  This is the default signal
+handler.
+
+=item B<die>
+
+The handler used for subsequently installed signals calls C<die>
+(actually C<croak>) with a message indicating which signal was caught.
+
+=item B<handler> I<your-handler>
+
+I<your-handler> will be used as the handler for subsequently installed
+signals.  I<your-handler> can be any value which is valid as an
+assignment to an element of C<%SIG>.
+
+=back
+
+=head2 SIGNAL LISTS
+
+B<sigtrap> has a few built-in lists of signals to trap.  They are:
+
+=over 4
+
+=item B<normal-signals>
+
+These are the signals which a program might normally expect to encounter
+and which by default cause it to terminate.  They are HUP, INT, PIPE and
+TERM.
+
+=item B<error-signals>
+
+These signals usually indicate a serious problem with the Perl
+interpreter or with your script.  They are ABRT, BUS, EMT, FPE, ILL,
+QUIT, SEGV, SYS and TRAP.
+
+=item B<old-interface-signals>
+
+These are the signals which were trapped by default by the old
+B<sigtrap> interface, they are ABRT, BUS, EMT, FPE, ILL, PIPE, QUIT,
+SEGV, SYS, TERM, and TRAP.  If no signals or signals lists are passed to
+B<sigtrap>, this list is used.
+
+=back
+
+For each of these three lists, the collection of signals set to be
+trapped is checked before trapping; if your architecture does not
+implement a particular signal, it will not be trapped but rather
+silently ignored.
+
+=head2 OTHER
+
+=over 4
+
+=item B<untrapped>
+
+This token tells B<sigtrap> to install handlers only for subsequently
+listed signals which aren't already trapped or ignored.
+
+=item B<any>
+
+This token tells B<sigtrap> to install handlers for all subsequently
+listed signals.  This is the default behavior.
+
+=item I<signal>
+
+Any argument which looks like a signal name (that is,
+C</^[A-Z][A-Z0-9]*$/>) indicates that B<sigtrap> should install a
+handler for that name.
+
+=item I<number>
+
+Require that at least version I<number> of B<sigtrap> is being used.
+
+=back
+
+=head1 EXAMPLES
+
+Provide a stack trace for the old-interface-signals:
+
+    use sigtrap;
+
+Ditto:
+
+    use sigtrap qw(stack-trace old-interface-signals);
+
+Provide a stack trace on the 4 listed signals only:
+
+    use sigtrap qw(BUS SEGV PIPE ABRT);
+
+Die on INT or QUIT:
+
+    use sigtrap qw(die INT QUIT);
+
+Die on HUP, INT, PIPE or TERM:
+
+    use sigtrap qw(die normal-signals);
+
+Die on HUP, INT, PIPE or TERM, except don't change the behavior for
+signals which are already trapped or ignored:
+
+    use sigtrap qw(die untrapped normal-signals);
+
+Die on receipt one of an of the B<normal-signals> which is currently
+B<untrapped>, provide a stack trace on receipt of B<any> of the
+B<error-signals>:
+
+    use sigtrap qw(die untrapped normal-signals
+		    stack-trace any error-signals);
+
+Install my_handler() as the handler for the B<normal-signals>:
+
+    use sigtrap 'handler', \&my_handler, 'normal-signals';
+
+Install my_handler() as the handler for the normal-signals, provide a
+Perl stack trace on receipt of one of the error-signals:
+
+    use sigtrap qw(handler my_handler normal-signals
+    	    	    stack-trace error-signals);
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/strict.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/strict.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/strict.pm	(revision 14265)
@@ -0,0 +1,117 @@
+package strict;
+
+=head1 NAME
+
+strict - Perl pragma to restrict unsafe constructs
+
+=head1 SYNOPSIS
+
+    use strict;
+
+    use strict "vars";
+    use strict "refs";
+    use strict "subs";
+
+    use strict;
+    no strict "vars";
+
+=head1 DESCRIPTION
+
+If no import list is supplied, all possible restrictions are assumed.
+(This is the safest mode to operate in, but is sometimes too strict for
+casual programming.)  Currently, there are three possible things to be
+strict about:  "subs", "vars", and "refs".
+
+=over 6
+
+=item C<strict refs>
+
+This generates a runtime error if you 
+use symbolic references (see L<perlref>).
+
+    use strict 'refs';
+    $ref = \$foo;
+    print $$ref;	# ok
+    $ref = "foo";
+    print $$ref;	# runtime error; normally ok
+    $file = "STDOUT";
+    print $file "Hi!";	# error; note: no comma after $file
+
+There is one exception to this rule:
+
+    $bar = \&{'foo'};
+    &$bar;
+
+is allowed so that C<goto &$AUTOLOAD> would not break under stricture.
+
+
+=item C<strict vars>
+
+This generates a compile-time error if you access a variable that wasn't
+declared via "our" or C<use vars>,
+localized via C<my()>, or wasn't fully qualified.  Because this is to avoid
+variable suicide problems and subtle dynamic scoping issues, a merely
+local() variable isn't good enough.  See L<perlfunc/my> and
+L<perlfunc/local>.
+
+    use strict 'vars';
+    $X::foo = 1;	 # ok, fully qualified
+    my $foo = 10;	 # ok, my() var
+    local $foo = 9;	 # blows up
+
+    package Cinna;
+    our $bar;			# Declares $bar in current package
+    $bar = 'HgS';		# ok, global declared via pragma
+
+The local() generated a compile-time error because you just touched a global
+name without fully qualifying it.
+
+Because of their special use by sort(), the variables $a and $b are
+exempted from this check.
+
+=item C<strict subs>
+
+This disables the poetry optimization, generating a compile-time error if
+you try to use a bareword identifier that's not a subroutine, unless it
+appears in curly braces or on the left hand side of the "=E<gt>" symbol.
+
+
+    use strict 'subs';
+    $SIG{PIPE} = Plumber;   	# blows up
+    $SIG{PIPE} = "Plumber"; 	# just fine: bareword in curlies always ok
+    $SIG{PIPE} = \&Plumber; 	# preferred form
+
+
+
+=back
+
+See L<perlmodlib/Pragmatic Modules>.
+
+
+=cut
+
+$strict::VERSION = "1.01";
+
+my %bitmask = (
+refs => 0x00000002,
+subs => 0x00000200,
+vars => 0x00000400
+);
+
+sub bits {
+    my $bits = 0;
+    foreach my $s (@_){ $bits |= $bitmask{$s} || 0; };
+    $bits;
+}
+
+sub import {
+    shift;
+    $^H |= bits(@_ ? @_ : qw(refs subs vars));
+}
+
+sub unimport {
+    shift;
+    $^H &= ~ bits(@_ ? @_ : qw(refs subs vars));
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/subs.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/subs.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/subs.pm	(revision 14265)
@@ -0,0 +1,38 @@
+package subs;
+
+=head1 NAME
+
+subs - Perl pragma to predeclare sub names
+
+=head1 SYNOPSIS
+
+    use subs qw(frob);
+    frob 3..10;
+
+=head1 DESCRIPTION
+
+This will predeclare all the subroutine whose names are 
+in the list, allowing you to use them without parentheses
+even before they're declared.
+
+Unlike pragmas that affect the C<$^H> hints variable, the C<use vars> and
+C<use subs> declarations are not BLOCK-scoped.  They are thus effective
+for the entire file in which they appear.  You may not rescind such
+declarations with C<no vars> or C<no subs>.
+
+See L<perlmodlib/Pragmatic Modules> and L<strict/strict subs>.
+
+=cut
+
+require 5.000;
+
+sub import {
+    my $callpack = caller;
+    my $pack = shift;
+    my @imports = @_;
+    foreach $sym (@imports) {
+	*{"${callpack}::$sym"} = \&{"${callpack}::$sym"};
+    }
+};
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/utf8.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/utf8.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/utf8.pm	(revision 14265)
@@ -0,0 +1,84 @@
+package utf8;
+
+if (ord('A') != 193) { # make things more pragmatic for EBCDIC folk
+
+$utf8::hint_bits = 0x00800000;
+
+sub import {
+    $^H |= $utf8::hint_bits;
+    $enc{caller()} = $_[1] if $_[1];
+}
+
+sub unimport {
+    $^H &= ~$utf8::hint_bits;
+}
+
+sub AUTOLOAD {
+    require "utf8_heavy.pl";
+    goto &$AUTOLOAD if defined &$AUTOLOAD;
+    Carp::croak("Undefined subroutine $AUTOLOAD called");
+}
+
+}
+
+1;
+__END__
+
+=head1 NAME
+
+utf8 - Perl pragma to enable/disable UTF-8 in source code
+
+=head1 SYNOPSIS
+
+    use utf8;
+    no utf8;
+
+=head1 DESCRIPTION
+
+WARNING: The implementation of Unicode support in Perl is incomplete.
+See L<perlunicode> for the exact details.
+
+The C<use utf8> pragma tells the Perl parser to allow UTF-8 in the
+program text in the current lexical scope.  The C<no utf8> pragma
+tells Perl to switch back to treating the source text as literal
+bytes in the current lexical scope.
+
+This pragma is primarily a compatibility device.  Perl versions
+earlier than 5.6 allowed arbitrary bytes in source code, whereas
+in future we would like to standardize on the UTF-8 encoding for
+source text.  Until UTF-8 becomes the default format for source
+text, this pragma should be used to recognize UTF-8 in the source.
+When UTF-8 becomes the standard source format, this pragma will
+effectively become a no-op.  This pragma already is a no-op on
+EBCDIC platforms (where it is alright to code perl in EBCDIC 
+rather than UTF-8).
+
+Enabling the C<utf8> pragma has the following effects:
+
+=over
+
+=item *
+
+Bytes in the source text that have their high-bit set will be treated
+as being part of a literal UTF-8 character.  This includes most literals
+such as identifiers, string constants, constant regular expression patterns
+and package names.
+
+=item *
+
+In the absence of inputs marked as UTF-8, regular expressions within the
+scope of this pragma will default to using character semantics instead
+of byte semantics.
+
+    @bytes_or_chars = split //, $data;	# may split to bytes if data
+					# $data isn't UTF-8
+    {
+	use utf8;			# force char semantics
+	@chars = split //, $data;	# splits characters
+    }
+
+=head1 SEE ALSO
+
+L<perlunicode>, L<bytes>
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/utf8_heavy.pl
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/utf8_heavy.pl	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/utf8_heavy.pl	(revision 14265)
@@ -0,0 +1,221 @@
+package utf8;
+
+my $DEBUG = 0;
+my $seq = "AAA0000";
+
+sub DESTROY {}
+
+sub croak { require Carp; Carp::croak(@_) }
+
+sub SWASHNEW {
+    my ($class, $type, $list, $minbits, $none) = @_;
+    local $^D = 0 if $^D;
+    print STDERR "SWASHNEW @_\n" if $DEBUG;
+    my $extras;
+    my $bits;
+ 
+    if ($type and ref ${"${class}::{$type}"} eq $class) {
+	warn qq/Found \${"${class}::{$type}"}\n/ if $DEBUG;
+	return ${"${class}::{$type}"};	# Already there...
+    }
+
+    $type ||= $seq++;
+
+    my $caller;
+    my $i = 0;
+    while (($caller = caller($i)) eq __PACKAGE__) { $i++ }
+    my $encoding = $enc{$caller} || "unicode";
+    (my $file = $type) =~ s!::!/!g;
+    $file =~ s#^(I[sn]|To)([A-Z].*)#$1/$2#;
+    $list ||= eval { $caller->$type(); }
+	|| do "$file.pl"
+	|| do "$encoding/$file.pl"
+	|| do "$encoding/Is/${type}.pl"
+	|| croak("Can't find $encoding character property definition via $caller->$type or $file.pl");
+
+    $| = 1;
+
+    if ($list) {
+	my @tmp = split(/^/m, $list);
+	my %seen;
+	no warnings;
+	$extras = join '', grep /^[^0-9a-fA-F]/, @tmp;
+	$list = join '',
+	    sort { hex $a <=> hex $b }
+	    grep {/^([0-9a-fA-F]+)/ and not $seen{$1}++} @tmp; # XXX doesn't do ranges right
+    }
+
+    if ($none) {
+	my $hextra = sprintf "%04x", $none + 1;
+	$list =~ s/\tXXXX$/\t$hextra/mg;
+    }
+
+    if ($minbits < 32) {
+	my $top = 0;
+	while ($list =~ /^([0-9a-fA-F]+)(?:\t([0-9a-fA-F]+)?)(?:\t([0-9a-fA-F]+))?/mg) {
+	    my $min = hex $1;
+	    my $max = hex(defined $2 ? $2 : $1);
+	    my $val = hex(defined $3 ? $3 : "");
+	    $val += $max - $min if defined $3;
+	    $top = $val if $val > $top;
+	}
+	$bits =
+	    $top > 0xffff ? 32 :
+	    $top > 0xff ? 16 :
+	    $top > 1 ? 8 : 1
+    }
+    $bits = $minbits if $bits < $minbits;
+
+    my @extras;
+    for my $x ($extras) {
+	pos $x = 0;
+	while ($x =~ /^([^0-9a-fA-F\n])(.*)/mg) {
+	    my $char = $1;
+	    my $name = $2;
+	    # print STDERR "$1 => $2\n" if $DEBUG;
+	    if ($char =~ /[-+!]/) {
+		my ($c,$t) = split(/::/, $name, 2);	# bogus use of ::, really
+		my $subobj = $c->SWASHNEW($t, "", 0, 0, 0);
+		push @extras, $name => $subobj;
+		$bits = $subobj->{BITS} if $bits < $subobj->{BITS};
+	    }
+	}
+    }
+
+    print STDERR "CLASS = $class, TYPE => $type, BITS => $bits, NONE => $none\nEXTRAS =>\n$extras\nLIST =>\n$list\n" if $DEBUG;
+
+    ${"${class}::{$type}"} = bless {
+	TYPE => $type,
+	BITS => $bits,
+	EXTRAS => $extras,
+	LIST => $list,
+	NONE => $none,
+	@extras,
+    } => $class;
+}
+
+# NOTE: utf8.c:swash_init() assumes entries are never modified once generated.
+
+sub SWASHGET {
+    my ($self, $start, $len) = @_;
+    local $^D = 0 if $^D;
+    my $type = $self->{TYPE};
+    my $bits = $self->{BITS};
+    my $none = $self->{NONE};
+    print STDERR "SWASHGET @_ [$type/$bits/$none]\n" if $DEBUG;
+    my $end = $start + $len;
+    my $swatch = "";
+    my $key;
+    vec($swatch, $len - 1, $bits) = 0;	# Extend to correct length.
+    if ($none) {
+	for $key (0 .. $len - 1) { vec($swatch, $key, $bits) = $none }
+    }
+
+    for ($self->{LIST}) {
+	pos $_ = 0;
+	if ($bits > 1) {
+	  LINE:
+	    while (/^([0-9a-fA-F]+)(?:\t([0-9a-fA-F]+)?)(?:\t([0-9a-fA-F]+))?/mg) {
+		my $min = hex $1;
+		my $max = (defined $2 ? hex $2 : $min);
+		my $val = hex $3;
+		next if $max < $start;
+#		print "$min $max $val\n";
+		if ($none) {
+		    if ($min < $start) {
+			$val += $start - $min if $val < $none;
+			$min = $start;
+		    }
+		    for ($key = $min; $key <= $max; $key++) {
+			last LINE if $key >= $end;
+#			print STDERR "$key => $val\n" if $DEBUG;
+			vec($swatch, $key - $start, $bits) = $val;
+			++$val if $val < $none;
+		    }
+		}
+		else {
+		    if ($min < $start) {
+			$val += $start - $min;
+			$min = $start;
+		    }
+		    for ($key = $min; $key <= $max; $key++, $val++) {
+			last LINE if $key >= $end;
+#			print STDERR "$key => $val\n" if $DEBUG;
+			vec($swatch, $key - $start, $bits) = $val;
+		    }
+		}
+	    }
+	}
+	else {
+	  LINE:
+	    while (/^([0-9a-fA-F]+)(?:\t([0-9a-fA-F]+))?/mg) {
+		my $min = hex $1;
+		my $max = (defined $2 ? hex $2 : $min);
+		next if $max < $start;
+		if ($min < $start) {
+		    $min = $start;
+		}
+		for ($key = $min; $key <= $max; $key++) {
+		    last LINE if $key >= $end;
+#		    print STDERR "$key => 1\n" if $DEBUG;
+		    vec($swatch, $key - $start, 1) = 1;
+		}
+	    }
+	}
+    }
+    for my $x ($self->{EXTRAS}) {
+	pos $x = 0;
+	while ($x =~ /^([-+!])(.*)/mg) {
+	    my $char = $1;
+	    my $name = $2;
+	    print STDERR "INDIRECT $1 $2\n" if $DEBUG;
+	    my $otherbits = $self->{$name}->{BITS};
+	    croak("SWASHGET size mismatch") if $bits < $otherbits;
+	    my $other = $self->{$name}->SWASHGET($start, $len);
+	    if ($char eq '+') {
+		if ($bits == 1 and $otherbits == 1) {
+		    $swatch |= $other;
+		}
+		else {
+		    for ($key = 0; $key < $len; $key++) {
+			vec($swatch, $key, $bits) = vec($other, $key, $otherbits);
+		    }
+		}
+	    }
+	    elsif ($char eq '!') {
+		if ($bits == 1 and $otherbits == 1) {
+		    $swatch |= ~$other;
+		}
+		else {
+		    for ($key = 0; $key < $len; $key++) {
+			if (!vec($other, $key, $otherbits)) {
+			    vec($swatch, $key, $bits) = 1;
+			}
+		    }
+		}
+	    }
+	    elsif ($char eq '-') {
+		if ($bits == 1 and $otherbits == 1) {
+		    $swatch &= ~$other;
+		}
+		else {
+		    for ($key = 0; $key < $len; $key++) {
+			if (vec($other, $key, $otherbits)) {
+			    vec($swatch, $key, $bits) = 0;
+			}
+		    }
+		}
+	    }
+	}
+    }
+    if ($DEBUG) {
+	print STDERR "CELLS ";
+	for ($key = 0; $key < $len; $key++) {
+	    print STDERR vec($swatch, $key, $bits), " ";
+	}
+	print STDERR "\n";
+    }
+    $swatch;
+}
+
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/vars.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/vars.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/vars.pm	(revision 14265)
@@ -0,0 +1,83 @@
+package vars;
+
+require 5.002;
+
+# The following require can't be removed during maintenance
+# releases, sadly, because of the risk of buggy code that does
+# require Carp; Carp::croak "..."; without brackets dying
+# if Carp hasn't been loaded in earlier compile time. :-(
+# We'll let those bugs get found on the development track.
+require Carp if $] < 5.00450;
+
+use warnings::register;
+require strict;
+
+sub import {
+    my $callpack = caller;
+    my ($pack, @imports, $sym, $ch) = @_;
+    foreach $sym (@imports) {
+        ($ch, $sym) = unpack('a1a*', $sym);
+	if ($sym =~ tr/A-Za-z_0-9//c) {
+	    # time for a more-detailed check-up
+	    if ($sym =~ /::/) {
+		require Carp;
+		Carp::croak("Can't declare another package's variables");
+	    } elsif ($sym =~ /^\w+[[{].*[]}]$/) {
+		require Carp;
+		Carp::croak("Can't declare individual elements of hash or array");
+	    } elsif (warnings::enabled() and length($sym) == 1 and $sym !~ tr/a-zA-Z//) {
+		warnings::warn("No need to declare built-in vars");
+            } elsif  ( $^H &= strict::bits('vars') ) {
+              Carp::croak("'$ch$sym' is not a valid variable name under strict vars");
+	    }
+	}
+        *{"${callpack}::$sym"} =
+          (  $ch eq "\$" ? \$   {"${callpack}::$sym"}
+           : $ch eq "\@" ? \@   {"${callpack}::$sym"}
+           : $ch eq "\%" ? \%   {"${callpack}::$sym"}
+           : $ch eq "\*" ? \*   {"${callpack}::$sym"}
+           : $ch eq "\&" ? \&   {"${callpack}::$sym"}
+           : do {
+		require Carp;
+		Carp::croak("'$ch$sym' is not a valid variable name");
+	     });
+    }
+};
+
+1;
+__END__
+
+=head1 NAME
+
+vars - Perl pragma to predeclare global variable names (obsolete)
+
+=head1 SYNOPSIS
+
+    use vars qw($frob @mung %seen);
+
+=head1 DESCRIPTION
+
+NOTE: The functionality provided by this pragma has been superseded
+by C<our> declarations, available in Perl v5.6.0 or later.  See
+L<perlfunc/our>.
+
+This will predeclare all the variables whose names are 
+in the list, allowing you to use them under "use strict", and
+disabling any typo warnings.
+
+Unlike pragmas that affect the C<$^H> hints variable, the C<use vars> and
+C<use subs> declarations are not BLOCK-scoped.  They are thus effective
+for the entire file in which they appear.  You may not rescind such
+declarations with C<no vars> or C<no subs>.
+
+Packages such as the B<AutoLoader> and B<SelfLoader> that delay
+loading of subroutines within packages can create problems with
+package lexicals defined using C<my()>. While the B<vars> pragma
+cannot duplicate the effect of package lexicals (total transparency
+outside of the package), it can act as an acceptable substitute by
+pre-declaring global symbols, ensuring their availability to the
+later-loaded routines.
+
+See L<perlmodlib/Pragmatic Modules>.
+
+=cut
Index: /for-distributions/trunk/bin/windows/perl/lib/warnings.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/warnings.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/warnings.pm	(revision 14265)
@@ -0,0 +1,419 @@
+
+# This file was created by warnings.pl
+# Any changes made here will be lost.
+#
+
+package warnings;
+
+=head1 NAME
+
+warnings - Perl pragma to control optional warnings
+
+=head1 SYNOPSIS
+
+    use warnings;
+    no warnings;
+
+    use warnings "all";
+    no warnings "all";
+
+    use warnings::register;
+    if (warnings::enabled()) {
+        warnings::warn("some warning");
+    }
+
+    if (warnings::enabled("void")) {
+        warnings::warn("void", "some warning");
+    }
+
+    if (warnings::enabled($object)) {
+        warnings::warn($object, "some warning");
+    }
+
+    warnif("some warning");
+    warnif("void", "some warning");
+    warnif($object, "some warning");
+
+=head1 DESCRIPTION
+
+If no import list is supplied, all possible warnings are either enabled
+or disabled.
+
+A number of functions are provided to assist module authors. 
+
+=over 4
+
+=item use warnings::register
+
+Creates a new warnings category with the same name as the package where
+the call to the pragma is used.
+
+=item warnings::enabled()
+
+Use the warnings category with the same name as the current package.
+
+Return TRUE if that warnings category is enabled in the calling module.
+Otherwise returns FALSE.
+
+=item warnings::enabled($category)
+
+Return TRUE if the warnings category, C<$category>, is enabled in the
+calling module.
+Otherwise returns FALSE.
+
+=item warnings::enabled($object)
+
+Use the name of the class for the object reference, C<$object>, as the
+warnings category.
+
+Return TRUE if that warnings category is enabled in the first scope
+where the object is used.
+Otherwise returns FALSE.
+
+=item warnings::warn($message)
+
+Print C<$message> to STDERR.
+
+Use the warnings category with the same name as the current package.
+
+If that warnings category has been set to "FATAL" in the calling module
+then die. Otherwise return.
+
+=item warnings::warn($category, $message)
+
+Print C<$message> to STDERR.
+
+If the warnings category, C<$category>, has been set to "FATAL" in the
+calling module then die. Otherwise return.
+
+=item warnings::warn($object, $message)
+
+Print C<$message> to STDERR.
+
+Use the name of the class for the object reference, C<$object>, as the
+warnings category.
+
+If that warnings category has been set to "FATAL" in the scope where C<$object>
+is first used then die. Otherwise return.
+
+
+=item warnings::warnif($message)
+
+Equivalent to:
+
+    if (warnings::enabled())
+      { warnings::warn($message) }
+
+=item warnings::warnif($category, $message)
+
+Equivalent to:
+
+    if (warnings::enabled($category))
+      { warnings::warn($category, $message) }
+
+=item warnings::warnif($object, $message)
+
+Equivalent to:
+
+    if (warnings::enabled($object))
+      { warnings::warn($object, $message) }
+
+=back
+
+See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
+
+=cut
+
+use Carp ;
+
+%Offsets = (
+    'all'		=> 0,
+    'chmod'		=> 2,
+    'closure'		=> 4,
+    'exiting'		=> 6,
+    'glob'		=> 8,
+    'io'		=> 10,
+    'closed'		=> 12,
+    'exec'		=> 14,
+    'newline'		=> 16,
+    'pipe'		=> 18,
+    'unopened'		=> 20,
+    'misc'		=> 22,
+    'numeric'		=> 24,
+    'once'		=> 26,
+    'overflow'		=> 28,
+    'pack'		=> 30,
+    'portable'		=> 32,
+    'recursion'		=> 34,
+    'redefine'		=> 36,
+    'regexp'		=> 38,
+    'severe'		=> 40,
+    'debugging'		=> 42,
+    'inplace'		=> 44,
+    'internal'		=> 46,
+    'malloc'		=> 48,
+    'signal'		=> 50,
+    'substr'		=> 52,
+    'syntax'		=> 54,
+    'ambiguous'		=> 56,
+    'bareword'		=> 58,
+    'deprecated'	=> 60,
+    'digit'		=> 62,
+    'parenthesis'	=> 64,
+    'precedence'	=> 66,
+    'printf'		=> 68,
+    'prototype'		=> 70,
+    'qw'		=> 72,
+    'reserved'		=> 74,
+    'semicolon'		=> 76,
+    'taint'		=> 78,
+    'umask'		=> 80,
+    'uninitialized'	=> 82,
+    'unpack'		=> 84,
+    'untie'		=> 86,
+    'utf8'		=> 88,
+    'void'		=> 90,
+    'y2k'		=> 92,
+  );
+
+%Bits = (
+    'all'		=> "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
+    'ambiguous'		=> "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
+    'bareword'		=> "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
+    'chmod'		=> "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+    'closed'		=> "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+    'closure'		=> "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+    'debugging'		=> "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
+    'deprecated'	=> "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
+    'digit'		=> "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
+    'exec'		=> "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+    'exiting'		=> "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+    'glob'		=> "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+    'inplace'		=> "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
+    'internal'		=> "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
+    'io'		=> "\x00\x54\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10]
+    'malloc'		=> "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
+    'misc'		=> "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+    'newline'		=> "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+    'numeric'		=> "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+    'once'		=> "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+    'overflow'		=> "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+    'pack'		=> "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+    'parenthesis'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
+    'pipe'		=> "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+    'portable'		=> "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
+    'precedence'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
+    'printf'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
+    'prototype'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
+    'qw'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
+    'recursion'		=> "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
+    'redefine'		=> "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
+    'regexp'		=> "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
+    'reserved'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
+    'semicolon'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
+    'severe'		=> "\x00\x00\x00\x00\x00\x55\x01\x00\x00\x00\x00\x00", # [20..24]
+    'signal'		=> "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
+    'substr'		=> "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
+    'syntax'		=> "\x00\x00\x00\x00\x00\x00\x40\x55\x55\x15\x00\x00", # [27..38]
+    'taint'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
+    'umask'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
+    'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
+    'unopened'		=> "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+    'unpack'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
+    'untie'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
+    'utf8'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
+    'void'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
+    'y2k'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
+  );
+
+%DeadBits = (
+    'all'		=> "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
+    'ambiguous'		=> "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
+    'bareword'		=> "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
+    'chmod'		=> "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+    'closed'		=> "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+    'closure'		=> "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+    'debugging'		=> "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
+    'deprecated'	=> "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
+    'digit'		=> "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
+    'exec'		=> "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+    'exiting'		=> "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+    'glob'		=> "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+    'inplace'		=> "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
+    'internal'		=> "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
+    'io'		=> "\x00\xa8\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10]
+    'malloc'		=> "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
+    'misc'		=> "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+    'newline'		=> "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+    'numeric'		=> "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+    'once'		=> "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+    'overflow'		=> "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+    'pack'		=> "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+    'parenthesis'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
+    'pipe'		=> "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+    'portable'		=> "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
+    'precedence'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
+    'printf'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
+    'prototype'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
+    'qw'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
+    'recursion'		=> "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
+    'redefine'		=> "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
+    'regexp'		=> "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
+    'reserved'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
+    'semicolon'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
+    'severe'		=> "\x00\x00\x00\x00\x00\xaa\x02\x00\x00\x00\x00\x00", # [20..24]
+    'signal'		=> "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
+    'substr'		=> "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
+    'syntax'		=> "\x00\x00\x00\x00\x00\x00\x80\xaa\xaa\x2a\x00\x00", # [27..38]
+    'taint'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
+    'umask'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
+    'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
+    'unopened'		=> "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+    'unpack'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
+    'untie'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
+    'utf8'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
+    'void'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
+    'y2k'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
+  );
+
+$NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0";
+$LAST_BIT = 94 ;
+$BYTES    = 12 ;
+
+$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
+
+sub bits {
+    my $mask ;
+    my $catmask ;
+    my $fatal = 0 ;
+    foreach my $word (@_) {
+	if  ($word eq 'FATAL') {
+	    $fatal = 1;
+	}
+	elsif ($catmask = $Bits{$word}) {
+	    $mask |= $catmask ;
+	    $mask |= $DeadBits{$word} if $fatal ;
+	}
+	else
+          { croak("unknown warnings category '$word'")}  
+    }
+
+    return $mask ;
+}
+
+sub import {
+    shift;
+    my $mask = ${^WARNING_BITS} ;
+    if (vec($mask, $Offsets{'all'}, 1)) {
+        $mask |= $Bits{'all'} ;
+        $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
+    }
+    ${^WARNING_BITS} = $mask | bits(@_ ? @_ : 'all') ;
+}
+
+sub unimport {
+    shift;
+    my $mask = ${^WARNING_BITS} ;
+    if (vec($mask, $Offsets{'all'}, 1)) {
+        $mask |= $Bits{'all'} ;
+        $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
+    }
+    ${^WARNING_BITS} = $mask & ~ (bits(@_ ? @_ : 'all') | $All) ;
+}
+
+sub __chk
+{
+    my $category ;
+    my $offset ;
+    my $isobj = 0 ;
+
+    if (@_) {
+        # check the category supplied.
+        $category = shift ;
+        if (ref $category) {
+            croak ("not an object")
+                if $category !~ /^([^=]+)=/ ;+
+	    $category = $1 ;
+            $isobj = 1 ;
+        }
+        $offset = $Offsets{$category};
+        croak("unknown warnings category '$category'")
+	    unless defined $offset;
+    }
+    else {
+        $category = (caller(1))[0] ; 
+        $offset = $Offsets{$category};
+        croak("package '$category' not registered for warnings")
+	    unless defined $offset ;
+    }
+
+    my $this_pkg = (caller(1))[0] ; 
+    my $i = 2 ;
+    my $pkg ;
+
+    if ($isobj) {
+        while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
+            last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
+        }
+	$i -= 2 ;
+    }
+    else {
+        for ($i = 2 ; $pkg = (caller($i))[0] ; ++ $i) {
+            last if $pkg ne $this_pkg ;
+        }
+        $i = 2 
+            if !$pkg || $pkg eq $this_pkg ;
+    }
+
+    my $callers_bitmask = (caller($i))[9] ; 
+    return ($callers_bitmask, $offset, $i) ;
+}
+
+sub enabled
+{
+    croak("Usage: warnings::enabled([category])")
+	unless @_ == 1 || @_ == 0 ;
+
+    my ($callers_bitmask, $offset, $i) = __chk(@_) ;
+
+    return 0 unless defined $callers_bitmask ;
+    return vec($callers_bitmask, $offset, 1) ||
+           vec($callers_bitmask, $Offsets{'all'}, 1) ;
+}
+
+
+sub warn
+{
+    croak("Usage: warnings::warn([category,] 'message')")
+	unless @_ == 2 || @_ == 1 ;
+
+    my $message = pop ;
+    my ($callers_bitmask, $offset, $i) = __chk(@_) ;
+    local $Carp::CarpLevel = $i ;
+    croak($message) 
+	if vec($callers_bitmask, $offset+1, 1) ||
+	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
+    carp($message) ;
+}
+
+sub warnif
+{
+    croak("Usage: warnings::warnif([category,] 'message')")
+	unless @_ == 2 || @_ == 1 ;
+
+    my $message = pop ;
+    my ($callers_bitmask, $offset, $i) = __chk(@_) ;
+    local $Carp::CarpLevel = $i ;
+
+    return 
+        unless defined $callers_bitmask &&
+            	(vec($callers_bitmask, $offset, 1) ||
+            	vec($callers_bitmask, $Offsets{'all'}, 1)) ;
+
+    croak($message) 
+	if vec($callers_bitmask, $offset+1, 1) ||
+	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
+
+    carp($message) ;
+}
+1;
Index: /for-distributions/trunk/bin/windows/perl/lib/warnings/register.pm
===================================================================
--- /for-distributions/trunk/bin/windows/perl/lib/warnings/register.pm	(revision 14265)
+++ /for-distributions/trunk/bin/windows/perl/lib/warnings/register.pm	(revision 14265)
@@ -0,0 +1,38 @@
+package warnings::register ;
+
+=pod
+
+=head1 NAME
+
+warnings::register - warnings import function
+
+=cut
+
+require warnings ;
+
+sub mkMask
+{
+    my ($bit) = @_ ;
+    my $mask = "" ;
+
+    vec($mask, $bit, 1) = 1 ;
+    return $mask ;
+}
+
+sub import
+{
+    shift ;
+    my $package = (caller(0))[0] ;
+    if (! defined $warnings::Bits{$package}) {
+        $warnings::Bits{$package}     = mkMask($warnings::LAST_BIT) ;
+        vec($warnings::Bits{'all'}, $warnings::LAST_BIT, 1) = 1 ;
+        $warnings::Offsets{$package}  = $warnings::LAST_BIT ++ ;
+	foreach my $k (keys %warnings::Bits) {
+	    vec($warnings::Bits{$k}, $warnings::LAST_BIT, 1) = 0 ;
+	}
+        $warnings::DeadBits{$package} = mkMask($warnings::LAST_BIT);
+        vec($warnings::DeadBits{'all'}, $warnings::LAST_BIT++, 1) = 1 ;
+    }
+}
+
+1 ;
Index: /for-distributions/trunk/collect/demo/etc/collect.cfg
===================================================================
--- /for-distributions/trunk/collect/demo/etc/collect.cfg	(revision 14265)
+++ /for-distributions/trunk/collect/demo/etc/collect.cfg	(revision 14265)
@@ -0,0 +1,82 @@
+creator		greenstone@cs.waikato.ac.nz
+maintainer	greenstone@cs.waikato.ac.nz
+public		true
+
+beta		false
+
+indexes		section:text section:Title document:text
+
+plugin		GAPlug
+plugin		HTMLPlug -description_tags 
+plugin		ArcPlug 
+plugin		RecPlug -use_metadata_files 
+
+classify	Hierarchy -metadata dls.Subject -sort dls.Title -buttonname Subject
+classify	Hierarchy -metadata dls.AZList -hlist_at_top  -sort dls.Title -buttonname Title
+classify	Hierarchy -metadata dls.Organization -sort dls.Title -buttonname Organization
+classify	Hierarchy -metadata dls.Keyword -sort dls.Title -buttonname Howto
+
+# To build this collection using the List clasifier for the Howto
+# listing (as shown in the Greenstone Developer's Guide) you should
+# uncomment the following two lines and comment out the line above
+# before rebuilding.
+#classify      List -metadata dls.Keyword -buttonname Howto
+#format        CL4VList     "<br>[link][dls.Keyword][/link]"
+
+format SearchVList "<td valign=top>[link][icon][/link]</td><td>{If}{[parent(All\': \'):Title],[parent(All\': \'):Title]:}[link][Title][/link]</td>"
+format VList "<td valign=top>[link][icon][/link]</td><td valign=top>[highlight]{Or}{[Title],Untitled}[/highlight]<i><small>{If}{[Date],<br>_textdate_[Date]}{If}{[NumPages],<br>_textnumpages_[NumPages]}{If}{[Source],<br>_textsource_[Source]}</small></i></td>"
+
+format DocumentText "<h3>[Title]</h3>\\n\\n<p>[Text]"
+format DocumentImages true
+format DocumentButtons "Expand Text|Expand Contents|Detach|Highlight"
+
+format DateList "<td>[link][icon][/link]</td><td>[highlight]{Or}{[dls.Title],[dc.Title],[Title],Untitled}[/highlight]</td><td>[Date]</td>"
+
+format HList "[link][highlight][Title][/highlight][/link]"
+
+format DocumentHeading "{Or}{[parent(Top):Title],[Title],untitled}<br>"
+
+collectionmeta	iconcollectionsmall [l=en] "_httpprefix_/collect/demo/images/en/demosm.gif"
+collectionmeta	iconcollection [l=en] "_httpprefix_/collect/demo/images/en/demo.gif"
+
+collectionmeta	iconcollectionsmall [l=fr] "_httpprefix_/collect/demo/images/fr/demosm.gif"
+collectionmeta	iconcollection [l=fr] "_httpprefix_/collect/demo/images/fr/demo.gif"
+
+collectionmeta	iconcollectionsmall [l=es] "_httpprefix_/collect/demo/images/es/demosm.gif"
+collectionmeta	iconcollection [l=es] "_httpprefix_/collect/demo/images/es/demo.gif"
+
+collectionmeta	iconcollectionsmall [l=ru] "_httpprefix_/collect/demo/images/ru/demosm.gif"
+collectionmeta	iconcollection [l=ru] "_httpprefix_/collect/demo/images/ru/demo.gif"
+
+# -- English strings ----------------
+collectionmeta	collectionname [l=en] "Greenstone demo"
+collectionmeta	collectionextra [l=en] "This is a demonstration collection for the Greenstone digital library software.\nIt contains a small subset (11 documents) of the Humanitarian and Development Libraries."
+
+collectionmeta	.section:text [l=en] "chapters"
+collectionmeta	.section:Title [l=en] "section titles"
+collectionmeta	.document:text [l=en] "entire documents"
+
+# -- French strings ----------------
+collectionmeta	collectionname [l=fr] "DÃ©mo Greenstone"
+collectionmeta	collectionextra [l=fr] "Il s\'agit d\'une collection de dÃ©monstration pour le logiciel Greenstone. Elle contient seulement un petit Ã©chantillon des BibliothÃšques humanitaires pour le DÃ©veloppement (11 documents)."
+
+collectionmeta	.section:text [l=fr] "chapitres"
+collectionmeta	.section:Title [l=fr] "titres des sections"
+collectionmeta	.document:text [l=fr] "documents entiers"
+
+# -- Spanish strings ----------------
+collectionmeta	collectionname [l=es] "ColecciÃ³n de muestra Greenstone"
+collectionmeta	collectionextra [l=es] "Esta es una colecciÃ³n de demostraciÃ³n del programa Greenstone. Contiene un pequeÃ±o subconjunto (11 documentos) de las Bibliotecas Humanitarias para el Desarrollo."
+
+collectionmeta	.section:text [l=es] "capÃ­tulos"
+collectionmeta	.section:Title [l=es] "tÃ­tulos de las secciones"
+collectionmeta	.document:text [l=es] "documentos enteros"
+
+# -- Russian strings ----------------
+collectionmeta	collectionname [l=ru] "ÐŽÐµÐŒÐŸÐœÑÑÑÐ°ÑÐžÐŸÐœÐœÑÐ¹ Ð¿ÑÐžÐŒÐµÑ Greenstone"
+collectionmeta	collectionextra [l=ru] "Ð­ÑÐŸ - ÐŽÐµÐŒÐŸÐœÑÑÑÐ°ÑÐžÐŸÐœÐœÐ°Ñ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ Ð¿ÑÐŸÐ³ÑÐ°ÐŒÐŒÐœÐŸÐ³ÐŸ ÐŸÐ±ÐµÑÐ¿ÐµÑÐµÐœÐžÑ ÑÐžÑÑÐŸÐ²ÐŸÐ¹ Ð±ÐžÐ±Ð»ÐžÐŸÑÐµÐºÐž Greenstone. ÐÐœÐ° ÑÐŸÐŽÐµÑÐ¶ÐžÑ ÐœÐµÐ±ÐŸÐ»ÑÑÐŸÐ¹ Ð¿ÐŸÐŽÐœÐ°Ð±ÐŸÑ (11 ÐŽÐŸÐºÑÐŒÐµÐœÑÐŸÐ²) ÐÑÐŒÐ°ÐœÐžÑÐ°ÑÐœÐŸÐ¹ Ð±ÐžÐ±Ð»ÐžÐŸÑÐµÐºÐž Ðž ÐÐžÐ±Ð»ÐžÐŸÑÐµÐºÐž ÑÐ°Ð·Ð²ÐžÑÐžÑ."
+
+collectionmeta	.section:text [l=ru] "ÐÐ»Ð°Ð²Ñ"
+collectionmeta	.section:Title [l=ru] "ÐÐ°Ð·Ð²Ð°ÐœÐžÑ ÑÐ°Ð·ÐŽÐµÐ»ÐŸÐ²"
+collectionmeta	.document:text [l=ru] "ÐÐŸÐ»ÐœÑÐµ ÐŽÐŸÐºÑÐŒÐµÐœÑÑ"
+
Index: /for-distributions/trunk/creating-a-release.txt
===================================================================
--- /for-distributions/trunk/creating-a-release.txt	(revision 14265)
+++ /for-distributions/trunk/creating-a-release.txt	(revision 14265)
@@ -0,0 +1,429 @@
+Preparation (do once) -- Linux
+
+    * work in your research partition (create a distribution version rather than using the normal gsdl working version), not home directory.
+    * cvs checkout -P gsdl (make sure $CVSROOT and $CVS_RSH are set)
+    * Run source setup.bash, in gsdl directory
+    * Set version number (GSDL_VERSION) in lib/gsdlconf.h
+    * Set version number for VERSION file near end of Install.sh, and commit
+    * Make "dist" directory as a sibling (not child!!) of gsdl 
+
+
+    * cvs checkout -P gli, in gsdl directory
+    * Update AboutDialog.Date in classes/dictionary*.properties, and commit
+          o Get month strings from within the file (Dates.*) 
+    * Set PROGRAM_VERSION in src/org/greenstone/gatherer/util/Utility.java, and commit
+    * Set Configuration version in classes/xml/config.xml and configRemote.xml, and commit 
+
+
+    * Change version numbers and dates in /home/nzdl/gsdl-docs/README*.TXT
+          o Get month strings from the files /home/nzdl/for-distributions/dates.* 
+    * Change version number in /home/nzdl/gsdl-docs/Support.htm
+    * Check PDF manuals are in /home/nzdl/gsdl-docs/docs 
+
+
+    * Copy /home/nzdl/for-distributions/bin/windows to become $GSDLHOME/bin/windows 
+
+    * In $GSDLHOME:
+    * Add "-static" to LDFLAGS in configure.in (LDFLAGS=-static). no space!!!
+    * Run autoconf configure.in > configure
+    * Run ./configure
+    * Fix up non-statically linked packages by adding "-static" to LDFLAGS in:
+          o packages/expat/expat-1.95.8/Makefile
+          o packages/isis-gdl/Makefile
+          o packages/pdftohtml/pdftohtml_gs/src/Makefile
+          o packages/wv/wv-gs/Makefile
+          o packages/xlhtml/xlhtml-0.4.9.0/xlhtml/Makefile
+          o packages/xlhtml/xlhtml-0.4.9.0/ppthtml/Makefile 
+    * Add "-static" to the end of the "rtftohtml" rule in packages/rtftohtml/rtftohtml_src/Makefile 
+
+look for this line and add to the end:
+
+rtftohtml$(EXEEXT): $(LIBRARIES) $(OBJS)
+   $(CC)   $(CFLAGS) $(OBJS) $(LIBRARIES) -o rtftohtml$(EXEEXT)
+
+    * Using an existing up-to-date Greenstone installation, build the demo collection, and copy to collect/demo 
+
+
+    * Get the Greenstone Installshield project:
+          o Copy /home/nzdl/for-distributions/installers/gsdl directory to somewhere on your research partition. The parent directory is the installer directory mentioned below.
+          o Edit the <installer-dir>/gsdl/Greenstone Digital Library Software.uip file and change any absolute paths as needed. 
+    * Edit the paths in the installer: edit /home/nzdl/installshieldX/alias.properties
+          o Set GSDL_DISTRIBUTION_SOURCE to .../dist/gsdl-x.xx-cdrom (dist is the directory you created earlier)
+          o Set GSDL_WEB_DISTRIBUTION_EXTRAS to .../dist/gsdl-x.xx-unix
+          o Set INSTALLERS_DIR to the installer directory from above 
+
+    * Run Installshield X (/home/nzdl/installshieldX/InstallShieldUniversal)
+          o Using "open existing project", open <installer-dir>/gsdl/Greenstone Digital Library Software.uip
+          o Set Installation Information -> General Information: Version property
+          o Change the version numbers for Text_GSDL_Version in Additional Tools -> String Table -> MyStrings. Do this for English, French, Spanish, Russian. (Could this use the Version property ???) 
+    * Save and exit for now. 
+
+[edit]
+UNESCO cdroms only
+
+    * Core languages are English (en), French (fr), Spanish (es) and Russian (ru).
+    * Edit $GSDLHOME/collect/demo/etc/collect.cfg and remove non-core language strings
+          o Overwrite /home/nzdl/for-distributions/collect/demo/etc/collect.cfg and commit if different 
+    * Edit $GSDLHOME/gli/classes/xml/languages.xml and remove mds="true" and gli="true" from non-core languages
+    * Overwrite /home/nzdl/for-distributions/gli/classes/xml/languages.xml and commit if different
+    * Check the /home/nzdl/for-distributions/etc/main.cfg against gsdl/etc/main.cfg - update the one in /home/nzdl if needed. (should be the same except language lines and language macro files commented out.) 
+
+    * Note: if you subsequently want to create a normal release, you need to delete $GSDLHOME/collect/demo/etc/collect.cfg and cvs update it to get the other languages back. 
+
+[edit]
+Preparation (do once) -- Windows (kohekohe)
+
+    * Run CMD.exe
+    * Run H:\setupenv.bat, or (equivalently):
+          o Set PATH to include CVS and SSH executables (H:\bin)
+          o Set CVSROOT=:ext:<username>@cvs.scms.waikato.ac.nz:/usr/local/global-cvs/gsdl-src
+          o Set CVS_RSH=ssh
+          o Set EDITOR=edit 
+
+
+    * cvs checkout -P gsdl (requires about 120MB once compiled)
+    * Set version number (GSDL_VERSION) in gsdl\lib\gsdlconf.h
+    * Unzip the Crypt, Expat, GDBM and STLPort packages in gsdl\packages\windows 
+
+
+    * cvs checkout -P winbin
+    * Copy winbin\bin to become gsdl\bin\windows (i.e. Copy the bin directory from winbin into 
+
+gsdl\bin\ and rename it to windows)
+
+    * Delete winbin directory 
+
+[edit]
+Preparation (do once) -- Mac OS X (shuttle)
+
+    * Start a Terminal (Finder: Go -> Utilites)
+    * export CVSROOT=:ext:<username>@cvs.scms.waikato.ac.nz:/usr/local/global-cvs/gsdl-src
+    * export CVS_RSH=ssh 
+
+    * cvs checkout -P gsdl
+    * Set version number (GSDL_VERSION) in gsdl/lib/gsdlconf.h
+    * In the gsdl directory, run ./configure --with-gdbm=<gdbm-dir> (gdbm dir e.g. /Users/kjdon/gdbm-1.8.3)
+    * In the following Makefiles, replace "-L/Users/kjdon/gdbm-1.8.3/lib -lgdbm" with "/Users/kjdon/gdbm-1.8.3/lib/libgdbm.a" in the specified variable
+          o src/recpt, GDBM_LIBS
+          o src/oaiservr, GDBM_LIBS
+          o src/db2txt, LIBS
+          o src/txt2db, LIBS 
+    * In the following Makefiles, replace "-L../../packages/expat/lib -lexpat" with "../../packages/expat/lib/libexpat.a"
+          o src/recpt, LC_LIBS
+          o src/oaiservr, LIBS 
+
+    * Create the Mac OS version of the gdbm database file for the demo collection (demo.bdb). Either:
+          o Using an existing up-to-date Greenstone installation, build the demo collection, and copy index/text/demo.bdb to gsdl/collect/demo/index/text (Linux)
+          o Or on Linux, in the demo collection, run "db2txt index/text/demo.ldb > out.txt", copy the out.txt file to the Mac, and run "txt2db demo.bdb < out.txt", then copy the demo.bdb file to gsdl/collect/demo/index/text/demo.dbd on Linux. 
+
+[edit]
+Building (repeat as often as necessary) -- Mac OS X (shuttle)
+
+    * cvs update -dP, in gsdl directory (retrieve any new changes) 
+
+    * Run make
+    * Run make install
+    * In cgi-bin, run library to check for segfaults, then copy it and oaiserver into ../bin/darwin
+    * Run otool -L bin/darwin/* to check that no executables (db2txt, library, oaiserver, txt2db) are linked to local packages. (Its ok to link against libraries in /usr/lib/.)
+    * Run strip bin/darwin/*
+    * Copy all files in bin/darwin to $GSDLHOME/bin/darwin (Linux) 
+
+[edit]
+Building (repeat as often as necessary) -- Windows (kohekohe)
+
+    * cvs update -dP, in gsdl directory (retrieve any new changes) 
+
+    * If Windows 3.1 support is absolutely not needed, Greenstone can be compiled with VC6:
+          o (Errors compiling httpreq.c are due to VC++ -> use a different version, eg. 12.00.8804) 
+
+ C:\Program Files\Microsoft Visual Studio\VC98\Bin\VCVARS32.BAT
+ nmake /f win32.mak 
+ nmake /f win32.mak LOCAL_LIBRARY=1
+
+    * Otherwise, compile Greenstone with VC4 (using the STLPort package): 
+
+ C:\MSDEV\bin\VCVARS32.BAT
+ nmake /f win32.mak GSDL_VC4=1
+ nmake /f win32.mak GSDL_VC4=1 LOCAL_LIBRARY=1 
+
+    * Move server.exe, cgi-bin\library.exe and cgi-bin\oaiserver.exe to bin\windows
+    * Copy all files in bin\windows to $GSDLHOME/bin/windows (Linux) 
+
+[edit]
+Building (repeat as often as necessary) -- Linux
+
+    * cvs update -dP, in gsdl directory (retrieve any new changes)
+    * Run make (from top level gsdl directory)
+    * In packages/wget/wget-1.9/src, delete wget, run make, rerun gcc command with -static at end (and ignore the warnings)
+    * Run make install (from top level gsdl directory)
+    * In cgi-bin, run library to check for segfaults, then copy it and oaiserver into ../bin/linux
+    * Check all executables are statically-linked: ldd bin/linux/* (ignore mgquery_old)
+    * Strip all executables: strip bin/linux/* 
+
+
+    * GLI will be compiled by create_distributions.pl (it runs makegli.sh). But you need to make sure that it compiles with Java 1.5. If you do this in your release version, run clean.sh afterwards. 
+
+
+    * In the gsdl directory, run 'source setup.bash' if it hasn't already been run.
+    * In the dist directory, remove any existing folders
+    * Run /home/nzdl/for-distributions/bin/script/create_distributions.pl -version_num x.xx -output_dir `pwd` -no_cols
+          o Before running this the first time, make sure you have done the Mac and Windows building at least once.
+          o IMPORTANT: if you are generating a UNESCO CDROM release, use the -unesco option. This uses modified languages.xml, main.cfg, demo collect.cfg with only 4 languages
+          o You can use the -NoChangeLog option while testing so the changelog is not generated each time.
+          o This checks out greenstone into /tmp/gsdl and copies it over to ...dist. If you kill the process before it has been copied, you'll need to delete this directory, otherwise it will have a hissy fit next time.
+          o NOTE: if you need to remake the installer with a couple of modified files, but not with all the source as it currently is:
+                + Change the tag on the modified files: cvs tag -F tagname
+                + Edit create_distributions.pl: want to export from the tag, not from 1 second ago. (x2, gsdl and gli) 
+    * Check no distribution contains non-core language interfaces (macrofiles, images) 
+
+[edit]
+Web release
+[edit]
+Linux and MacOSx web distributions
+
+    * Run Installshield X, open Greenstone Digital Library Software.uip
+          o Media -> Releases: select Linux Web Distribution and Build
+          o Media -> Releases: select Mac OS X Web Distribution and Build 
+    * Close Installshield X 
+
+    * Run finish-linux.sh linux-web (in <installer-dir>/gsdl)
+    * Rename linux-web/disk1 folder to linux-web/gsdl-x.xx-unix
+    * Tar and gzip the gsdl-x.xx-unix folder as gsdl-x.xx-unix.tar.gz (tar czvf gsdl-x.xx-unix.tar.gz gsdl-x.xx-unix/) 
+
+    * Run finish-macOSx.sh macOSx-web
+    * Rename macOSx-web/disk1 folder to macOSx-web/gsdl-x.xx-macOSx
+    * Tar and gzip the gsdl-x.xx-macOSx folder as gsdl-x.xx-macOSx.tar.gz 
+
+[edit]
+Windows web distribution
+
+    * Edit Greenstone Digital Library Software.uip, replace all "storedAs">1< with "storedAs">0< (in emacs, Alt-X query-replace, then ! for all)
+    * Run Installshield X, open Greenstone Digital Library Software.uip
+          o Media -> Releases: select Windows Web Distribution and Build 
+    * Close Installshield X
+    * Restore old Greenstone Digital Library Software.uip file
+    * Rename the windows-web/disk1/setupwin32.exe file to gsdl-x.xx-win32.exe 
+
+[edit]
+Source distribution
+
+    * In the dist directory, tar and gzip the gsdl-x.xx-src directory as gsdl-x.xx-src.tar.gz 
+
+[edit]
+CD-ROM release
+[edit]
+Linux and Windows CD-ROM distributions
+
+    * Run Installshield X, open Greenstone Digital Library Software.uip
+          o Media -> Releases: select Linux CD-ROM Distribution and Build
+          o Media -> Releases: select Windows CD-ROM Distribution and Build 
+    * Close Installshield X
+    * Run finish-windows.sh windows-cd
+    * Run merge-cds.pl
+    * Run finish-linux.sh merged-cd
+    * Zip up contents of merged-cd/disk1 directory, copy to Windows, then write to CD-ROM
+          o Don't forget any extra files for the CD (cd-files)
+                + which are for tutorial versions, which for all versions?? 
+
+packages/ImageMagick-5.5.7-16.tar.gz  
+         ImageMagick-5.5.7-Q8-windows-dll.exe  
+         j2re-1_4_2_07-linux-i586.bin     
+         j2re-1_4_2_07-windows-i586-p.exe
+extras/ ??
+Greenstone Language pack/glp-x.xx-linux.bin  
+                         glp-x.xx-win32.exe
+tutorial/sample_files 
+         Greenstone tutorial exercises.pdf
+workshop_1day_jun2004
+workshop_4day_sep2005 
+workshop_files
+
+
+[edit]
+All
+
+    * Test ad nauseum!
+    * On windows, install into somewhere with spaces in the path 
+
+[edit]
+Finalisation (do once) -- CD-ROM Release
+
+    * Write data to CD
+          o Use Sonic RecordNow DX, but don't use the Wizard. Click the Data icon at the top.
+          o Under Options, for CD:
+                + Recording type select "Disc At Once (Closed)" - this finalises the CD.
+                + Make sure CD-ROMs are created as Joliet CD-ROMs (this should be the default) 
+          o Set the volume label for the CD: GSDL x.xx ???
+          o Add in any extra stuff required (cd-files folder) 
+
+[edit]
+UNESCO CDs
+
+    * To make an ISO image: ensure CD is finalized when written (see above)
+          o On Linux: put the cd in the drive, then run "dd if=/dev/cdrom of=cd.iso"
+          o Rename cd.iso to whatever is appropriate:
+                + unesco-greenstone-cd-2006.iso 
+          o Zip up the iso image and upload to gsdl@sadl.uleth.ca:/var/ftp/pub/unesco 
+
+    * Downloading instructions for unesco: 
+
+   FTP site: sadl.uleth.ca
+   Username: anonymous
+   Password: your e-mail address
+   Filename: pub/unesco/unesco-greenstone-cd-2006.iso.zip
+
+[edit]
+Finalisation (do once) -- Web Release
+
+    * Upload binaries and ChangeLog to sourceforges ftp site:
+          o ftp username is "anonymous", password is your e-mail address
+          o rename the ChangeLog created by create_distributions (dist/gsdl-x.xx-src/gsdl/ChangeLog) to gsdl-x.xx-ChangeLog.txt 
+
+ ftp upload.sourceforge.net
+ ftp> cd incoming
+ ftp> bin
+ ftp> put gsdl-x.xx-unix.tar.gz
+ ftp> put gsdl-x.xx-win32.exe
+ ftp> put gsdl-x.xx-macOSx.tar.gz
+ ftp> put gsdl-x.xx-src.tar.gz
+ ftp> put gsdl-x.xx-ChangeLog.txt
+
+    * Add releases to sourceforge:
+          o login, go to the Greenstone project (http://sourceforge.net/projects/greenstone), select Admin, select File Releases
+          o Click on add releases for the appropriate one.
+          o Release name is the version number e.g. 2.60. For unstable releases, add (Beta), eg 2.61 (Beta)
+          o Type in release notes (or upload release notes file), check 'preserve preformat', and click Submit
+          o Select files from ones you have uploaded, and add
+          o Set file attributes (check previous release for values), and click update
+          o Notify all watchers
+          o Hide old releases unless doing an unstable release
+                + Edit Release, set the status to Hidden, and Submit. 
+          o The ChangeLog goes as a file into the Source release. Don't add as change notes. 
+    * Update http://www.greenstone.org:
+          o Add a new item to home.dm
+          o change the download paths in base.dm 
+    * E-mail mailing lists with release notice (greenstone-users and greenstone-devel)
+          o Skim the ChangeLog to find the important changes.
+          o Send the message to each mailing list separately, that way when people reply, it won't go to both lists. 
+    * Take the updated DistDates file and commit it back into /home/nzdl/for-distributions
+    * Tag the repository - in the gsdl directory, run 
+
+ cvs tag -F gsdl-x_xx-distribution
+
+    * If you have made changes to the Installshield project, copy the <installer-dir>/gsdl directory back to /home/nzdl/for-distributions/installers/gsdl 
+
+
+    * Advertise (say GNU/Linux instead of Linux!):
+          o Open Source for Libraries: http://www.oss4lib.org - post a message
+          o FreshMeat: http://freshmeat.net - log in and add a release 
+
+[edit]
+Export to CD-ROM package
+
+    * Create a new directory in your release directory, e.g. export
+    * Copy the following files/directories from the gsdl/bin/windows directory into export: 
+
+Win32s net16 net32 Setup.exe gssetup.exe server.exe
+
+    * Copy /home/nzdl/for-distributions/export-README.txt to export/README.txt
+    * Edit the README.txt file (change the distribution number)
+    * Zip up the contents of the export directory (only the contents, don't include the export directory): 
+
+cd export
+zip -r gsdl-x.xx-export.zip *
+
+    * Upload to sourceforge like the greenstone ones. 
+
+[edit]
+Greenstone Language Pack (old, no longer needed)
+
+    * Checkout a fresh copy of the latest release version of greenstone, and add the non-core-images: 
+
+ cvs co -r gsdl-x_xx-distribution gsdl
+ cd gsdl/images
+ cvs co gsdl-non-core-images
+
+    * Edit /home/nzdl/installshieldX/alias.properties
+          o Set GLP_SOURCE to the gsdl directory from above 
+    * Copy the glp installer project from /home/nzdl/for-distributions/installers/glp to your previous installers directory
+    * Edit the <installer-dir>/glp/Greenstone Language Pack.uip file and change any absolute paths as needed 
+
+
+    * Run InstallShield X (/home/nzdl/installshieldX/InstallShieldUniversal)
+    * Using "open existing project", open <installer-dir>/glp/Greenstone Language Pack.uip
+    * Edit version numbers in Installation Information -> General Information: Name and Version properties
+    * Edit version numbers in Media -> Releases -> Default -> Distributions -> Linux/Mac/Windows distributions -> File Name
+    * If new languages have been added since the last release, need to update the installer.
+          o Check the gsdl ChangeLog to see whether new languages were added.
+          o Organisation -> Installation Design: add the new interface 
+    * Media -> Releases: select the default build configuration, and Build 
+
+    * The releases are output in <installer-dir>/glp/default/disk1 
+
+    * Upload to sourceforge
+    * email the mailing list
+    * add a new item to greenstone.org and update download link 
+
+
+[edit]
+Greenstone Classic Interface Pack
+
+    * do we need to do that after 2.63?? Will the images have changed?? 
+
+cvs export gsdl-non-core-images-repository
+cd gsdl-non-core-images-repository
+zip -r gcip-x.xx.zip *
+
+    * upload the zip file to sourceforge, and add a new release to the classic interface package 
+
+[edit]
+Tutorial Exercises
+
+    * When these change, need to create a new release of them 
+
+cvs co gsdl-tutorials
+cd gsdl-tutorials
+
+    * edit the xsl files, and set mode to cd 
+
+./generate_html.sh
+cd ../
+zip -r gsdl-tutorial-exercises-monYEAR.zip gsdl-tutorials/tutorial_files gsdl-tutorials/en gsdl-tutorials/fr gsdl-tutorials/es gsdl-tutorials/ru gsdl-tutorials/index.html
+
+    * if the sample files have changed, make a new release of those.
+          o all folders except beatles go into gsdl-tutorial-sample-files-monYEAR.zip
+          o beatles folder goes into gsdl-tutorial-multimedia-files-monYEAR.zip 
+
+    * On sourceforge, the release name is Month Year, eg "March 2006" 
+
+    * If you want to regenerate the version on the wiki, see this page 
+
+[edit]
+Notes
+
+    * Linux installer (others too?) doesn't like being run from a path with spaces in it. But its OK installing greenstone into a path with spaces.
+          o You get errors like: 
+
+(Feb 15, 2006 11:36:15 AM), Install, com.installshield.product.actions.Files, err, java.io.IOException: 
+File does not  exist: /home/kjdon/istemp22540046113422/COPYING
+STACK_TRACE: 20
+java.io.IOException: File does not exist: /home/kjdon/istemp22540046113422/COPYING
+       at com.installshield.archive.ISMPFileURLStreamHandler.openConnection(Unknown Source)
+       at java.net.URL.openConnection(URL.java:896)
+       at java.net.URL.openStream(URL.java:913)
+       at com.installshield.wizard.service.AbstractWizardServices.getSpannedResource(Unknown Source)
+       at com.installshield.wizard.service.AbstractWizardServices.getSpannedResource(Unknown Source)
+       at com.installshield.wizard.service.AbstractWizardServices.getExternalResource(Unknown Source)
+       at com.installshield.product.ProductAction.getExternalResource(Unknown Source)
+       at com.installshield.product.actions.Files.getResourceInputStream(Unknown Source)
+       at com.installshield.product.actions.Files.install(Unknown Source)
+       at com.installshield.product.service.product.PureJavaProductServiceImpl.installProductAction(Unknown Source)
+       at com.installshield.product.service.product.PureJavaProductServiceImpl$InstallProduct.
+            getResultForProductAction(Unknown Source)
+       at com.installshield.product.service.product.InstallableObjectVisitor.visitComponent(Unknown Source)
+       at com.installshield.product.service.product.InstallableObjectVisitor.visitInstallableComponents(Unknown Source)
+       at com.installshield.product.service.product.InstallableObjectVisitor.visitProductBeans(Unknown Source)
+       at com.installshield.product.service.product.PureJavaProductServiceImpl$InstallProduct.install(Unknown Source)
+       at com.installshield.product.service.product.PureJavaProductServiceImpl$Installer.execute(Unknown Source)
+       at com.installshield.wizard.service.AsynchronousOperation.run(Unknown Source)
+       at java.lang.Thread.run(Thread.java:534)
Index: /for-distributions/trunk/etc/main.cfg
===================================================================
--- /for-distributions/trunk/etc/main.cfg	(revision 14265)
+++ /for-distributions/trunk/etc/main.cfg	(revision 14265)
@@ -0,0 +1,255 @@
+# This file must be utf-8 encoded
+#
+# This is the main configuration file for configuring
+# your Greenstone receptionist (the bit responsible for the way
+# things are displayed) and contains information common
+# to the interface of all collections served by the site.
+
+# Email address of the webmaster of this Greenstone installation
+# If maintainer is set to "NULL" EmailEvents and EmailUserEvents
+# will be disabled.
+maintainer      NULL
+
+# Outgoing (SMTP) mail server for this Greenstone installation.
+# This will default to mail.maintainer-domain if it's not set
+# (i.e. if maintainer is greenstone@cs.waikato.ac.nz then MailServer
+# will default to mail.cs.waikato.ac.nz). If MailServer doesn't
+# resolve to a valid SMTP server then the EmailEvents and
+# EmailUserEvents options (see below) won't be functional. Likewise,
+# turning off EmailEvents and EmailUserEvents will remove any 
+# reliance on MailServer.
+MailServer      NULL
+
+# Set status to "enabled" if you want the Maintenance and
+# Administration facility to be available.
+status          disabled
+
+# Set collector to "disabled" if you don't want the "collector"
+# end-user collection building facility to be available.
+collector       disabled
+
+# Set gliapplet to "disabled" if you don't want the remote users
+# to be able to build collections on your server through an applet
+# version of GLI
+gliapplet       disabled
+
+# Set logcgiargs to true to keep a log of usage information in
+# $GSDLHOME/etc/usage.txt.
+logcgiargs      false
+
+# Set usecookies to true to use cookies to identify users (cookie 
+# information will be written to the usage log if logcgiargs is
+# true).
+usecookies      false
+
+# LogDateFormat sets the format that timestamps will be stored in the usage
+# log (i.e. if logcgiargs is enabled). It takes the following values:
+# LocalTime: (the default) The local time and date in the form 
+#            "Thu Dec 07 23:47:00 NZDT 2000".
+# UTCTime: Coordinated universal time (GMT) in the same format as LocalTime.
+# Absolute: Integer value representing the number of seconds since 
+#           00:00:00 1/1/1970 GMT
+LogDateFormat   LocalTime
+
+# Log any events that Greenstone deems important in 
+# $GSDLHOME/etc/events.txt. 
+# The only events that are currently implemented come from the 
+# collector (e.g. someone just built/deleted the following collection)
+# LogEvents may take values of:
+# AllEvents: All important events
+# CollectorEvents: Just those events originating from the collector
+#                  (e.g. someone just built a collection)
+# disabled: Don't log events
+LogEvents       disabled
+
+# Email the maintainer whenever any event occurs. EmailEvents
+# takes the same values as LogEvents.
+# Note that perl must be installed for EmailEvents or
+# EmailUserEvents to work.
+EmailEvents     disabled
+
+# In some cases it may be appropriate to email the user about a
+# certain event (e.g. notification from the collector that a collection
+# was built successfully)
+EmailUserEvents false
+
+
+# The list of display macro files used by this receptionist
+macrofiles      tip.dm style.dm base.dm query.dm help.dm pref.dm about.dm \
+                document.dm browse.dm status.dm authen.dm users.dm html.dm \
+                extlink.dm gsdl.dm extra.dm home.dm collect.dm docs.dm \
+		bsummary.dm gti.dm gli.dm nav_css.dm \
+		english.dm english2.dm french.dm french2.dm spanish.dm \
+		spanish2.dm russian.dm russian2.dm 
+#		hebrew.dm czech.dm czech2.dm galician.dm galician2.dm \
+#		indo.dm indo2.dm japanese.dm japanese2.dm thai.dm thai2.dm \
+#		kazakh.dm kazakh2.dm port-br.dm port-pt.dm \
+#		chinese.dm german.dm maori.dm arabic.dm dutch.dm  \
+#                italian.dm italian2.dm turkish.dm turkish2.dm \
+#		ukrainian.dm croatian.dm hindi.dm kannada.dm finnish.dm \
+#		greek.dm armenian.dm  farsi.dm serbian.dm georgian.dm \
+#		georgian2.dm catalan.dm catalan2.dm latvian.dm latvian2.dm \
+#		vietnamese.dm vietnamese2.dm chinese-trad.dm chinese-trad2.dm \
+#		mongolian.dm mongolian2.dm kirghiz.dm bengali.dm polish.dm gaelic.dm
+
+# Define the interface languages and encodings supported by this receptionist
+
+# An "Encoding" line defines an encoding to be used by the receptionist.
+# Uncomment "Encoding" lines to include an encoding on your "preferences" page.
+# Encoding line options are:
+# shortname -- The standard charset label for the given encoding. The
+#              shortname option is mandatory.
+# longname  -- The display name of the given encoding. If longname isn't set
+#              it will default to using shortname instead.
+# map       -- The name of the map file (i.e. the .ump file) for use when
+#              converting between unicode and the given encoding. The map
+#              option is mandatory for all encoding lines except the
+#              special case for utf8.
+# multibyte -- This optional argument should be set for all encodings that use
+#              multibyte characters.
+
+# The utf8 encoding is handled internally and doesn't require a map file.
+# As a rule the utf8 encoding should always be enabled, especially if you
+# have collections of documents that may not all be in the same
+# language/encoding.
+Encoding shortname=utf-8 "longname=Unicode (UTF-8)"
+
+# This is very experimental, and you almost certainly don't need it
+#Encoding shortname=utf-16be "longname=Unicode (UTF-16BE)"
+
+# The ISO-8859 series
+Encoding shortname=iso-8859-1 "longname=Western (ISO-8859-1)" map=8859_1.ump
+#Encoding shortname=iso-8859-2 "longname=Central European (ISO-8859-2)" map=8859_2.ump
+#Encoding shortname=iso-8859-3 "longname=Latin 3 (ISO-8859-3)" map=8859_3.ump
+#Encoding shortname=iso-8859-4 "longname=Latin 4 (ISO-8859-4)" map=8859_4.ump
+#Encoding shortname=iso-8859-5 "longname=Cyrillic (ISO-8859-5)" map=8859_5.ump
+#Encoding shortname=iso-8859-6 "longname=Arabic (ISO-8859-6)" map=8859_6.ump
+#Encoding shortname=iso-8859-7 "longname=Greek (ISO-8859-7)" map=8859_7.ump
+#Encoding shortname=iso-8859-8 "longname=Hebrew (ISO-8859-8)" map=8859_8.ump
+#Encoding shortname=iso-8859-9 "longname=Turkish (ISO-8859-9)" map=8859_9.ump
+#Encoding shortname=iso-8859-15 "longname=Western (ISO-8859-15)" map=8859_15.ump
+
+# Windows codepages
+Encoding shortname=windows-1250 "longname=Central European (Windows-1250)" map=win1250.ump
+Encoding shortname=windows-1251 "longname=Cyrillic (Windows-1251)" map=win1251.ump
+#Encoding shortname=windows-1252 "longname=Western (Windows-1252)" map=win1252.ump
+Encoding shortname=windows-1253 "longname=Greek (Windows-1253)" map=win1253.ump
+Encoding shortname=windows-1254 "longname=Turkish (Windows-1254)" map=win1254.ump
+Encoding shortname=windows-1255 "longname=Hebrew (Windows-1255)" map=win1255.ump
+Encoding shortname=windows-1256 "longname=Arabic (Windows-1256)" map=win1256.ump
+#Encoding shortname=windows-1257 "longname=Baltic (Windows-1257)" map=win1257.ump
+#Encoding shortname=windows-1258 "longname=Vietnamese (Windows-1258)" map=win1258.ump
+#Encoding shortname=windows-874 "longname=Thai (Windows-874)" map=win874.ump
+#Encoding shortname=cp866 "longname=Cyrillic (DOS)" map=dos866.ump
+#Encoding shortname=cp850 "longname=Latin-1 (DOS)" map=dos850.ump
+
+# KOI8 Cyrillic encodings
+#Encoding shortname=koi8-r "longname=Cyrillic (KOI8-R)" map=koi8_r.ump
+#Encoding shortname=koi8-u "longname=Cyrillic (KOI8-U)" map=koi8_u.ump
+
+# CJK encodings (note that Shift-JIS Japanese isn't currently supported)
+Encoding shortname=gbk "longname=æ±è¯­ (Chinese Simplified GBK)" map=gbk.ump multibyte
+Encoding shortname=big5 "longname=æŒ¢èª (Chinese Traditional Big5)" map=big5.ump multibyte
+Encoding shortname=euc-jp "longname=Japanese (EUC)" map=euc_jp.ump multibyte
+Encoding shortname=euc-kr "longname=Korean (UHC)" map=uhc.ump multibyte
+
+
+# A "Language" line defines an interface language to be used by the
+# interface. Note that it is possible to display only a subset of the
+# specified languages on the preferences page for a given collection by
+# using the "PreferenceLanguages" format option in your collect.cfg
+# configuration file.
+# Arguments are:
+# shortname        -- ISO 639 two letter language symbol. The shortname
+#                     argument is mandatory.
+# longname         -- The display name for the given language. If longname
+#                     isn't set it will default to using shortname instead.
+# default_encoding -- The encoding to use by default when using the given
+#                     interface language. This should be set to the
+#                     "shortname" of a valid "Encoding" line
+#Language shortname=ar longname=Arabic default_encoding=windows-1256
+#Language shortname=bn "longname=àŠ¬àŠŸàŠàŠ²àŠŸ (Bengali)" default_encoding=utf-8
+#Language shortname=ca "longname=CatalÃ  (Catalan)" default_encoding=utf-8
+#Language shortname=cs "longname=Äesky (Czech)" default_encoding=utf-8
+#Language shortname=de "longname=Deutsch (German)" default_encoding=utf-8
+#Language shortname=el "longname=ÎÎ»Î»Î·ÎœÎ¹ÎºÎ¬ (Greek)" default_encoding=windows-1253
+Language shortname=en longname=English default_encoding=utf-8
+Language shortname=es "longname=EspaÃ±ol (Spanish)" \
+	 default_encoding=utf-8
+#Language shortname=fa longname=Farsi default_encoding=utf-8
+#Language shortname=fi longname=Finnish default_encoding=utf-8
+Language shortname=fr "longname=FranÃ§ais (French)" \
+	default_encoding=utf-8
+#Language shortname=gd "longname=Gaelic (Scottish)" default_encoding=utf-8
+#Language shortname=gl longname=Galician default_encoding=utf-8
+#Language shortname=he longname=Hebrew default_encoding=windows-1255
+#Language shortname=hi longname=Hindi default_encoding=utf-8
+#Language shortname=hr longname=Croatian default_encoding=windows-1250
+#Language shortname=hy longname=Armenian default_encoding=utf-8
+#Language shortname=id "longname=Bahasa Indonesia (Indonesian)" default_encoding=utf-8
+#Language shortname=it longname=Italiano default_encoding=utf-8
+#Language shortname=ja "longname=æ¥æ¬èª (Japanese)" default_encoding=utf-8
+#Language shortname=ka longname=Georgian default_encoding=utf-8
+#Language shortname=kk "longname=ÒÐ°Ð·Ð°Ò (Kazakh)" default_encoding=utf-8
+#Language shortname=kn longname=Kannada default_encoding=utf-8
+#Language shortname=ky "longname=ÐÑÑÐ³ÑÐ·ÑÐ° (Kirghiz)" default_encoding=utf-8
+#Language shortname=lv longname=Latvian default_encoding=utf-8
+#Language shortname=mi "longname=MÄori" default_encoding=utf-8
+#Language shortname=mn "longname=ÐÐŸÐœÐ³ÐŸÐ» (Mongolian)" default_encoding=utf-8
+#Language shortname=nl "longname=Nederlands (Dutch)" default_encoding=utf-8
+#Language shortname=pl "longname=polski (Polish)" default_encoding=utf-8
+#Language shortname=pt-br "longname=portuguÃªs-BR (Brasil)" \
+#	default_encoding=utf-8
+#Language shortname=pt-pt "longname=portuguÃªs-PT (Portugal)" \
+#	default_encoding=utf-8
+Language shortname=ru "longname=ÑÑÑÑÐºÐžÐ¹ (Russian)" default_encoding=windows-1251
+#Language shortname=sr longname=Serbian default_encoding=utf-8
+#Language shortname=th longname=Thai default_encoding=utf-8
+#Language shortname=tr longname=Turkish default_encoding=windows-1254
+#Language shortname=uk longname=Ukrainian default_encoding=utf-8
+#Language shortname=vi "longname=Tiáº¿ng Viá»t (Vietnamese)" default_encoding=utf-8
+#Language shortname=zh "longname=ç®äœäž­æ (Simplified Chinese)" 	default_encoding=gbk
+#Language shortname=zh-tr "longname=ç¹é«äž­æ (Traditional Chinese)" default_encoding=big5
+
+
+# Define any additional page parameters to be used by the above macro files
+# (the current default page parameters are c (collection) and l (language)
+
+# Define v (version -- text or graphic) page parameter and give it a default
+# value of 0 (0 = text version off)
+pageparam       v 0
+
+# Set the precedence given to the page parameters. This effects which macro 
+# will be selected for display when there are multiple versions of the same 
+# macro with different page parameters.
+# e.g. Given a macroprecedence of "c,v,l" and the following macro definitions:
+# _content_ []
+# _content_ [l=en]
+# _content_ [c=demo]
+# _content_ [v=1]
+# _content_ [l=fr,v=1,c=hdl]
+# If the corresponding cgi arguments were set to l=en&v=1&c=hdl then the
+# _content_[v=1] macro would be selected for display. It would be selected 
+# ahead of the _content_[l=en] macro because "v" has a higher precedence 
+# than "l". The _content_[l=fr,v=1,c=hdl] macro would not be selected 
+# because one of the page parameters is completely wrong ("l").
+macroprecedence c,v,l
+
+
+# Define any additional cgi arguments. Most cgi arguments are built into
+# Greenstone but it's possible to define them here (or set defaults for
+# existing built-in cgi arguments).
+
+# define the "v" cgi argument (to correspond to the "v" page parameter defined
+# above).
+cgiarg          shortname=v longname=version multiplechar=false argdefault=0 \
+                defaultstatus=weak savedarginfo=must
+
+# set a default value for the built-in "a" cgi argument
+cgiarg          shortname=a argdefault=p
+
+# set a default value for the built-in "p" cgi argument
+cgiarg          shortname=p argdefault=home
+
+# set the default encoding to utf-8
+cgiarg          shortname=w argdefault=utf-8
Index: /for-distributions/trunk/export-README.txt
===================================================================
--- /for-distributions/trunk/export-README.txt	(revision 14265)
+++ /for-distributions/trunk/export-README.txt	(revision 14265)
@@ -0,0 +1,12 @@
+gsdl-2.70u-export.zip
+
+This package contains all extra files required to make Greenstone's "Export
+collection to CD/DVD" function work. It should be extracted to the 
+greenstone\bin\windows directory of an existing Greenstone installation.
+
+This package is not platform dependant, but the CD/DVDs created by the 
+export function will only work under Windows.
+
+
+
+
Index: /for-distributions/trunk/gli/classes/xml/languages.xml
===================================================================
--- /for-distributions/trunk/gli/classes/xml/languages.xml	(revision 14265)
+++ /for-distributions/trunk/gli/classes/xml/languages.xml	(revision 14265)
@@ -0,0 +1,159 @@
+<?xml version="1.0" encoding="UTF-8" ?>
+<!DOCTYPE Languages [
+   <!ELEMENT Languages     (Language*)>
+   <!ELEMENT Language      (#PCDATA)>
+   <!-- name: The name of the language -->
+   <!-- code: The two letter language code -->
+   <!-- gs:   Does greenstone include support for this language? -->
+   <!-- gli:  Does gli have a dictionary for this language? -->
+   <!-- mds:  Does any metadata set include support for this language? -->
+   <!ATTLIST Language
+             name          CDATA #REQUIRED
+	     code          CDATA #REQUIRED
+	     gs            CDATA "false"
+	     gli           CDATA "false"
+	     mds           CDATA "false">
+]>
+
+<Languages>
+   <Language name="ABKHAZIAN"           code="AB">IBERO-CAUCASIAN</Language>
+   <Language name="AFAN(OROMO)"         code="OM">HAMITIC</Language>
+   <Language name="AFAR"                code="AA">HAMITIC</Language>
+   <Language name="AFRIKAANS"           code="AF">GERMANIC</Language>
+   <Language name="ALBANIAN"            code="SQ">INDO-EUROPEAN (OTHER)</Language>
+   <Language name="AMHARIC"             code="AM">SEMITIC</Language>
+   <Language name="ARABIC"              code="AR" gs="true">SEMITIC</Language>
+   <Language name="ARMENIAN"            code="HY" gs="true">INDO-EUROPEAN (OTHER)</Language>
+   <Language name="ASSAMESE"            code="AS">INDIAN</Language>
+   <Language name="AYMARA"              code="AY">AMERINDIAN</Language>
+   <Language name="AZERBAIJANI"         code="AZ">TURKIC/ALTAIC</Language>
+   <Language name="BASHKIR"             code="BA">TURKIC/ALTAIC</Language>
+   <Language name="BASQUE"              code="EU">BASQUE</Language>
+   <Language name="BENGALI(BANGLA)"     code="BN">INDIAN</Language>
+   <Language name="BHUTANI"             code="DZ">ASIAN</Language>
+   <Language name="BIHARI"              code="BH">INDIAN</Language>
+   <Language name="BISLAMA"             code="BI">[not given]</Language>
+   <Language name="BRETON"              code="BR">CELTIC</Language>
+   <Language name="BULGARIAN"           code="BG">SLAVIC</Language>
+   <Language name="BURMESE"             code="MY">ASIAN</Language>
+   <Language name="BYELORUSSIAN"        code="BE">SLAVIC</Language>
+   <Language name="CAMBODIAN"           code="KM">ASIAN</Language>
+   <Language name="CATALAN"             code="CA">ROMANCE</Language>
+   <Language name="CHINESE-SIMPLIFIED"  code="CN" gs="true">ASIAN</Language>
+   <Language name="CHINESE-TRADITIONAL" code="ZH" gs="true">ASIAN</Language>
+   <Language name="CORSICAN"            code="CO">ROMANCE</Language>
+   <Language name="CROATIAN"            code="HR" gs="true">SLAVIC</Language>
+   <Language name="CZECH"               code="CS" gs="true">SLAVIC</Language>
+   <Language name="DANISH"              code="DA">GERMANIC</Language>
+   <Language name="DUTCH"               code="NL" gs="true">GERMANIC</Language>
+   <Language name="ENGLISH"             code="EN" gs="true" gli="true" mds="true">GERMANIC</Language>
+   <Language name="ESPERANTO"           code="EO">INTERNATIONAL AUX.</Language>
+   <Language name="ESTONIAN"            code="ET">FINNO-UGRIC</Language>
+   <Language name="FAROESE"             code="FO">GERMANIC</Language>
+   <Language name="FIJI"                code="FJ">OCEANIC/INDONESIAN</Language>
+   <Language name="FINNISH"             code="FI" gs="true">FINNO-UGRIC</Language>
+   <Language name="FRENCH"              code="FR" gs="true" gli="true" mds="true">ROMANCE</Language>
+   <Language name="FRISIAN"             code="FY">GERMANIC</Language>
+   <Language name="GALICIAN"            code="GL" gs="true">ROMANCE</Language>
+   <Language name="GEORGIAN"            code="KA">IBERO-CAUCASIAN</Language>
+   <Language name="GERMAN"              code="DE" gs="true">GERMANIC</Language>
+   <Language name="GREEK"               code="EL" gs="true">LATIN/GREEK</Language>
+   <Language name="GREENLANDIC"         code="KL">ESKIMO</Language>
+   <Language name="GUARANI"             code="GN">AMERINDIAN</Language>
+   <Language name="GUJARATI"            code="GU">INDIAN</Language>
+   <Language name="HAUSA"               code="HA">NEGRO-AFRICAN</Language>
+   <Language name="HEBREW"              code="IW" gs="true">SEMITIC [*Changed back from HE in 2003 by us. Not valid iso639, HE]</Language>
+   <Language name="HINDI"               code="HI" gs="true">INDIAN</Language>
+   <Language name="HUNGARIAN"           code="HU">FINNO-UGRIC</Language>
+   <Language name="ICELANDIC"           code="IS">GERMANIC</Language>
+   <Language name="INDONESIAN"          code="ID" gs="true">OCEANIC/INDONESIAN [*Changed 1989 from original ISO 639:1988, IN]</Language>
+   <Language name="INTERLINGUA"         code="IA">INTERNATIONAL AUX.</Language>
+   <Language name="INTERLINGUE"         code="IE">INTERNATIONAL AUX.</Language>
+   <Language name="INUKTITUT"           code="IU">[        ]</Language>
+   <Language name="INUPIAK"             code="IK">ESKIMO</Language>
+   <Language name="IRISH"               code="GA">CELTIC</Language>
+   <Language name="ITALIAN"             code="IT" gs="true">ROMANCE</Language>
+   <Language name="JAPANESE"            code="JA" gs="true">ASIAN</Language>
+   <Language name="JAVANESE"            code="JV">OCEANIC/INDONESIAN</Language>
+   <Language name="KANNADA"             code="KN" gs="true">DRAVIDIAN</Language>
+   <Language name="KASHMIRI"            code="KS">INDIAN</Language>
+   <Language name="KAZAKH"              code="KZ" gs="true">TURKIC/ALTAIC [*Changed 2003 by us. Not valid iso639, KK]</Language>
+   <Language name="KINYARWANDA"         code="RW">NEGRO-AFRICAN</Language>
+   <Language name="KIRGHIZ"             code="KY">TURKIC/ALTAIC</Language>
+   <Language name="KOREAN"              code="KO">ASIAN</Language>
+   <Language name="KURDISH"             code="KU">IRANIAN</Language>
+   <Language name="KURUNDI"             code="RN">NEGRO-AFRICAN</Language>
+   <Language name="LAOTHIAN"            code="LO">ASIAN</Language>
+   <Language name="LATIN"               code="LA">LATIN/GREEK</Language>
+   <Language name="LATVIAN (LETTISH)"   code="LV" gli="true">BALTIC</Language>
+   <Language name="LINGALA"             code="LN">NEGRO-AFRICAN</Language>
+   <Language name="LITHUANIAN"          code="LT">BALTIC</Language>
+   <Language name="MACEDONIAN"          code="MK">SLAVIC</Language>
+   <Language name="MALAGASY"            code="MG">OCEANIC/INDONESIAN</Language>
+   <Language name="MALAY"               code="MS">OCEANIC/INDONESIAN</Language>
+   <Language name="MALAYALAM"           code="ML">DRAVIDIAN</Language>
+   <Language name="MALTESE"             code="MT">SEMITIC</Language>
+   <Language name="MAORI"               code="MI" gs="true">OCEANIC/INDONESIAN</Language>
+   <Language name="MARATHI"             code="MR">INDIAN</Language>
+   <Language name="MOLDAVIAN"           code="MO">ROMANCE</Language>
+   <Language name="MONGOLIAN"           code="MN">[not given]</Language>
+   <Language name="NAURU"               code="NA">[not given]</Language>
+   <Language name="NEPALI"              code="NE">INDIAN</Language>
+   <Language name="NORWEGIAN"           code="NO">GERMANIC</Language>
+   <Language name="OCCITAN"             code="OC">ROMANCE</Language>
+   <Language name="ORIYA"               code="OR">INDIAN</Language>
+   <Language name="PASHTO(PUSHTO)"      code="PS">IRANIAN</Language>
+   <Language name="PERSIAN(FARSI)"      code="FA">IRANIAN</Language>
+   <Language name="POLISH"              code="PL">SLAVIC</Language>
+   <Language name="PORTUGUESE"          code="PT" gs="true">ROMANCE</Language>
+   <Language name="PUNJABI"             code="PA">INDIAN</Language>
+   <Language name="QUECHUA"             code="QU">AMERINDIAN</Language>
+   <Language name="RHAETO-ROMANCE"      code="RM">ROMANCE</Language>
+   <Language name="ROMANIAN"            code="RO">ROMANCE</Language>
+   <Language name="RUSSIAN"             code="RU" gs="true" gli="true" mds="true">SLAVIC</Language>
+   <Language name="SAMOAN"              code="SM">OCEANIC/INDONESIAN</Language>
+   <Language name="SANGHO"              code="SG">NEGRO-AFRICAN</Language>
+   <Language name="SANSKRIT"            code="SA">INDIAN</Language>
+   <Language name="SCOTS(GAELIC)"       code="GD">CELTIC</Language>
+   <Language name="SERBIAN"             code="SR">SLAVIC</Language>
+   <Language name="SERBO-CROATIAN"      code="SH">SLAVIC</Language>
+   <Language name="SESOTHO"             code="ST">NEGRO-AFRICAN</Language>
+   <Language name="SETSWANA"            code="TN">NEGRO-AFRICAN</Language>
+   <Language name="SHONA"               code="SN">NEGRO-AFRICAN</Language>
+   <Language name="SINDHI"              code="SD">INDIAN</Language>
+   <Language name="SINGHALESE"          code="SI">INDIAN</Language>
+   <Language name="SISWATI"             code="SS">NEGRO-AFRICAN</Language>
+   <Language name="SLOVAK"              code="SK">SLAVIC</Language>
+   <Language name="SLOVENIAN"           code="SL">SLAVIC</Language>
+   <Language name="SOMALI"              code="SO">HAMITIC</Language>
+   <Language name="SPANISH"             code="ES" gs="true" gli="true" mds="true">ROMANCE</Language>
+   <Language name="SUNDANESE"           code="SU">OCEANIC/INDONESIAN</Language>
+   <Language name="SWAHILI"             code="SW">NEGRO-AFRICAN</Language>
+   <Language name="SWEDISH"             code="SV">GERMANIC</Language>
+   <Language name="TAGALOG"             code="TL">OCEANIC/INDONESIAN</Language>
+   <Language name="TAJIK"               code="TG">IRANIAN</Language>
+   <Language name="TAMIL"               code="TA">DRAVIDIAN</Language>
+   <Language name="TATAR"               code="TT">TURKIC/ALTAIC</Language>
+   <Language name="TELUGU"              code="TE">DRAVIDIAN</Language>
+   <Language name="THAI"                code="TH" gs="true">ASIAN</Language>
+   <Language name="TIBETAN"             code="BO">ASIAN</Language>
+   <Language name="TIGRINYA"            code="TI">SEMITIC</Language>
+   <Language name="TONGA"               code="TO">OCEANIC/INDONESIAN</Language>
+   <Language name="TSONGA"              code="TS">NEGRO-AFRICAN</Language>
+   <Language name="TURKISH"             code="TR" gs="true">TURKIC/ALTAIC</Language>
+   <Language name="TURKMEN"             code="TK">TURKIC/ALTAIC</Language>
+   <Language name="TWI"                 code="TW">NEGRO-AFRICAN</Language>
+   <Language name="UIGUR"               code="UG">[       ]</Language>
+   <Language name="UKRAINIAN"           code="UK" gs="true">SLAVIC</Language>
+   <Language name="URDU"                code="UR">INDIAN</Language>
+   <Language name="UZBEK"               code="UZ">TURKIC/ALTAIC</Language>
+   <Language name="VIETNAMESE"          code="VI">ASIAN</Language>
+   <Language name="VOLAPUK"             code="VO">INTERNATIONAL AUX.</Language>
+   <Language name="WELSH"               code="CY">CELTIC</Language>
+   <Language name="WOLOF"               code="WO">NEGRO-AFRICAN</Language>
+   <Language name="XHOSA"               code="XH">NEGRO-AFRICAN</Language>
+   <Language name="YIDDISH"             code="YI">GERMANIC [*Changed 1989 from original ISO 639:1988, JI]</Language>
+   <Language name="YORUBA"              code="YO">NEGRO-AFRICAN</Language>
+   <Language name="ZHUANG"              code="ZA">[       ]</Language>
+   <Language name="ZULU"                code="ZU">NEGRO-AFRICAN</Language>
+</Languages>
Index: /for-distributions/trunk/macros/home.dm
===================================================================
--- /for-distributions/trunk/macros/home.dm	(revision 14265)
+++ /for-distributions/trunk/macros/home.dm	(revision 14265)
@@ -0,0 +1,637 @@
+# this file must be UTF-8 encoded
+
+package home
+
+# set the title of the home page to be "greenstone digital library"
+# in the currently chosen language
+
+_pagetitle_ {_textdescrgreenstone_}
+
+#######################################################################
+# global navigation links
+#######################################################################
+
+# overridden here as we don't want 'home' links on this page
+
+# home:helplink and home:preflink set in nav_css/ns4 macro files
+_globallinks_ {_helplink_ _preflink_}
+
+#######################################################################
+# icons
+#######################################################################
+
+_imagecollection_ {<img src="_httpimg_/gsdlhead.gif" alt="_textdescrgreenstone_">}
+
+#######################################################################
+# http macros 
+#
+# These contain the url without any quotes
+#######################################################################
+
+_httppagegsdl_ {_httppagex_(gsdl)}
+_httppagehomepref_ {_httppagex_(homepref)}
+
+#######################################################################
+# images
+#######################################################################
+
+# Buttons for the pane after the collections and before the text
+
+_button_ {<div class="button"><span class="button"><a href="_1_">_2_</a></span></div>
+}
+
+_imagegli_ {_button_(_httppagegli_,_gli:textgli_)}
+
+_imagecollector_ {_button_(_httppagecollector_,_collector:textcollector_)}
+
+_imagedepositor_ {_button_(_httppagedepositor_,_depositor:textdepositor_)}
+
+_imagetranslator_ {_button_(_httppagetranslator_,_gti:textgti_)}
+
+_imageadmin_ {_button_(_httppagestatus_,_home:textadmin_)}
+
+_imagegogreenstone_ {_button_(_home:httppagegsdl_,_home:textabgs_)}
+
+_imagegodocs_ {_button_(_home:httppagedocs_,_home:textgsdocs_)}
+
+
+#######################################################################
+# page content                     
+#######################################################################
+
+# _homeextra_ is the automatically generated list of collections (in a table)
+_content_ {
+<div id="content">
+<div class="divbar">
+<p class="navbar">
+_textdescrselcol_
+</p>
+</div>
+
+<div class="section">
+_homeextra_
+</div>
+
+<div class="divbar">&nbsp;</div>
+
+<div class="section">
+<p><table>
+_textgogli_
+_textgocollector_
+_textgodepositor_
+_textgotranslator_
+_textgoadmin_
+_textgogreenstone_
+_textgodocs_
+</table>
+</div>
+
+<div class="divbar">&nbsp;</div>
+_collectdec_
+
+<div class="divbar">&nbsp;</div>
+
+<div class="section">
+_textaboutgreenstone_
+</div>
+
+<div class="divbar">&nbsp;</div>
+
+</div>
+}
+
+# the _textgocollector_, _textgotranslator_, and _textgoadmin_ macros 
+# may be overridden to be empty from within the receptionist if the 
+# collector, translator, or admin facilities are disabled
+
+_textgogli_ {
+<tr valign=top>
+<td valign=top>_imagegli_</td>
+<td>_gli:textdescrgli_</td>
+</tr>
+}
+
+_textgocollector_ {
+<tr valign=top>
+<td valign=top>_imagecollector_</td>
+<td>_collector:textdescrcollector_</td>
+</tr>
+}
+
+_textgodepositor_ {
+<tr valign=top>
+<td valign=top>_imagedepositor_</td>
+<td>_depositor:textdescrdepositor_</td>
+</tr>
+}
+
+_textgotranslator_ {
+<tr valign=top>
+<td valign=top>_imagetranslator_</td>
+<td>_gti:textdescrtranslator_</td>
+</tr>
+}
+
+_textgoadmin_ {
+<tr valign=top>
+<td valign=top>_imageadmin_</td>
+<td>_textdescradmin_</td>
+</tr>
+}
+
+_textgogreenstone_ {
+<tr valign=top>
+<td valign=top>_imagegogreenstone_</td>
+<td>_textdescrgogreenstone_</td>
+</tr>
+}
+
+_textgodocs_ {
+<tr valign=top>
+<td valign=top>_imagegodocs_</td>
+<td>_textdescrgodocs_</td>
+</tr>
+}
+
+_documentedexamplecollectionlink_ {<a href="_gwcgi_?a=p&p=about&c=_3_&l=_cgiargl_&w=_cgiargw_"><img border=1 src="_httpimg_/_1_" alt=_2_></a>}
+
+
+_collectdec_ {
+_textdecs_
+<p>
+
+<table width=537 cellpadding=5>
+
+<tr valign="top">
+<td><a name="dls-e">_documentedexamplecollectionlink_(_httpicondls_, "_decdlstitle_", dls-e)</td>
+<td>_decdlsdesc_</td>
+</tr>
+
+<tr valign="top">
+<td><a name="wrdpdf-e">_documentedexamplecollectionlink_(_httpiconwrdpdf_, "_decwrdpdftitle_", wrdpdf-e)</td>
+<td>_decwrdpdfdesc_</td>
+</tr>
+
+<tr valign="top">
+<td><a name="gsarch-e">_documentedexamplecollectionlink_(_httpicongsarch_, "_decgsarchtitle_", gsarch-e)</td>
+<td>_decgsarchdesc_</td>
+</tr>
+
+<tr valign="top">
+<td><a name="cltbib-e">_documentedexamplecollectionlink_(_httpiconcltbib_, "_deccltbibtitle_", cltbib-e&ct=1&qt=1)</td>
+<td>_deccltbibdesc_</td>
+</tr>
+
+<tr valign="top">
+<td><a name="cltext-e">_documentedexamplecollectionlink_(_httpiconcltext_, "_deccltexttitle_", cltext-e&ct=1&qt=1)</td>
+<td>_deccltextdesc_</td>
+</tr>
+
+<tr valign="top">
+<td><a name="MARC-e">_documentedexamplecollectionlink_(_httpiconmarc_, "_decmarctitle_", MARC-e)</td>
+<td>_decmarcdesc_</td>
+</tr>
+
+<tr valign="top">
+<td><a name="oai-e">_documentedexamplecollectionlink_(_httpiconoai_, "_decoaititle_", oai-e)</td>
+<td>_decoaidesc_</td>
+</tr>
+
+<tr valign="top">
+<td><a name="image-e">_documentedexamplecollectionlink_(_httpiconimage_, "_decimagetitle_", image-e)</td>
+<td>_decimagedesc_</td>
+</tr>
+
+
+<tr valign="top">
+<td><a name="pagedimg-e">_documentedexamplecollectionlink_(_httpiconpagedimg_, "_decpagedimgtitle_", pagedimg-e)</td>
+<td>_decpagedimgdesc_</td>
+</tr>
+
+<tr valign="top">
+<td><a name="authen-e">_documentedexamplecollectionlink_(_httpiconauthen_, "_decauthentitle_", authen-e)</td>
+<td>_decauthendesc_</td>
+</tr>
+
+<tr valign="top">
+<td><a name="garish">_documentedexamplecollectionlink_(_httpicongarish_, "_decgarishtitle_", garish)</td>
+<td>_decgarishdesc_</td>
+</tr>
+
+
+<tr valign="top">
+<td><a name="style-e">_documentedexamplecollectionlink_(_httpiconstyle_, "_decstyletitle_", style-e)</td>
+<td>_decstyledesc_</td>
+</tr>
+
+<tr valign="top">
+<td><a name="isis-e">_documentedexamplecollectionlink_(_httpiconisis_, "_decisistitle_", isis-e&ct=1&qt=1)</td>
+<td>_decisisdesc_</td>
+</tr>
+
+
+<tr valign="top">
+<td><a name="dspace-e">_documentedexamplecollectionlink_(_httpicondspace_, "_decdspacetitle_", dspace-e)</td>
+<td>_decdspacedesc_</td>
+</tr>
+
+</table>
+}
+
+
+# -- English strings ----------------
+
+_textdecs_ {
+Greenstone comes with some documented example collections whose "about" page describes how they are constructed.
+}
+
+_httpicondls_ {dls-e.gif}
+_decdlstitle_ { Development Library Subset collection }
+_decdlsdesc_ {
+Like the Greenstone Demo, this is a subset of the HDL -- but much larger.  It contains 25 publications -- books, reports and magazines -- in various areas of human development (the full HDL contains 1,230 publications). It has the same structure as the Greenstone Demo. It's fairly complex, and if you're just starting out you might prefer to look at some other collections first (e.g. <a href="#wrdpdf-e">MSWord and PDF demonstration</a>, the <a href="#gsarch-e">Greenstone Archives</a>, or the <a href="#image-e">simple image collection</a>).
+}
+
+_httpiconwrdpdf_ {wrdpdf-e.gif}
+_decwrdpdftitle_ { MSWord and PDF demonstration }
+_decwrdpdfdesc_ {
+This contains a few documents in PDF, MSWord, RTF, and Postscript formats, demonstrating the ability to build collections from documents in different formats. The collection configuration file is very simple.
+}
+
+_httpicongsarch_ {gsarch-e.gif}
+_decgsarchtitle_ { Greenstone Archives collection }
+_decgsarchdesc_ {
+A collection of email messages from the Greenstone mailing list archives, this uses the Email plugin, which parses files in email formats. The collection configuration file is very simple.
+}
+
+_httpiconcltbib_ {cltbib-e.gif}
+_deccltbibtitle_ { Bibliography collection }
+_deccltbibdesc_ {
+With about 4,000 bibliography entries, this collection incorporates a form-based search interface that allows fielded searching. It is fairly complex.
+}
+
+_httpiconcltext_ {cltext-e.gif}
+_deccltexttitle_ { Bibliography supplement }
+_deccltextdesc_ {
+This tiny collection of 10 bibliography entries illustrates the "supercollection" facility which searches several collections together, seamlessly. It operates together with the <a href="#cltbib-e">bibliography collection</a>, and its configuration file is almost the same.
+}
+
+_httpiconmarc_ {MARC-e.gif}
+_decmarctitle_ { MARC example }
+_decmarcdesc_ {
+Based on some MARC records from the Library of Congress, this is a simple collection (and does not allow form-based searching).
+}
+
+_httpiconoai_ {oai-e.gif}
+_decoaititle_ { OAI demo }
+_decoaidesc_ {
+Using the Open Archive Protocol and the Import-From feature, this retrieves metadata from an archive and builds a collection from the records. In this case they are images, so both the OAI and Image plugins are used.
+}
+
+_httpiconimage_ {image-e.gif}
+_decimagetitle_ { Simple image collection }
+_decimagedesc_ {
+This very basic image collection contains no text and no explicit metadata -- which makes it rather unrealistic. The configuration file is about as simple as you can get.
+}
+
+
+_httpiconpagedimg_ {pagedimg-e.gif}
+_decpagedimgtitle_ { Paged image collection }
+_decpagedimgdesc_ {
+This collection contains some newspapers from the Niupepa Maori Newspaper collection. Each newspaper consists of a series of scanned images and (optionally) the corresponding OCR text. PagedImgPlug is used to group the images into documents, and extended formatting is used to switch between image and text versions of each page.
+}
+
+_httpiconauthen_ {authen-e.gif}
+_decauthentitle_ { Formatting and authentication demo }
+_decauthendesc_ {
+With the same material as the original Greenstone demo collection, this shows off two independent features: non-standard document formatting, and controlled access to the documents via user authentication.
+}
+
+_httpicongarish_ {garish.gif}
+_decgarishtitle_ { Garish version of demo collection }
+_decgarishdesc_ {
+This collection also contains the same material as the Greenstone demo. Its appearance has been altered to show how the pages generated can be set out differently. It relies on a non-standard macro file that is supplied with Greenstone.
+}
+
+
+_httpiconstyle_ {style-e.gif}
+_decstyletitle_ { Cascading style sheets demo collection }
+_decstyledesc_ {
+This collection demonstrates Greenstone's use of Cascading Style Sheets (CSS) for visual formatting in web browsers. (Greenstone uses CSS instead of HTML tables since version 2.63.) On every page, you can change the style-sheet in effect, to modify that page's appearance.
+}
+
+_httpiconisis_ {isis-e.gif}
+_decisistitle_ { CDS/ISIS example }
+_decisisdesc_ {
+This collection is built from a CDS/ISIS database of about 150 bibliography entries. It uses the ISISPlug plugin, which reads the standard ISIS .mst and .fdt files and converts them to Greenstone metadata.
+}
+
+
+_httpicondspace_ {dspace-e.gif}
+_decdspacetitle_ { DSpace example }
+_decdspacedesc_ {
+This collection is based on records exported from a DSpace institutional repository.
+}
+
+# -- French strings ----------------
+
+_textdecs_ [l=fr] {
+Greenstone vient avec quelques exemples de collections documentÃ©es dont la page "a propos" dÃ©crit comment elles sont construites.
+}
+
+_httpicondls_ [l=fr] {fr/dls-e.gif}
+_decdlstitle_ [l=fr] { Sous-ensemble de la collection BibliothÃšque de DÃ©veloppement }
+_decdlsdesc_ [l=fr] {
+A l'instar de "Greenstone Demo", c'est une composante de HDL, mais plus grande. Elle contient 25 livres de publications, rapports et magazines dans divers domaines du dÃ©veloppement humain (la totalitÃ© de HDL contient 1230 publications). Elle a la mÃªme structure que "Greenstone Demo". Elle est assez complexe et si on est tout juste dÃ©butant, il serait peut-Ãªtre prÃ©fÃ©rable de consulter d'abord d'autres collections (Exemple: <a href="#wrdpdf-e">dÃ©monstration MS Word et PDF</a>, les <a href="#gsarch-e">archives Greenstone</a>, ou la <a href="#image-e">collection "simple image"</a>).
+}
+
+_httpiconwrdpdf_ [l=fr] {fr/wrdpdf-e.gif}
+_decwrdpdftitle_ [l=fr] { DÃ©monstration MSWord et PDF }
+_decwrdpdfdesc_ [l=fr] {
+Elle contient des documents en PDF, MS Word, RTF, et des formats Postscript, qui attestent de la possibilitÃ© de former des collections Ã  partir de documents de diffÃ©rents formats. Le fichier de configuration de la collection est trÃšs simple.
+}
+
+_httpicongsarch_ [l=fr] {fr/gsarch-e.gif}
+_decgsarchtitle_ [l=fr] { Collection des Archives de Greenstone }
+_decgsarchdesc_ [l=fr] {
+Une collection de messages e-mail Ã  partir des archives de listes d'adresses de Greenstone, elle utilise le plugin e-mail qui analyse les fichiers en formats e-mail. Le fichier de configuration de la collection est trÃšs simple.
+}
+
+_httpiconcltbib_ [l=fr] {fr/cltbib-e.gif}
+_deccltbibtitle_ [l=fr] { Collection bibliographie }
+_deccltbibdesc_ [l=fr] {
+Avec environ 4000 entrÃ©es bibliographiques, cette collection incorpore une interface de recherche basÃ©e sur un formulaire qui permet une recherche par champ. Elle est assez complexe.
+}
+
+_httpiconcltext_ [l=fr] {fr/cltext-e.gif}
+_deccltexttitle_ [l=fr] { SupplÃ©ment bibliographie }
+_deccltextdesc_ [l=fr] {
+Cette petite collection de 10 entrÃ©es bibliographiques illustre la fonction "supercollection" qui recherche plusieurs collections Ã  la fois. Elle fonctionne avec la <a href="#cltbib-e">collection bibliographie</a> et son fichier de configuration est presque le mÃªme.
+}
+
+_httpiconmarc_ [l=fr] {fr/MARC-e.gif}
+_decmarctitle_ [l=fr] { Exemple MARC }
+_decmarcdesc_ [l=fr] {
+BasÃ© sur quelques enregistrements Marc de la Librairie du CongrÃšs, c'est est une collection simple (et ne permet pas une recherche basÃ©e sur formulaire).
+}
+
+_httpiconoai_ [l=fr] {fr/oai-e.gif}
+_decoaititle_ [l=fr] { DÃ©mo OAI }
+_decoaidesc_ [l=fr] {
+En utilisant la caractÃ©ristique "Open Archive Protocol" et "Import Form", elle extrait des mÃ©ta-donnÃ©es d'une archive et confectionne une collection Ã  partir des enregistrements. Dans ce cas, ce sont des images; ainsi, aussi bien les plugins OAI que les images sont utilisÃ©s.
+}
+
+_httpiconimage_ [l=fr] {fr/image-e.gif}
+_decimagetitle_ [l=fr] { Collection d'images simple }
+_decimagedesc_ [l=fr] {
+Cette collection d'images simples standard ne contient aucun texte et aucune mÃ©ta-donnÃ©e explicite, ce qui la rend plutÃŽt irrÃ©aliste. Le fichier de configuration est tout aussi simple et accessible.
+}
+
+_httpiconauthen_ [l=fr] {fr/authen-e.gif}
+_decauthentitle_ [l=fr] { DÃ©monstration de formatage et d'authentification }
+_decauthendesc_ [l=fr] {
+Avec le mÃªme matÃ©riel que la collection de dÃ©monstration Greenstone originale, elle affiche deux caractÃ©ristiques indÃ©pendantes: le formatage de document non-standard et l'accÃšs contrÃŽlÃ© aux documents par le biais d'une authentification de l'utilisateur.
+}
+
+_httpicongarish_ [l=fr] {fr/garish.gif}
+_decgarishtitle_ [l=fr] { Version Garish de la collection de dÃ©monstration }
+_decgarishdesc_ [l=fr] {
+Cette collection contient aussi le mÃªme matÃ©riel que la collection de dÃ©monstration Greenstone. Sa prÃ©sentation a Ã©tÃ© altÃ©rÃ©e pour montrer comment les pages gÃ©nÃ©rÃ©es peuvent Ãªtre affichÃ©es diffÃ©remment. Elle dÃ©pend d'un fichier macro non standard qui est fourni avec Greenstone.
+}
+
+_httpiconisis_ [l=fr] {fr/isis-e.gif}
+_decisistitle_ [l=fr] { Exemple CDS/ISIS }
+_decisisdesc_ [l=fr] {
+Cette collection est construite a partir des donnÃ©es CDS/ISIS de quelques 150 entrÃ©es bibliographiques. Elle utilize le plugin ISISPlug, qui lit les fichiers standards ISIS .mst et .fdt et les convertit en metadonnÃ©es de Greenstone.
+}
+
+
+_httpicondspace_ [l=fr] {fr/dspace-e.gif}
+_decdspacetitle_ [l=fr] { Exemple DSpace }
+_decdspacedesc_ [l=fr] {
+Cette collection est basÃ©e en donnÃ©e exportÃ©es d' un dÃ©pÃŽt institutionnel DSpace.
+}
+
+# -- Spanish strings ----------------
+_textdecs_ [l=es] {
+Greenstone viene con algunas colecciones de muestra documentadas, cuya pÃ¡gina "acerca de" describe la forma en que se construyeron.
+}
+
+_httpicondls_ [l=es] {es/dls-e.gif}
+_decdlstitle_ [l=es] { Subconjunto de la Biblioteca para el Desarrollo }
+_decdlsdesc_ [l=es] {
+Al igual que la ColecciÃ³n de muestra Greenstone, Ã©sta es un subconjunto de la Biblioteca para el Desarrollo Humano, sÃ³lo que mucho mayor. Contiene 25 publicaciones entre libros, informes y revistas relacionadas con diferentes Ã¡reas del saber humano (la HDL contiene un total de 1,230 publicaciones). Tiene la misma estructura que la ColecciÃ³n de muestra Greenstone y es bastante compleja, por lo que si apenas estÃ¡ empezando a familiarizarse con su uso quizÃ¡ sea mejor que se fije primero en alguna otra (p. ej. la <a href="#wrdpdf-e">demostraciÃ³n en MSWord y PDF</a>, los <a href="#gsarch-e">Archivos Greenstone</a> o la <a href="#image-e">colecciÃ³n de ImÃ¡genes Sencillas</a>).
+}
+
+_httpiconwrdpdf_ [l=es] {es/wrdpdf-e.gif}
+_decwrdpdftitle_ [l=es] { DemostraciÃ³n en MSWord y PDF }
+_decwrdpdfdesc_ [l=es] {
+Esta colecciÃ³n contiene unos cuantos documentos en formatos PDF, MSWord, RTF y PostScript, y muestra la capacidad de construir colecciones a partir de diferentes tipos de documentos. El archivo de configuraciÃ³n de la colecciÃ³n es sumamente sencillo.
+}
+
+_httpicongsarch_ [l=es] {es/gsarch-e.gif}
+_decgsarchtitle_ [l=es] { ColecciÃ³n de Archivos Greenstone }
+_decgsarchdesc_ [l=es] {
+Una colecciÃ³n de mensajes de correo electrÃ³nico hecha a partir de los archivos de las listas de correo de Greenstone. Utiliza el plugin Email que descompone y analiza los archivos en formatos de correo electrÃ³nico. El archivo de configuraciÃ³n de la colecciÃ³n es sumamente sencillo.
+}
+
+_httpiconcltbib_ [l=es] {es/cltbib-e.gif}
+_deccltbibtitle_ [l=es] { ColecciÃ³n bibliogrÃ¡fica }
+_deccltbibdesc_ [l=es] {
+Con aproximadamente 4,000 entradas bibliogrÃ¡ficas, esta colecciÃ³n incorpora una interfase de bÃºsqueda basada en formas que permite la bÃºsqueda por campos. Es bastante compleja.
+}
+
+_httpiconcltext_ [l=es] {es/cltext-e.gif}
+_deccltexttitle_ [l=es] { Suplemento bibliogrÃ¡fico }
+_deccltextdesc_ [l=es] {
+Esta pequeÃ±a colecciÃ³n de 10 entradas bibliogrÃ¡ficas ilustra el programa "supercolecciÃ³n" de Greenstone, el cual busca en varias colecciones al mismo tiempo. Opera junto con la <a href="#cltbib-e">colecciÃ³n bibliogrÃ¡fica</a> y su archivo de configuraciÃ³n es casi idÃ©ntico.
+}
+
+_httpiconmarc_ [l=es] {es/MARC-e.gif}
+_decmarctitle_ [l=es] { ColecciÃ³n de muestra MARC }
+_decmarcdesc_ [l=es] {
+Basada en algunos registros MARC de la Biblioteca del Congreso, Ã©sta es una colecciÃ³n sencilla, aunque no permite la bÃºsqueda basada en formas.
+}
+
+_httpiconoai_ [l=es] {es/oai-e.gif}
+_decoaititle_ [l=es] { ColecciÃ³n de muestra OAI }
+_decoaidesc_ [l=es] {
+Por medio del Protocolo de Archivo Abierto y la funciÃ³n Import-From, Ã©sta recupera metadatos de un archivo y construye una colecciÃ³n a partir de los registros. En este caso se trata de imÃ¡genes, por lo que se utilizan tanto el plugin OAI como el plugin ImagePlug.
+}
+
+_httpiconimage_ [l=es] {es/image-e.gif}
+_decimagetitle_ [l=es] { ColecciÃ³n de imÃ¡genes sencillas }
+_decimagedesc_ [l=es] {
+Esta colecciÃ³n de imÃ¡genes es sumamente bÃ¡sica y no contiene texto ni metadatos explÃ­citos, lo que mÃ¡s bien la hace poco prÃ¡ctica. El archivo de configuraciÃ³n es lo mÃ¡s simple que se puede encontrar.
+}
+
+_httpiconauthen_ [l=es] {es/authen-e.gif}
+_decauthentitle_ [l=es] { DemostraciÃ³n de formateo y autenticaciÃ³n }
+_decauthendesc_ [l=es] {
+Con el mismo material que la colecciÃ³n de muestra Greenstone original, Ã©sta muestra dos funciones independientes: el formateo de documentos que no sean estÃ¡ndar y el acceso controlado a los documentos por medio de la autenticaciÃ³n de los usuarios.
+}
+
+_httpicongarish_ [l=es] {es/garish.gif}
+_decgarishtitle_ [l=es] { VersiÃ³n Garish de la colecciÃ³n de muestra }
+_decgarishdesc_ [l=es] {
+Esta colecciÃ³n tambiÃ©n contiene el mismo material que la colecciÃ³n de muestra Greenstone, sÃ³lo que su apariencia ha sido alterada para mostrar la forma en que las pÃ¡ginas generadas pueden configurarse de manera diferente. Se basa en un archivo de macros no estÃ¡ndar que se proporciona junto con Greenstone.
+}
+
+_httpiconisis_ [l=es] {es/isis-e.gif}
+_decisistitle_ [l=es] { ColecciÃ³n de muestra CDS/ISIS }
+_decisisdesc_ [l=es] {
+Esta colecciÃ³n estÃ¡ construida a partir de una base de datos CDS/ISIS de cerca de 150 referencias bibliogrÃ¡ficas. Usa el plugin ISISPlug, el cual lee archivos estÃ¡ndar ISIS (.mst y .fdt) y los convierte a metadatos de Greenstone.
+}
+
+
+_httpicondspace_ [l=es] {es/dspace-e.gif}
+_decdspacetitle_ [l=es] { ColecciÃ³n de muestra DSpace }
+_decdspacedesc_ [l=es] {
+Esta colecciÃ³n estÃ¡ basada en datos exportados de un repositorio institucional DSpace.
+}
+
+# -- Russian strings ----------------
+_textdecs_ [l=ru] {
+Greenstone ÐžÐŽÐµÑ Ñ ÐœÐµÐºÐŸÑÐŸÑÑÐŒÐž Ð·Ð°ÑÐµÐ³ÐžÑÑÑÐžÑÐŸÐ²Ð°ÐœÐœÑÐŒÐž Ð¿ÑÐžÐŒÐµÑÐ°ÐŒÐž ÐºÐŸÐ»Ð»ÐµÐºÑÐžÐ¹, ÐœÐ° ÑÑÑÐ°ÐœÐžÑÐ°Ñ
+ ÐºÐŸÑÐŸÑÑÑ
+ "Ð ÐºÐŸÐ»Ð»ÐµÐºÑÐžÐž" ÐŸÐ¿ÐžÑÑÐ²Ð°ÐµÑÑÑ, ÐºÐ°Ðº ÐŸÐœÐž Ð¿ÐŸÑÑÑÐŸÐµÐœÑ.
+}
+
+_httpicondls_ [l=ru] {ru/dls-e.gif}
+_decdlstitle_ [l=ru] { Ð¡ÑÐ±ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ ÐÐžÐ±Ð»ÐžÐŸÑÐµÐºÐž ÑÐ°Ð·Ð²ÐžÑÐžÑ }
+_decdlsdesc_ [l=ru] {
+ÐÐŸÐŽÐŸÐ±ÐœÐŸ ÐŽÐµÐŒÐŸÐœÑÑÑÐ°ÑÐžÐŸÐœÐœÐŸÐŒÑ Ð¿ÑÐžÐŒÐµÑÑ Greenstone, ÑÑÐŸ - ÑÑÐ±ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ HDL, ÐœÐŸ ÐœÐ°ÐŒÐœÐŸÐ³ÐŸ Ð±ÐŸÐ»ÑÑÐµÐ³ÐŸ ÐŸÐ±ÑÐµÐŒÐ°. ÐÐœÐ° ÑÐŸÐŽÐµÑÐ¶ÐžÑ 25 Ð¿ÑÐ±Ð»ÐžÐºÐ°ÑÐžÐ¹ - ÐºÐœÐžÐ³, ÑÐŸÐŸÐ±ÑÐµÐœÐžÐ¹ Ðž Ð¶ÑÑÐœÐ°Ð»ÐŸÐ² - Ð² ÑÐ°Ð·Ð»ÐžÑÐœÑÑ
+ ÐŸÐ±Ð»Ð°ÑÑÑÑ
+ ÑÐ°Ð·Ð²ÐžÑÐžÑ ÑÐµÐ»ÐŸÐ²ÐµÑÐµÑÑÐ²Ð° (Ð¿ÐŸÐ»ÐœÐ°Ñ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ HDL ÑÐŸÐŽÐµÑÐ¶ÐžÑ 1230 Ð¿ÑÐ±Ð»ÐžÐºÐ°ÑÐžÐ¹). ÐÐœÐ° ÐžÐŒÐµÐµÑ ÑÑ Ð¶Ðµ ÑÐ°ÐŒÑÑ ÑÑÑÑÐºÑÑÑÑ, ÑÑÐŸ Ðž ÐÐµÐŒÐŸÐœÑÑÑÐ°ÑÐžÐŸÐœÐœÐ°Ñ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ Greenstone. ÐÐœÐ° ÐŽÐŸÐ²ÐŸÐ»ÑÐœÐŸ ÑÐ»ÐŸÐ¶ÐœÐ°. ÐÐŸÑÑÐŸÐŒÑ, ÐµÑÐ»Ðž ÐÑ ÑÐŸÐ»ÑÐºÐŸ ÐœÐ°ÑÐžÐœÐ°ÐµÑÐµ ÑÐ°Ð±ÐŸÑÐ°ÑÑ, ÑÐŸ Ð»ÑÑÑÐµ ÐœÐ°ÑÐ°ÑÑ Ñ Ð¿ÑÐŸÑÐŒÐŸÑÑÐ° ÐœÐµÐºÐŸÑÐŸÑÑÑ
+ ÐŽÑÑÐ³ÐžÑ
+ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÐ¹ (ÐœÐ°Ð¿ÑÐžÐŒÐµÑ, ÐŽÐµÐŒÐŸÐœÑÑÑÐ°ÑÐžÐ¹ MSWord, PDF, Ð°ÑÑ
+ÐžÐ²Ð° Greenstone ÐžÐ»Ðž ÐºÐŸÐ»Ð»ÐµÐºÑÐžÐž Ð¿ÑÐŸÑÑÑÑ
+ ÐžÐ·ÐŸÐ±ÑÐ°Ð¶ÐµÐœÐžÐ¹).
+}
+
+_httpiconwrdpdf_ [l=ru] {ru/wrdpdf-e.gif}
+_decwrdpdftitle_ [l=ru] { ÐÐµÐŒÐŸÐœÑÑÑÐ°ÑÐžÑ MSWord Ðž PDF }
+_decwrdpdfdesc_ [l=ru] {
+ÐÐœÐ° ÑÐŸÐŽÐµÑÐ¶ÐžÑ ÐœÐµÑÐºÐŸÐ»ÑÐºÐŸ ÐŽÐŸÐºÑÐŒÐµÐœÑÐŸÐ² Ð² ÑÐŸÑÐŒÐ°ÑÐµ PDF, MSWord, RTF, PostScript, ÐŽÐµÐŒÐŸÐœÑÑÑÐžÑÑÑ Ð²ÐŸÐ·ÐŒÐŸÐ¶ÐœÐŸÑÑÑ Ð¿ÐŸÑÑÑÐŸÐµÐœÐžÑ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÐ¹ ÐžÐ· ÐŽÐŸÐºÑÐŒÐµÐœÑÐŸÐ² Ð² ÑÐ°Ð·Ð»ÐžÑÐœÑÑ
+ ÑÐŸÑÐŒÐ°ÑÐ°Ñ
+. ÐÐŸÐœÑÐžÐ³ÑÑÐ°ÑÐžÐŸÐœÐœÑÐ¹ ÑÐ°Ð¹Ð» ÐºÐŸÐ»Ð»ÐµÐºÑÐžÐž ÐŸÑÐµÐœÑ Ð¿ÑÐŸÑÑ.
+}
+
+_httpicongsarch_ [l=ru] {ru/gsarch-e.gif}
+_decgsarchtitle_ [l=ru] { ÐÐŸÐ»Ð»ÐµÐºÑÐžÑ Ð°ÑÑ
+ÐžÐ²ÐŸÐ² Greenstone }
+_decgsarchdesc_ [l=ru] {
+ÐÐŸÐ»Ð»ÐµÐºÑÐžÑ ÑÐŸÐŸÐ±ÑÐµÐœÐžÐ¹ ÑÐ»ÐµÐºÑÑÐŸÐœÐœÐŸÐ¹ Ð¿ÐŸÑÑÑ ÐžÐ· Ð°ÑÑ
+ÐžÐ²Ð° ÑÐ¿ÐžÑÐºÐŸÐ² Ð°ÐŽÑÐµÑÐ°ÑÐŸÐ² Greenstone, ÐžÑÐ¿ÐŸÐ»ÑÐ·ÑÑÑÐ°Ñ Ð¿Ð»Ð°Ð³ÐžÐœ Email, ÐºÐŸÑÐŸÑÑÐ¹ Ð°ÐœÐ°Ð»ÐžÐ·ÐžÑÑÐµÑ ÑÐ°Ð¹Ð»Ñ Ð² ÑÐŸÑÐŒÐ°ÑÐ°Ñ
+ ÑÐ»ÐµÐºÑÑÐŸÐœÐœÐŸÐ¹ Ð¿ÐŸÑÑÑ. ÐÐŸÐœÑÐžÐ³ÑÑÐ°ÑÐžÐŸÐœÐœÑÐ¹ ÑÐ°Ð¹Ð» ÐºÐŸÐ»Ð»ÐµÐºÑÐžÐž ÐŸÑÐµÐœÑ Ð¿ÑÐŸÑÑ.
+}
+
+_httpiconcltbib_ [l=ru] {ru/cltbib-e.gif}
+_deccltbibtitle_ [l=ru] { ÐÐžÐ±Ð»ÐžÐŸÐ³ÑÐ°ÑÐžÑÐµÑÐºÐ°Ñ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ }
+_deccltbibdesc_ [l=ru] {
+Ð­ÑÐ° ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ Ð²ÐºÐ»ÑÑÐ°ÐµÑ Ð¿ÑÐžÐ±Ð»ÐžÐ·ÐžÑÐµÐ»ÑÐœÐŸ 4000 Ð±ÐžÐ±Ð»ÐžÐŸÐ³ÑÐ°ÑÐžÑÐµÑÐºÐžÑ
+ Ð·Ð°Ð¿ÐžÑÐµÐ¹. ÐÐœÑÐµÑÑÐµÐ¹Ñ Ð¿ÐŸÐžÑÐºÐ° ÑÐŸÐ·ÐŽÐ°Ðœ ÐœÐ° ÐŸÑÐœÐŸÐ²Ðµ Ð±Ð»Ð°ÐœÐºÐ°, ÐºÐŸÑÐŸÑÑÐ¹ Ð¿ÐŸÐ·Ð²ÐŸÐ»ÑÐµÑ Ð¿ÑÐŸÐ²ÐŸÐŽÐžÑÑ Ð¿ÐŸÐžÑÐº Ð¿ÐŸ Ð¿ÐŸÐ»ÑÐŒ Ð·Ð°Ð¿ÐžÑÐž. Ð­ÑÐŸ ÐŽÐŸÐ²ÐŸÐ»ÑÐœÐŸ ÑÐ»ÐŸÐ¶ÐœÑÐ¹ ÐºÐŸÐŒÐ¿Ð»ÐµÐºÑ.
+}
+
+_httpiconcltext_ [l=ru] {ru/cltext-e.gif}
+_deccltexttitle_ [l=ru] { ÐÑÐžÐ»ÐŸÐ¶ÐµÐœÐžÐµ Ð±ÐžÐ±Ð»ÐžÐŸÐ³ÑÐ°ÑÐžÐž }
+_deccltextdesc_ [l=ru] {
+Ð­ÑÐŸ ÐºÑÐŸÑÐµÑÐœÐ°Ñ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ Ñ Ð±ÐžÐ±Ð»ÐžÐŸÐ³ÑÐ°ÑÐžÑÐµÑÐºÐžÐŒÐž Ð·Ð°Ð¿ÐžÑÑÐŒÐž ÐžÐ»Ð»ÑÑÑÑÐžÑÑÐµÑ ÑÑÐµÐŽÑÑÐ²ÐŸ Â«ÑÑÐ¿ÐµÑÐºÐŸÐ»Ð»ÐµÐºÑÐžÐžÂ», ÐºÐŸÑÐŸÑÐŸÐµ Ð¿ÑÐŸÐ²ÐŸÐŽÐžÑ Ð¿ÐŸÐžÑÐº Ð² Ð¿ÐµÑÐµÑÐµÐºÐ°ÑÑÐžÑ
+ÑÑ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑÑ
+. ÐÐœÐ° ÑÐ°Ð±ÐŸÑÐ°ÐµÑ Ð²ÐŒÐµÑÑÐµ Ñ ÐÐžÐ±Ð»ÐžÐŸÐ³ÑÐ°ÑÐžÑÐµÑÐºÐŸÐ¹ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÐµÐ¹. ÐÐµ ÐºÐŸÐœÑÐžÐ³ÑÑÐ°ÑÐžÐŸÐœÐœÑÐ¹ ÑÐ°Ð¹Ð» Ð¿ÐŸÑÑÐž ÑÐ°ÐºÐŸÐ¹ Ð¶Ðµ.
+}
+
+_httpiconmarc_ [l=ru] {ru/MARC-e.gif}
+_decmarctitle_ [l=ru] { ÐÑÐžÐŒÐµÑ MARC }
+_decmarcdesc_ [l=ru] {
+ÐÑÐœÐŸÐ²Ð°ÐœÐœÐ°Ñ ÐœÐ° ÐœÐµÑÐºÐŸÐ»ÑÐºÐžÑ
+ Ð·Ð°Ð¿ÐžÑÑÑ
+ MARC ÐžÐ· ÐÐžÐ±Ð»ÐžÐŸÑÐµÐºÐž ÐÐŸÐœÐ³ÑÐµÑÑÐ°, ÑÑÐŸ Ð¿ÑÐŸÑÑÐ°Ñ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ, ÐœÐµ Ð¿ÐŸÐ·Ð²ÐŸÐ»ÑÑÑÐ°Ñ Ð¿ÑÐŸÐ²ÐµÐŽÐµÐœÐžÐµ Ð¿ÐŸÐžÑÐºÐ° ÐœÐ° ÐŸÑÐœÐŸÐ²Ðµ Ð·Ð°ÐŽÐ°ÐœÐœÐŸÐ¹ ÑÐŸÑÐŒÑ.
+}
+
+_httpiconoai_ [l=ru] {ru/oai-e.gif}
+_decoaititle_ [l=ru] { ÐÐµÐŒÐŸÐœÑÑÑÐ°ÑÐž-ÐŸÐœÐœÐ°Ñ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ OAI }
+_decoaidesc_ [l=ru] {
+ÐÑÐ¿ÐŸÐ»ÑÐ·ÑÑ ÐŸÑÐºÑÑÑÑÐ¹ Ð°ÑÑ
+ÐžÐ²ÐœÑÐ¹ Ð¿ÑÐŸÑÐŸÐºÐŸÐ» Ðž ÑÑÐµÐŽÑÑÐ²Ð° ÐÐŒÐ¿ÐŸÑÑÐ°, ÐŸÐœÐ° Ð²ÐŸÑÑÑÐ°ÐœÐ°Ð²Ð»ÐžÐ²Ð°ÐµÑ ÐŒÐµÑÐ°ÐŽÐ°ÐœÐœÑÐµ ÐžÐ· Ð°ÑÑ
+ÐžÐ²Ð° Ðž ÑÑÑÐŸÐžÑ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ ÐžÐ· Ð·Ð°Ð¿ÐžÑÐµÐ¹. Ð ÐŽÐ°ÐœÐœÐŸÐŒ ÑÐ»ÑÑÐ°Ðµ ÐŸÐœÐž ÑÐ²Ð»ÑÑÑÑÑ ÐžÐ·ÐŸÐ±ÑÐ°Ð¶ÐµÐœÐžÑÐŒÐž, ÑÐ°Ðº ÑÑÐŸ ÐžÑÐ¿ÐŸÐ»ÑÐ·ÑÑÑÑÑ ÐŸÐ±Ð° Ð¿Ð»Ð°Ð³ÐžÐœÐ° OAI Ðž Image.
+}
+
+_httpiconimage_ [l=ru] {ru/image-e.gif}
+_decimagetitle_ [l=ru] { ÐÑÐŸÑÑÐ°Ñ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ ÐžÐ·ÐŸÐ±ÑÐ°Ð¶ÐµÐœÐžÐ¹ }
+_decimagedesc_ [l=ru] {
+Ð­ÑÐŸ ÐŸÑÐµÐœÑ ÐŸÑÐœÐŸÐ²Ð°ÑÐµÐ»ÑÐœÐ°Ñ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ ÐžÐ·ÐŸÐ±ÑÐ°Ð¶ÐµÐœÐžÐ¹ ÐœÐµ ÑÐŸÐŽÐµÑÐ¶ÐžÑ ÐœÐžÐºÐ°ÐºÐŸÐ³ÐŸ ÑÐµÐºÑÑÐ° Ðž ÐœÐžÐºÐ°ÐºÐžÑ
+ ÑÐ²ÐœÑÑ
+ ÐŒÐµÑÐ°ÐŽÐ°ÐœÐœÑÑ
+, ÑÑÐŸ ÐŽÐµÐ»Ð°ÐµÑ ÐµÐµ ÐŽÐŸÐ²ÐŸÐ»ÑÐœÐŸ ÐœÐµÑÐµÐ°Ð»ÐžÑÑÐžÑÐœÐŸÐ¹. ÐÐŸÐœÑÐžÐ³ÑÑÐ°ÑÐžÐŸÐœÐœÑÐ¹ ÑÐ°Ð¹Ð» ÑÐ²Ð»ÑÐµÑÑÑ Ð¿ÑÐŸÑÑÑÐŒ.
+}
+
+_httpiconauthen_ [l=ru] {ru/authen-e.gif}
+_decauthentitle_ [l=ru] { ÐÐµÐŒÐŸÐœÑÑÑÐ°ÑÐžÑ ÑÐŸÑÐŒÐ°ÑÐžÑÐŸÐ²Ð°-ÐœÐžÑ Ðž Ð°ÑÑÐµÐœÑÐžÑÐžÐºÐ°ÑÐžÐž }
+_decauthendesc_ [l=ru] {
+ÐÐ° ÑÐŸÐŒ Ð¶Ðµ ÑÐ°ÐŒÐŸÐŒ ÐŒÐ°ÑÐµÑÐžÐ°Ð»Ðµ, ÑÑÐŸ Ðž Ð¿ÐµÑÐ²ÐŸÐœÐ°ÑÐ°Ð»ÑÐœÐ°Ñ ÐŽÐµÐŒÐŸÐœÑÑÑÐ°ÑÐžÐŸÐœÐœÐ°Ñ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ Greenstone, ÐŸÐœÐ° ÐŸÑÐ»ÐžÑÐ°ÐµÑÑÑ ÐŽÐ²ÑÐŒÑ ÐœÐµÐ·Ð°Ð²ÐžÑÐžÐŒÑÐŒÐž ÐŸÑÐŸÐ±ÐµÐœÐœÐŸÑÑÑÐŒÐž: ÑÐŸÑÐŒÐ°ÑÐžÑÐŸÐ²Ð°ÐœÐžÐµ ÐœÐµÑÑÐ°ÐœÐŽÐ°ÑÑÐœÑÑ
+ ÐŽÐŸÐºÑÐŒÐµÐœÑÐŸÐ² Ðž ÑÐ¿ÑÐ°Ð²Ð»ÑÐµÐŒÑÐ¹ ÐŽÐŸÑÑÑÐ¿ Ðº ÐŽÐŸÐºÑÐŒÐµÐœÑÐ°ÐŒ Ð¿ÐŸÑÐ»Ðµ Ð°ÑÑÐµÐœÑÐžÑÐžÐºÐ°ÑÐžÐž Ð¿ÐŸÐ»ÑÐ·ÐŸÐ²Ð°ÑÐµÐ»Ñ.
+}
+
+_httpicongarish_ [l=ru] {ru/garish.gif}
+_decgarishtitle_ [l=ru] { Ð ÐµÐ·ÐºÐ°Ñ Ð²ÐµÑÑÐžÑ ÐŽÐµÐŒÐŸÐœÑÑÑÐ°ÑÐžÐŸÐœ-ÐœÐŸÐ¹ ÐºÐŸÐ»Ð»ÐµÐºÑÐžÐž }
+_decgarishdesc_ [l=ru] {
+Ð­ÑÐ° ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ ÑÐ°ÐºÐ¶Ðµ ÑÐŸÐŽÐµÑÐ¶ÐžÑ ÑÐŸÑ Ð¶Ðµ ÑÐ°ÐŒÑÐ¹ ÐŒÐ°ÑÐµÑÐžÐ°Ð», ÑÑÐŸ Ðž ÐŽÐµÐŒÐŸÐœÑÑÑÐ°ÑÐžÐŸÐœÐœÑÐ¹ Ð¿ÑÐžÐŒÐµÑ Greenstone. ÐÐµ Ð²ÐžÐŽ Ð±ÑÐ» ÐžÐ·ÐŒÐµÐœÐµÐœ, ÑÑÐŸÐ±Ñ Ð¿ÐŸÐºÐ°Ð·Ð°ÑÑ, ÐºÐ°Ðº Ð³ÐµÐœÐµÑÐžÑÐŸÐ²Ð°ÐœÐœÑÐµ ÑÑÑÐ°ÐœÐžÑÑ ÐŒÐŸÐ³ÑÑ Ð±ÑÑÑ ÐžÐ·Ð»ÐŸÐ¶ÐµÐœÑ Ð¿ÐŸ-ÐŽÑÑÐ³ÐŸÐŒÑ. ÐÐœÐ° ÑÐµÐ°Ð»ÐžÐ·ÐŸÐ²Ð°ÐœÐ° Ñ ÐžÑÐ¿ÐŸÐ»ÑÐ·ÐŸÐ²Ð°ÐœÐžÐµÐŒ ÑÑÐ°ÐœÐŽÐ°ÑÑÐœÐŸÐ³ÐŸ ÐŒÐ°ÐºÑÐŸ-ÑÐ°Ð¹Ð»Ð°, ÐºÐŸÑÐŸÑÑÐ¹ Ð¿ÑÐµÐŽÐŸÑÑÐ°Ð²Ð»ÑÐµÑÑÑ Ð²ÐŒÐµÑÑÐµ Ñ Greenstone.
+}
+
+_httpiconisis_ [l=ru] {ru/isis-e.gif}
+_decisistitle_ [l=ru] { ÐÑÐžÐŒÐµÑ CDS/ISIS }
+_decisisdesc_ [l=ru] {
+Ð­ÑÐ° ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ ÑÐŸÐ·ÐŽÐ°ÐœÐ° ÐžÐ· Ð±Ð°Ð·Ñ ÐŽÐ°ÐœÐœÑÑ
+ CDS/ISIS, ÑÐŸÐŽÐµÑÐ¶Ð°ÑÐµÐ¹ ÐŸÐºÐŸÐ»ÐŸ 150 Ð±ÐžÐ±Ð»ÐžÐŸÐ³ÑÐ°ÑÐžÑÐµÑÐºÐžÑ
+ ÑÐ»ÐµÐŒÐµÐœÑÐŸÐ². ÐÐ»Ñ ÑÑÐµÐœÐžÑ ÑÑÐ°ÐœÐŽÐ°ÑÑÐœÑÑ
+ ÐŽÐ»Ñ ISIS ÑÐ°Ð¹Ð»ÐŸÐ² .mst Ðž .ftd Ðž Ð¿ÑÐµÐŸÐ±ÑÐ°Ð·ÐŸÐ²Ð°ÐœÐžÑ ÐžÑ
+ Ð² ÐŒÐµÑÐ°-ÐŽÐ°ÐœÐœÑÐµ Greenstone ÐžÑÐ¿ÐŸÐ»ÑÐ·ÑÐµÑÑÑ Ð¿Ð»Ð°Ð³ÐžÐœ ISISPlug.
+}
+
+
+_httpicondspace_ [l=ru] {ru/dspace-e.gif}
+_decdspacetitle_ [l=ru] { ÐÑÐžÐŒÐµÑ DSpace }
+_decdspacedesc_ [l=ru] {
+Ð­ÑÐ° ÐºÐŸÐ»Ð»ÐµÐºÑÐžÑ ÐŸÑÐœÐŸÐ²Ð°ÐœÐ° ÐœÐ° Ð·Ð°Ð¿ÐžÑÑÑ
+, ÑÐºÑÐ¿ÐŸÑÑÐžÑÐŸÐ²Ð°ÐœÐœÑÑ
+ ÐžÐ· ÐœÐ°ÑÐ°Ð»ÑÐœÐŸÐ¹ ÑÐµÐ¿ÐŸÐ·ÐžÑÐŸÑÐžÐž DSpace.
+}
+
+
+package homepref
+_pagetitle_ {_preferences:textpreferences_ - _textdescrgreenstone_}
+
+_imagecollection_ {<a href="_httppagehome_"><img src="_httpimg_/gsdlhead.gif" alt="_textdescrgreenstone_" border="0"></a>}
+
+_globallinks_ {_homelink_ _helplink_}
+
+_pagescriptextra_ {_preferences:pagescriptextra_}
+
+_content_ {
+<div id="content">
+
+<div class="divbar">&nbsp;</div>
+
+<div class="section">
+<form name="PrefForm" method="get" action="_gwcgi_">
+<h3>_preferences:textpresentationprefs_</h3>
+
+<table border="0">
+<tr valign="top">
+<td>_preferences:textlanguage_</td>
+<td>_languageoption_</td>
+</tr>
+<tr valign="top">
+<td>_preferences:textencoding_</td>
+<td>_encodingoption_</td>
+</tr>
+<tr valign="top">
+_preferences:formatoption_
+</tr>
+</table>
+</div>
+
+<div class="divbar">&nbsp;</div>
+
+</div> <!-- \_homepref:content\_ -->
+}
