From 84f709e736e1ecec2cb204663711a2f0ea2f0e83 Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Thu, 4 Oct 2001 22:54:06 +0000
Subject: [PATCH] Retract #12313 and #12249.

p4raw-id: //depot/perl@12338
---
 pod/perlboot.pod      | 177 ++++++------------
 pod/perlbot.pod       | 173 +++++++----------
 pod/perlcall.pod      | 198 ++++++++++----------
 pod/perldata.pod      | 119 ++++++------
 pod/perldbmfilter.pod |  69 ++++---
 pod/perldsc.pod       | 499 ++++++++++++++++++++++++--------------------------
 pod/perlebcdic.pod    | 343 +++++++++++++---------------------
 7 files changed, 690 insertions(+), 888 deletions(-)

diff --git a/pod/perlboot.pod b/pod/perlboot.pod
index ff6f1af..8eaac86 100644
--- a/pod/perlboot.pod
+++ b/pod/perlboot.pod
@@ -44,8 +44,8 @@ packages, and called using the full package name.  So let's create
 an entire pasture:
 
     # Cow::speak, Horse::speak, Sheep::speak as before
-    my @pasture = qw(Cow Cow Horse Sheep Sheep);
-    foreach my $animal (@pasture) {
+    @pasture = qw(Cow Cow Horse Sheep Sheep);
+    foreach $animal (@pasture) {
       &{$animal."::speak"};
     }
 
@@ -58,10 +58,10 @@ This results in:
     a Sheep goes baaaah!
 
 Wow.  That symbolic coderef de-referencing there is pretty nasty.
-We're counting on L<strict|C<no strict refs>> mode, certainly not
-recommended for larger programs.  And why was that necessary?  Because
-the name of the package seems to be inseparable from the name of the
-subroutine we want to invoke within that package.
+We're counting on C<no strict subs> mode, certainly not recommended
+for larger programs.  And why was that necessary?  Because the name of
+the package seems to be inseparable from the name of the subroutine we
+want to invoke within that package.
 
 Or is it?
 
@@ -87,13 +87,12 @@ And once again, this results in:
 That's not fun yet.  Same number of characters, all constant, no
 variables.  But yet, the parts are separable now.  Watch:
 
-    my $a = "Cow";
+    $a = "Cow";
     $a->speak; # invokes Cow->speak
 
 Ahh!  Now that the package name has been parted from the subroutine
 name, we can use a variable package name.  And this time, we've got
-something that works even when L<strict|C<use strict refs>> is
-enabled.
+something that works even when C<use strict refs> is enabled.
 
 =head2 Invoking a barnyard
 
@@ -110,8 +109,8 @@ example:
       print "a Sheep goes baaaah!\n"
     }
 
-    my @pasture = qw(Cow Cow Horse Sheep Sheep);
-    foreach my $animal (@pasture) {
+    @pasture = qw(Cow Cow Horse Sheep Sheep);
+    foreach $animal (@pasture) {
       $animal->speak;
     }
 
@@ -169,14 +168,11 @@ the same class.
 Let's call out from C<speak> to a helper method called C<sound>.
 This method provides the constant text for the sound itself.
 
-    {
-      package Cow;
-
+    { package Cow;
       sub sound { "moooo" }
-
       sub speak {
-        my $class = shift;
-        print "a $class goes ", $class->sound, "!\n"
+	my $class = shift;
+	print "a $class goes ", $class->sound, "!\n"
       }
     }
 
@@ -184,11 +180,8 @@ Now, when we call C<< Cow->speak >>, we get a C<$class> of C<Cow> in
 C<speak>.  This in turn selects the C<< Cow->sound >> method, which
 returns C<moooo>.  But how different would this be for the C<Horse>?
 
-    {
-      package Horse;
-
+    { package Horse;
       sub sound { "neigh" }
-
       sub speak {
 	my $class = shift;
 	print "a $class goes ", $class->sound, "!\n"
@@ -204,9 +197,7 @@ Horse?  Yes, with inheritance!
 We'll define a common subroutine package called C<Animal>, with the
 definition for C<speak>:
 
-    {
-      package Animal;
-
+    { package Animal;
       sub speak {
 	my $class = shift;
 	print "a $class goes ", $class->sound, "!\n"
@@ -216,12 +207,8 @@ definition for C<speak>:
 Then, for each animal, we say it "inherits" from C<Animal>, along
 with the animal-specific sound:
 
-    {
-      package Cow;
-
-      # Not safe under `use strict', see below
+    { package Cow;
       @ISA = qw(Animal);
-
       sub sound { "moooo" }
     }
 
@@ -269,34 +256,32 @@ The easiest is to just spell the package name out:
 Or allow it as an implicitly named package variable:
 
     package Cow;
-    our @ISA = qw(Animal);
+    use vars qw(@ISA);
+    @ISA = qw(Animal);
 
 If you're bringing in the class from outside, via an object-oriented
 module, you change:
 
     package Cow;
     use Animal;
-    our @ISA = qw(Animal);
+    use vars qw(@ISA);
+    @ISA = qw(Animal);
 
 into just:
 
     package Cow;
     use base qw(Animal);
 
-And that's pretty darn compact.  Read about the L<base|base> pragma.
+And that's pretty darn compact.
 
 =head2 Overriding the methods
 
 Let's add a mouse, which can barely be heard:
 
-    # Animal package that we wrote before, goes here
-    {
-      package Mouse;
-
-      our @ISA = qw(Animal);
-
+    # Animal package from before
+    { package Mouse;
+      @ISA = qw(Animal);
       sub sound { "squeak" }
-
       sub speak {
         my $class = shift;
 	print "a $class goes ", $class->sound, "!\n";
@@ -324,14 +309,10 @@ C<Animal> does, but add in the extra comment?  Sure!
 
 First, we can invoke the C<Animal::speak> method directly:
 
-    # Animal package that we wrote before, goes here
-    {
-      package Mouse;
-
-      our @ISA = qw(Animal);
-
+    # Animal package from before
+    { package Mouse;
+      @ISA = qw(Animal);
       sub sound { "squeak" }
-
       sub speak {
         my $class = shift;
         Animal::speak($class);
@@ -364,11 +345,8 @@ A better solution is to tell Perl to search from a higher place
 in the inheritance chain:
 
     # same Animal as before
-    {
-       package Mouse;
-
+    { package Mouse;
       # same @ISA, &sound as before
-
       sub speak {
         my $class = shift;
         $class->Animal::speak;
@@ -394,11 +372,8 @@ invocation, we get a search of all of our super classes (classes
 listed in C<@ISA>) automatically:
 
     # same Animal as before
-    {
-      package Mouse;
-
+    { package Mouse;
       # same @ISA, &sound as before
-
       sub speak {
         my $class = shift;
         $class->SUPER::speak;
@@ -417,7 +392,7 @@ So far, we've seen the method arrow syntax:
 
 or the equivalent:
 
-  my $a = "Class";
+  $a = "Class";
   $a->method(@args);
 
 which constructs an argument list of:
@@ -444,20 +419,14 @@ haven't even begun to cover.
 Let's start with the code for the C<Animal> class
 and the C<Horse> class:
 
-  {
-    package Animal;
-
+  { package Animal;
     sub speak {
       my $class = shift;
       print "a $class goes ", $class->sound, "!\n"
     }
   }
-
-  {
-    package Horse;
-
-    our @ISA = qw(Animal);
-
+  { package Horse;
+    @ISA = qw(Animal);
     sub sound { "neigh" }
   }
 
@@ -479,7 +448,7 @@ An "instance" is generally created by a class.  In Perl, any reference
 can be an instance, so let's start with the simplest reference
 that can hold a horse's name: a scalar reference.
 
-  my $name    = "Mr. Ed";
+  my $name = "Mr. Ed";
   my $talking = \$name;
 
 So now C<$talking> is a reference to what will be the instance-specific
@@ -530,13 +499,9 @@ Because we get the instance as the first parameter, we can now access
 the instance-specific data.  In this case, let's add a way to get at
 the name:
 
-  {
-    package Horse;
-
-    our @ISA = qw(Animal);
-
+  { package Horse;
+    @ISA = qw(Animal);
     sub sound { "neigh" }
-
     sub name {
       my $self = shift;
       $$self;
@@ -565,21 +530,16 @@ guts" of a Horse are visible.  That's good if you're a veterinarian,
 but not if you just like to own horses.  So, let's let the Horse class
 build a new horse:
 
-  {
-    package Horse;
-
-    our @ISA = qw(Animal);
-
+  { package Horse;
+    @ISA = qw(Animal);
     sub sound { "neigh" }
-
     sub name {
       my $self = shift;
       $$self;
     }
-
     sub named {
       my $class = shift;
-      my $name  = shift;
+      my $name = shift;
       bless \$name, $class;
     }
   }
@@ -610,31 +570,23 @@ But was there anything specific to C<Horse> in that method?  No.  Therefore,
 it's also the same recipe for building anything else that inherited from
 C<Animal>, so let's put it there:
 
-  {
-    package Animal;
-
+  { package Animal;
     sub speak {
       my $class = shift;
       print "a $class goes ", $class->sound, "!\n"
     }
-
     sub name {
       my $self = shift;
       $$self;
     }
-
     sub named {
       my $class = shift;
-      my $name  = shift;
+      my $name = shift;
       bless \$name, $class;
     }
   }
-
-  {
-    package Horse;
-
-    our @ISA = qw(Animal);
-
+  { package Horse;
+    @ISA = qw(Animal);
     sub sound { "neigh" }
   }
 
@@ -663,7 +615,7 @@ classname).  Let's modify the C<name> method first to notice the change:
   sub name {
     my $either = shift;
     ref $either
-      ? $$either              # it's an instance, return name
+      ? $$either # it's an instance, return name
       : "an unnamed $either"; # it's a class, return generic
   }
 
@@ -673,8 +625,7 @@ instance or a class.  Note that I've changed the first parameter
 holder to C<$either> to show that this is intended:
 
   my $talking = Horse->named("Mr. Ed");
-
-  print Horse->name,    "\n"; # prints "an unnamed Horse\n"
+  print Horse->name, "\n"; # prints "an unnamed Horse\n"
   print $talking->name, "\n"; # prints "Mr Ed.\n"
 
 and now we'll fix C<speak> to use this:
@@ -691,46 +642,34 @@ we're done!
 
 Let's train our animals to eat:
 
-  {
-    package Animal;
+  { package Animal;
     sub named {
       my $class = shift;
-      my $name  = shift;
+      my $name = shift;
       bless \$name, $class;
     }
-
     sub name {
       my $either = shift;
       ref $either
-	? $$either              # it's an instance, return name
+	? $$either # it's an instance, return name
 	: "an unnamed $either"; # it's a class, return generic
     }
-
     sub speak {
       my $either = shift;
       print $either->name, " goes ", $either->sound, "\n";
     }
-
     sub eat {
       my $either = shift;
-      my $food   = shift;
+      my $food = shift;
       print $either->name, " eats $food.\n";
     }
   }
-
-  {
-    package Horse;
-
-    our @ISA = qw(Animal);
-
+  { package Horse;
+    @ISA = qw(Animal);
     sub sound { "neigh" }
   }
-
-  {
-    package Sheep;
-
-    our @ISA = qw(Animal);
-
+  { package Sheep;
+    @ISA = qw(Animal);
     sub sound { "baaaah" }
   }
 
@@ -738,7 +677,6 @@ And now try it out:
 
   my $talking = Horse->named("Mr. Ed");
   $talking->eat("hay");
-
   Sheep->eat("grass");
 
 which prints:
@@ -767,8 +705,7 @@ looks at the reference is changed accordingly.
 
 Let's make a sheep that has a name and a color:
 
-  my $data = { Name => "Evil", Color => "black" };
-  my $bad  = bless $data, Sheep;
+  my $bad = bless { Name => "Evil", Color => "black" }, Sheep;
 
 so C<< $bad->{Name} >> has C<Evil>, and C<< $bad->{Color} >> has
 C<black>.  But we want to make C<< $bad->name >> access the name, and
@@ -789,9 +726,8 @@ as well:
   ## in Animal
   sub named {
     my $class = shift;
-    my $name  = shift;
-    my $self  = { Name => $name, Color => $class->default_color };
-
+    my $name = shift;
+    my $self = { Name => $name, Color => $class->default_color };
     bless $self, $class;
   }
 
@@ -822,7 +758,6 @@ method or two to get and set the color.
   sub color {
     $_[0]->{Color}
   }
-
   sub set_color {
     $_[0]->{Color} = $_[1];
   }
diff --git a/pod/perlbot.pod b/pod/perlbot.pod
index 17b3755..bc4e4da 100644
--- a/pod/perlbot.pod
+++ b/pod/perlbot.pod
@@ -82,13 +82,11 @@ variables.  Named parameters are also demonstrated.
 	package Foo;
 
 	sub new {
-		my $type   = shift;
+		my $type = shift;
 		my %params = @_;
-		my $self   = {};
-
-		$self->{High} = $params{High};
-		$self->{Low}  = $params{Low};
-
+		my $self = {};
+		$self->{'High'} = $params{'High'};
+		$self->{'Low'}  = $params{'Low'};
 		bless $self, $type;
 	}
 
@@ -96,25 +94,23 @@ variables.  Named parameters are also demonstrated.
 	package Bar;
 
 	sub new {
-		my $type   = shift;
+		my $type = shift;
 		my %params = @_;
-		my $self   = [];
-
-		$self->[0] = $params{Left};
-		$self->[1] = $params{Right};
-
+		my $self = [];
+		$self->[0] = $params{'Left'};
+		$self->[1] = $params{'Right'};
 		bless $self, $type;
 	}
 
 	package main;
 
-	my $a = Foo->new( High => 42, Low => 11 );
-	print "High = $a->{High}\n";
-	print "Low  = $a->{Low}\n";
+	$a = Foo->new( 'High' => 42, 'Low' => 11 );
+	print "High=$a->{'High'}\n";
+	print "Low=$a->{'Low'}\n";
 
-	my $b = Bar->new( Left => 78, Right => 40 );
-	print "Left  = $b->[0]\n";
-	print "Right = $b->[1]\n";
+	$b = Bar->new( 'Left' => 78, 'Right' => 40 );
+	print "Left=$b->[0]\n";
+	print "Right=$b->[1]\n";
 
 =head1 SCALAR INSTANCE VARIABLES
 
@@ -124,15 +120,15 @@ An anonymous scalar can be used when only one instance variable is needed.
 
 	sub new {
 		my $type = shift;
-		my $self = shift;
-
+		my $self;
+		$self = shift;
 		bless \$self, $type;
 	}
 
 	package main;
 
-	my $a = Foo->new( 42 );
-	print "a = $$a\n";
+	$a = Foo->new( 42 );
+	print "a=$$a\n";
 
 
 =head1 INSTANCE VARIABLE INHERITANCE
@@ -147,29 +143,25 @@ object.
 	sub new {
 		my $type = shift;
 		my $self = {};
-
-		$self->{buz} = 42;
-
+		$self->{'buz'} = 42;
 		bless $self, $type;
 	}
 
 	package Foo;
-	our @ISA = qw( Bar );
+	@ISA = qw( Bar );
 
 	sub new {
 		my $type = shift;
 		my $self = Bar->new;
-
-		$self->{biz} = 11;
-
+		$self->{'biz'} = 11;
 		bless $self, $type;
 	}
 
 	package main;
 
-	my $a = Foo->new;
-	print "buz = $a->{buz}\n";
-	print "biz = $a->{biz}\n";
+	$a = Foo->new;
+	print "buz = ", $a->{'buz'}, "\n";
+	print "biz = ", $a->{'biz'}, "\n";
 
 
 
@@ -183,9 +175,7 @@ relationships between objects.
 	sub new {
 		my $type = shift;
 		my $self = {};
-
-		$self->{buz} = 42;
-
+		$self->{'buz'} = 42;
 		bless $self, $type;
 	}
 
@@ -194,18 +184,16 @@ relationships between objects.
 	sub new {
 		my $type = shift;
 		my $self = {};
-
-		$self->{Bar} = Bar->new;
-		$self->{biz} = 11;
-
+		$self->{'Bar'} = Bar->new;
+		$self->{'biz'} = 11;
 		bless $self, $type;
 	}
 
 	package main;
 
-	my $a = Foo->new;
-	print "buz = $a->{Bar}->{buz}\n";
-	print "biz = $a->{biz}\n";
+	$a = Foo->new;
+	print "buz = ", $a->{'Bar'}->{'buz'}, "\n";
+	print "biz = ", $a->{'biz'}, "\n";
 
 
 
@@ -219,17 +207,14 @@ where that method is defined.
 	package Buz;
 	sub goo { print "here's the goo\n" }
 
-
-	package Bar;
-        our @ISA = qw( Buz );
+	package Bar; @ISA = qw( Buz );
 	sub google { print "google here\n" }
 
-
 	package Baz;
 	sub mumble { print "mumbling\n" }
 
 	package Foo;
-	our @ISA = qw( Bar Baz );
+	@ISA = qw( Bar Baz );
 
 	sub new {
 		my $type = shift;
@@ -251,7 +236,7 @@ where that method is defined.
 
 	package main;
 
-	my $foo = Foo->new;
+	$foo = Foo->new;
 	$foo->mumble;
 	$foo->grr;
 	$foo->goo;
@@ -265,28 +250,24 @@ This example demonstrates an interface for the SDBM class.  This creates a
 
 	package Mydbm;
 
-	use SDBM_File;
-	use Tie::Hash;
-
-	our @ISA = qw( Tie::Hash );
+	require SDBM_File;
+	require Tie::Hash;
+	@ISA = qw( Tie::Hash );
 
 	sub TIEHASH {
 	    my $type = shift;
 	    my $ref  = SDBM_File->new(@_);
-	    bless { dbm => $ref }, $type;
+	    bless {'dbm' => $ref}, $type;
 	}
-
 	sub FETCH {
 	    my $self = shift;
-	    my $ref  = $self->{dbm};
+	    my $ref  = $self->{'dbm'};
 	    $ref->FETCH(@_);
 	}
-
 	sub STORE {
 	    my $self = shift;
-
-	    if ( defined $_[0] ) {
-		my $ref = $self->{dbm};
+	    if (defined $_[0]){
+		my $ref = $self->{'dbm'};
 		$ref->STORE(@_);
 	    } else {
 		die "Cannot STORE an undefined key in Mydbm\n";
@@ -296,13 +277,13 @@ This example demonstrates an interface for the SDBM class.  This creates a
 	package main;
 	use Fcntl qw( O_RDWR O_CREAT );
 
-	tie my %foo, 'Mydbm', 'Sdbm', O_RDWR|O_CREAT, 0640;
-	$foo{bar} = 123;
-	print "foo-bar = $foo{bar}\n";
+	tie %foo, "Mydbm", "Sdbm", O_RDWR|O_CREAT, 0640;
+	$foo{'bar'} = 123;
+	print "foo-bar = $foo{'bar'}\n";
 
-	tie my %bar, 'Mydbm', 'Sdbm2', O_RDWR|O_CREAT, 0640;
-	$bar{Cathy} = 456;
-	print "bar-Cathy = $bar{Cathy}\n";
+	tie %bar, "Mydbm", "Sdbm2", O_RDWR|O_CREAT, 0640;
+	$bar{'Cathy'} = 456;
+	print "bar-Cathy = $bar{'Cathy'}\n";
 
 =head1 THINKING OF CODE REUSE
 
@@ -320,7 +301,6 @@ that it is impossible to override the BAZ() method.
 		my $type = shift;
 		bless {}, $type;
 	}
-
 	sub bar {
 		my $self = shift;
 		$self->FOO::private::BAZ;
@@ -334,7 +314,7 @@ that it is impossible to override the BAZ() method.
 
 	package main;
 
-	my $a = FOO->new;
+	$a = FOO->new;
 	$a->bar;
 
 Now we try to override the BAZ() method.  We would like FOO::bar() to call
@@ -347,7 +327,6 @@ FOO::private::BAZ().
 		my $type = shift;
 		bless {}, $type;
 	}
-
 	sub bar {
 		my $self = shift;
 		$self->FOO::private::BAZ;
@@ -360,9 +339,7 @@ FOO::private::BAZ().
 	}
 
 	package GOOP;
-
-	our @ISA = qw( FOO );
-
+	@ISA = qw( FOO );
 	sub new {
 		my $type = shift;
 		bless {}, $type;
@@ -374,7 +351,7 @@ FOO::private::BAZ().
 
 	package main;
 
-	my $a = GOOP->new;
+	$a = GOOP->new;
 	$a->bar;
 
 To create reusable code we must modify class FOO, flattening class
@@ -387,7 +364,6 @@ method GOOP::BAZ() to be used in place of FOO::BAZ().
 		my $type = shift;
 		bless {}, $type;
 	}
-
 	sub bar {
 		my $self = shift;
 		$self->BAZ;
@@ -398,21 +374,19 @@ method GOOP::BAZ() to be used in place of FOO::BAZ().
 	}
 
 	package GOOP;
-
-	our @ISA = qw( FOO );
+	@ISA = qw( FOO );
 
 	sub new {
 		my $type = shift;
 		bless {}, $type;
 	}
-
 	sub BAZ {
 		print "in GOOP::BAZ\n";
 	}
 
 	package main;
 
-	my $a = GOOP->new;
+	$a = GOOP->new;
 	$a->bar;
 
 =head1 CLASS CONTEXT AND THE OBJECT
@@ -435,12 +409,12 @@ method where that data is located.
 
 	package Bar;
 
-	my %fizzle = ( Password => 'XYZZY' );
+	%fizzle = ( 'Password' => 'XYZZY' );
 
 	sub new {
 		my $type = shift;
 		my $self = {};
-		$self->{fizzle} = \%fizzle;
+		$self->{'fizzle'} = \%fizzle;
 		bless $self, $type;
 	}
 
@@ -451,29 +425,27 @@ method where that data is located.
 		# or %Foo::fizzle.  The object already knows which
 		# we should use, so just ask it.
 		#
-		my $fizzle = $self->{fizzle};
+		my $fizzle = $self->{'fizzle'};
 
-		print "The word is $fizzle->{Password}\n";
+		print "The word is ", $fizzle->{'Password'}, "\n";
 	}
 
 	package Foo;
+	@ISA = qw( Bar );
 
-	our @ISA = qw( Bar );
-
-	my %fizzle = ( Password => 'Rumple' );
+	%fizzle = ( 'Password' => 'Rumple' );
 
 	sub new {
 		my $type = shift;
 		my $self = Bar->new;
-		$self->{fizzle} = \%fizzle;
+		$self->{'fizzle'} = \%fizzle;
 		bless $self, $type;
 	}
 
 	package main;
 
-	my $a = Bar->new;
-	my $b = Foo->new;
-
+	$a = Bar->new;
+	$b = Foo->new;
 	$a->enter;
 	$b->enter;
 
@@ -496,8 +468,7 @@ object will be a BAR not a FOO, even though the constructor is in class FOO.
 	}
 
 	package BAR;
-
-	our @ISA = qw(FOO);
+	@ISA = qw(FOO);
 
 	sub baz {
 		print "in BAR::baz()\n";
@@ -505,7 +476,7 @@ object will be a BAR not a FOO, even though the constructor is in class FOO.
 
 	package main;
 
-	my $a = BAR->new;
+	$a = BAR->new;
 	$a->baz;
 
 =head1 DELEGATION
@@ -522,16 +493,14 @@ behavior by adding custom FETCH() and STORE() methods, if this is desired.
 
 	package Mydbm;
 
-	use SDBM_File;
-	use Tie::Hash;
-
-	our @ISA = qw( Tie::Hash );
-        our $AUTOLOAD;
+	require SDBM_File;
+	require Tie::Hash;
+	@ISA = qw(Tie::Hash);
 
 	sub TIEHASH {
 		my $type = shift;
-		my $ref  = SDBM_File->new(@_);
-		bless { delegate => $ref };
+		my $ref = SDBM_File->new(@_);
+		bless {'delegate' => $ref};
 	}
 
 	sub AUTOLOAD {
@@ -547,12 +516,12 @@ behavior by adding custom FETCH() and STORE() methods, if this is desired.
 		$AUTOLOAD =~ s/^Mydbm:://;
 
 		# Pass the message to the delegate.
-		$self->{delegate}->$AUTOLOAD(@_);
+		$self->{'delegate'}->$AUTOLOAD(@_);
 	}
 
 	package main;
 	use Fcntl qw( O_RDWR O_CREAT );
 
-	tie my %foo, 'Mydbm', 'adbm', O_RDWR|O_CREAT, 0640;
-	$foo{bar} = 123;
-	print "foo-bar = $foo{bar}\n";
+	tie %foo, "Mydbm", "adbm", O_RDWR|O_CREAT, 0640;
+	$foo{'bar'} = 123;
+	print "foo-bar = $foo{'bar'}\n";
diff --git a/pod/perlcall.pod b/pod/perlcall.pod
index d072f00..40f1d65 100644
--- a/pod/perlcall.pod
+++ b/pod/perlcall.pod
@@ -259,15 +259,13 @@ occur when the code that is executing the I<call_*> function has
 itself been called from another Perl subroutine. The code below
 illustrates this
 
-    sub fred {
-      print "@_\n";
-    }
+    sub fred
+      { print "@_\n"  }
 
-    sub joe {
-      &fred;
-    }
+    sub joe
+      { &fred }
 
-    &joe(1,2,3);
+    &joe(1,2,3) ;
 
 This will print
 
@@ -394,9 +392,11 @@ XSUB, the program will immediately terminate.
 
 For example, say you want to call this Perl sub
 
-    sub fred {
-      eval { die "Fatal Error" }
-      print "Trapped error: $@\n" if $@;
+    sub fred
+    {
+        eval { die "Fatal Error" ; }
+        print "Trapped error: $@\n"
+            if $@ ;
     }
 
 via this XSUB
@@ -450,8 +450,9 @@ I<Using call_sv> for details.
 This first trivial example will call a Perl subroutine, I<PrintUID>, to
 print out the UID of the process.
 
-    sub PrintUID {
-      print "UID is $<\n";
+    sub PrintUID
+    {
+        print "UID is $<\n" ;
     }
 
 and here is a C function to call it
@@ -510,9 +511,10 @@ print the first $n characters of the string.
 
 So the Perl subroutine would look like this
 
-    sub LeftString {
-      my($s, $n) = @_ ;
-      print substr($s, 0, $n), "\n";
+    sub LeftString
+    {
+        my($s, $n) = @_ ;
+        print substr($s, 0, $n), "\n" ;
     }
 
 The C function required to call I<LeftString> would look like this.
@@ -641,9 +643,10 @@ subroutine.
 Here is a Perl subroutine, I<Adder>, that takes 2 integer parameters
 and simply returns their sum.
 
-    sub Adder {
-        my($a, $b) = @_;
-        $a + $b;
+    sub Adder
+    {
+        my($a, $b) = @_ ;
+        $a + $b ;
     }
 
 Because we are now concerned with the return value from I<Adder>, the C
@@ -745,9 +748,10 @@ parameters and the difference.
 
 Here is the Perl subroutine
 
-    sub AddSubtract {
-      my($a, $b) = @_;
-      ($a+$b, $a-$b);
+    sub AddSubtract
+    {
+       my($a, $b) = @_ ;
+       ($a+$b, $a-$b) ;
     }
 
 and this is the C function
@@ -870,9 +874,10 @@ whether it is actually desirable to do it is another matter entirely.
 The Perl subroutine, I<Inc>, below takes 2 parameters and increments
 each directly.
 
-    sub Inc {
-      ++$_[0];
-      ++$_[1];
+    sub Inc
+    {
+        ++ $_[0] ;
+        ++ $_[1] ;
     }
 
 and here is a C function to call it.
@@ -928,12 +933,13 @@ Now an example using G_EVAL. Below is a Perl subroutine which computes
 the difference of its 2 parameters. If this would result in a negative
 result, the subroutine calls I<die>.
 
-    sub Subtract {
-      my ($a, $b) = @_;
+    sub Subtract
+    {
+        my ($a, $b) = @_ ;
 
-      die "death can be fatal\n" if $a < $b;
+        die "death can be fatal\n" if $a < $b ;
 
-      $a - $b;
+        $a - $b ;
     }
 
 and some C to call it
@@ -1035,21 +1041,16 @@ Consider this rather facetious example, where we have used an XS
 version of the call_Subtract example above inside a destructor:
 
     package Foo;
-
-    sub new { bless {}, shift }
-
+    sub new { bless {}, $_[0] }
     sub Subtract {
-      my($a,$b) = @_;
-      die "death can be fatal" if $a < $b;
-      $a - $b;
+        my($a,$b) = @_;
+        die "death can be fatal" if $a < $b ;
+        $a - $b;
     }
-
-    sub DESTROY { call_Subtract(5, 4) }
-    sub foo     { die "foo dies"      }
-
+    sub DESTROY { call_Subtract(5, 4); }
+    sub foo { die "foo dies"; }
 
     package main;
-
     eval { Foo->new->foo };
     print "Saw: $@" if $@;             # should be, but isn't
 
@@ -1076,11 +1077,12 @@ within the Perl script.
 
 Consider the Perl code below
 
-    sub fred {
-      print "Hello there\n";
+    sub fred
+    {
+        print "Hello there\n" ;
     }
 
-    CallSubPV("fred");
+    CallSubPV("fred") ;
 
 Here is a snippet of XSUB which defines I<CallSubPV>.
 
@@ -1109,12 +1111,11 @@ I<call_sv> instead of I<call_pv>.
 
 Because we are using an SV to call I<fred> the following can all be used
 
-    CallSubSV("fred");
-    CallSubSV(\&fred);
-
-    my $ref = \&fred;
-    CallSubSV($ref);
-    CallSubSV( sub { print "Hello there\n" } );
+    CallSubSV("fred") ;
+    CallSubSV(\&fred) ;
+    $ref = \&fred ;
+    CallSubSV($ref) ;
+    CallSubSV( sub { print "Hello there\n" } ) ;
 
 As you can see, I<call_sv> gives you much greater flexibility in
 how you can specify the Perl subroutine.
@@ -1143,11 +1144,11 @@ pointer C<rememberSub> in C<CallSavedSub1>, it may or may not still refer
 to the Perl subroutine that was recorded in C<SaveSub1>.  This is
 particularly true for these cases
 
-    SaveSub1(\&fred);
-    CallSavedSub1();
+    SaveSub1(\&fred) ;
+    CallSavedSub1() ;
 
-    SaveSub1( sub { print "Hello there\n" } );
-    CallSavedSub1();
+    SaveSub1( sub { print "Hello there\n" } ) ;
+    CallSavedSub1() ;
 
 By the time each of the C<SaveSub1> statements above have been executed,
 the SV*s which corresponded to the parameters will no longer exist.
@@ -1159,11 +1160,10 @@ for each of the C<CallSavedSub1> lines.
 
 Similarly, with this code
 
-    my $ref = \&fred;
-    SaveSub1($ref);
-
-    $ref = 47;
-    CallSavedSub1();
+    $ref = \&fred ;
+    SaveSub1($ref) ;
+    $ref = 47 ;
+    CallSavedSub1() ;
 
 you can expect one of these messages (which you actually get is dependent on
 the version of Perl you are using)
@@ -1183,11 +1183,10 @@ loudly.
 
 A similar but more subtle problem is illustrated with this code
 
-    my $ref = \&fred;
-    SaveSub1($ref);
-
-    $ref = \&joe;
-    CallSavedSub1();
+    $ref = \&fred ;
+    SaveSub1($ref) ;
+    $ref = \&joe ;
+    CallSavedSub1() ;
 
 This time whenever C<CallSavedSub1> get called it will execute the Perl
 subroutine C<joe> (assuming it exists) rather than C<fred> as was
@@ -1229,12 +1228,11 @@ C<SvSetSV>.
 Here is a Perl subroutine which prints whatever parameters are passed
 to it.
 
-    sub PrintList {
-        my @list = @_;
+    sub PrintList
+    {
+        my(@list) = @_ ;
 
-        foreach (@list) {
-          print "$_\n";
-        }
+        foreach (@list) { print "$_\n" }
     }
 
 and here is an example of I<call_argv> which will call
@@ -1258,22 +1256,25 @@ This is because I<call_argv> will do it for you.
 Consider the following Perl code
 
     {
-      package Mine ;
-
-      sub new {
-        my $type = shift;
-        bless [@_], $type;
-      }
-
-      sub Display {
-        my ($self, $index) = @_;
-        print "$index: $self->[$index]\n";
-      }
-
-      sub PrintID {
-        my $class = shift;
-        print "This is Class $class version 1.0\n";
-      }
+        package Mine ;
+
+        sub new
+        {
+            my($type) = shift ;
+            bless [@_]
+        }
+
+        sub Display
+        {
+            my ($self, $index) = @_ ;
+            print "$index: $$self[$index]\n" ;
+        }
+
+        sub PrintID
+        {
+            my($class) = @_ ;
+            print "This is Class $class version 1.0\n" ;
+        }
     }
 
 It implements just a very simple class to manage an array.  Apart from
@@ -1282,10 +1283,9 @@ virtual. The static method, C<PrintID>, prints out simply the class
 name and a version number. The virtual method, C<Display>, prints out a
 single element of the array.  Here is an all Perl example of using it.
 
-    my $a = Mine->new('red', 'green', 'blue');
-    $a->Display(1);
-
-    Mine->PrintID;
+    $a = new Mine ('red', 'green', 'blue') ;
+    $a->Display(1) ;
+    PrintID Mine;
 
 will print
 
@@ -1342,9 +1342,9 @@ the C<PrintID> and C<Display> methods from C.
 
 So the methods C<PrintID> and C<Display> can be invoked like this
 
-    my $a = Mine->new('red', 'green', 'blue');
-    call_Method($a, 'Display', 1);
-    call_PrintID('Mine', 'PrintID');
+    $a = new Mine ('red', 'green', 'blue') ;
+    call_Method($a, 'Display', 1) ;
+    call_PrintID('Mine', 'PrintID') ;
 
 The only thing to note is that in both the static and virtual methods,
 the method name is not passed via the stack--it is used as the first
@@ -1369,8 +1369,8 @@ currently executing.
 and here is some Perl to test it
 
     PrintContext ;
-    my $a = PrintContext;
-    my @a = PrintContext;
+    $a = PrintContext ;
+    @a = PrintContext ;
 
 The output from that will be
 
@@ -1551,8 +1551,9 @@ registers, C<pcb1>, might look like this
     # Register the sub pcb1
     register_fatal(\&pcb1) ;
 
-    sub pcb1 {
-      die "I'm dying...\n";
+    sub pcb1
+    {
+        die "I'm dying...\n" ;
     }
 
 The mapping between the C callback and the Perl equivalent is stored in
@@ -1651,14 +1652,15 @@ the entry from the hash C<Mapping>.
 
 So the Perl interface would look like this
 
-    sub callback1 {
-      my($handle, $buffer) = @_;
+    sub callback1
+    {
+        my($handle, $buffer) = @_ ;
     }
 
     # Register the Perl callback
-    asynch_read($fh, \&callback1);
+    asynch_read($fh, \&callback1) ;
 
-    asynch_close($fh);
+    asynch_close($fh) ;
 
 The mapping between the C callback and Perl is stored in the global
 hash C<Mapping> this time. Using a hash has the distinct advantage that
diff --git a/pod/perldata.pod b/pod/perldata.pod
index 9155abc..968588d 100644
--- a/pod/perldata.pod
+++ b/pod/perldata.pod
@@ -224,7 +224,7 @@ by assigning to an element that is off the end of the array.  You
 can truncate an array down to nothing by assigning the null list
 () to it.  The following are equivalent:
 
-    my @whatever = ();
+    @whatever = ();
     $#whatever = -1;
 
 If you evaluate an array in scalar context, it returns the length
@@ -233,6 +233,13 @@ the last value, like the C comma operator, nor of built-in functions,
 which return whatever they feel like returning.)  The following is
 always true:
 
+    scalar(@whatever) == $#whatever - $[ + 1;
+
+Version 5 of Perl changed the semantics of C<$[>: files that don't set
+the value of C<$[> no longer need to worry about whether another
+file changed its value.  (In other words, use of C<$[> is deprecated.)
+So in general you can assume that
+
     scalar(@whatever) == $#whatever + 1;
 
 Some programmers choose to use an explicit conversion so as to 
@@ -254,7 +261,6 @@ of sixteen buckets has been touched, and presumably contains all
 You can preallocate space for a hash by assigning to the keys() function.
 This rounds up the allocated buckets to the next power of two:
 
-    my %users = ();
     keys(%users) = 1000;		# allocate 1024 buckets
 
 =head2 Scalar value constructors
@@ -300,8 +306,8 @@ names beginning with $ or @, followed by an optional bracketed
 expression as a subscript.)  The following code segment prints out "The
 price is $Z<>100."
 
-    my $Price = '$100';                 # not interpolated
-    print "The price is $Price.\n";	# interpolated
+    $Price = '$100';	# not interpreted
+    print "The price is $Price.\n";	# interpreted
 
 As in some shells, you can enclose the variable name in braces to
 disambiguate it from following alphanumerics (and underscores).
@@ -310,7 +316,7 @@ this when interpolating a variable into a string to separate the
 variable name from a following double-colon or an apostrophe, since
 these would be otherwise treated as a package separator:
 
-    my $who = "Larry";
+    $who = "Larry";
     print PASSWD "${who}::0:0:Superuser:/:/bin/perl\n";
     print "We use ${who}speak when ${who}'s here.\n";
 
@@ -393,7 +399,7 @@ by joining the elements with the delimiter specified in the C<$">
 variable (C<$LIST_SEPARATOR> in English), space by default.  The
 following are equivalent:
 
-    my $temp = join($", @ARGV);
+    $temp = join($", @ARGV);
     system "echo $temp";
 
     system "echo @ARGV";
@@ -460,7 +466,7 @@ If you want your here-docs to be indented with the
 rest of the code, you'll need to remove leading whitespace
 from each line manually:
 
-    (my $quote = <<'FINIS') =~ s/^\s+//gm;
+    ($quote = <<'FINIS') =~ s/^\s+//gm;
 	The Road goes ever on and on, 
 	down from the door where it began.
     FINIS
@@ -509,23 +515,23 @@ In a context not requiring a list value, the value of what appears
 to be a list literal is simply the value of the final element, as
 with the C comma operator.  For example,
 
-    my @foo = ('cc', '-E', $bar);
+    @foo = ('cc', '-E', $bar);
 
 assigns the entire list value to array @foo, but
 
-    my $foo = ('cc', '-E', $bar);
+    $foo = ('cc', '-E', $bar);
 
 assigns the value of variable $bar to the scalar variable $foo.
 Note that the value of an actual array in scalar context is the
 length of the array; the following assigns the value 3 to $foo:
 
-    my @foo = ('cc', '-E', $bar);
-    my $foo = @foo;		# $foo gets 3
+    @foo = ('cc', '-E', $bar);
+    $foo = @foo;		# $foo gets 3
 
 You may have an optional comma before the closing parenthesis of a
 list literal, so that you can say:
 
-    my @foo = (
+    @foo = (
 	1,
 	2,
 	3,
@@ -534,7 +540,7 @@ list literal, so that you can say:
 To use a here-document to assign an array, one line per element,
 you might use an approach like this:
 
-    my @sauces = <<End_Lines =~ m/(\S.*\S)/g;
+    @sauces = <<End_Lines =~ m/(\S.*\S)/g;
 	normal tomato
 	spicy tomato
 	green chile
@@ -573,13 +579,13 @@ A list value may also be subscripted like a normal array.  You must
 put the list in parentheses to avoid ambiguity.  For example:
 
     # Stat returns list value.
-    my $time = (stat($file))[8];
+    $time = (stat($file))[8];
 
     # SYNTAX ERROR HERE.
-    my $time = stat($file)[8];  # OOPS, FORGOT PARENTHESES
+    $time = stat($file)[8];  # OOPS, FORGOT PARENTHESES
 
     # Find a hex digit.
-    my $hexdigit = ('a','b','c','d','e','f')[$digit-10];
+    $hexdigit = ('a','b','c','d','e','f')[$digit-10];
 
     # A "reverse comma operator".
     return (pop(@foo),pop(@foo))[0];
@@ -587,21 +593,21 @@ put the list in parentheses to avoid ambiguity.  For example:
 Lists may be assigned to only when each element of the list
 is itself legal to assign to:
 
-    my($a, $b, $c) = (1, 2, 3);
+    ($a, $b, $c) = (1, 2, 3);
 
-    ($map{red}, $map{blue}, $map{green}) = (0x00f, 0x0f0, 0xf00);
+    ($map{'red'}, $map{'blue'}, $map{'green'}) = (0x00f, 0x0f0, 0xf00);
 
 An exception to this is that you may assign to C<undef> in a list.
 This is useful for throwing away some of the return values of a
 function:
 
-    my($dev, $ino, undef, undef, $uid, $gid) = stat($file);
+    ($dev, $ino, undef, undef, $uid, $gid) = stat($file);
 
 List assignment in scalar context returns the number of elements
 produced by the expression on the right side of the assignment:
 
-    my $x = (($foo,$bar) = (3,2,1));	# set $x to 3, not 2
-    my $x = (($foo,$bar) = f());        # set $x to f()'s return count
+    $x = (($foo,$bar) = (3,2,1));	# set $x to 3, not 2
+    $x = (($foo,$bar) = f());	        # set $x to f()'s return count
 
 This is handy when you want to do a list assignment in a Boolean
 context, because most list functions return a null list when finished,
@@ -612,7 +618,7 @@ performing an operation in list context and then counting the number of
 return values, by assigning to an empty list and then using that
 assignment in scalar context. For example, this code:
 
-    my $count = () = $string =~ /\d+/g;
+    $count = () = $string =~ /\d+/g;
 
 will place into $count the number of digit groups found in $string.
 This happens because the pattern match is in list context (since it
@@ -622,15 +628,14 @@ context will translate that into the number of elements (here, the
 number of times the pattern matched) and assign that to $count. Note
 that simply using
 
-    my $count = $string =~ /\d+/g;
+    $count = $string =~ /\d+/g;
 
 would not have worked, since a pattern match in scalar context will
 only return true or false, rather than a count of matches.
 
 The final element of a list assignment may be an array or a hash:
 
-    my($a, $b, @rest) = split;
-    # or
+    ($a, $b, @rest) = split;
     my($a, $b, %rest) = @_;
 
 You can actually put an array or hash anywhere in the list, but the first one
@@ -641,7 +646,7 @@ A hash can be initialized using a literal list holding pairs of
 items to be interpreted as a key and a value:
 
     # same as map assignment above
-    my %map = ('red',0x00f,'blue',0x0f0,'green',0xf00);
+    %map = ('red',0x00f,'blue',0x0f0,'green',0xf00);
 
 While literal lists and named arrays are often interchangeable, that's
 not the case for hashes.  Just because you can subscript a list value like
@@ -656,7 +661,7 @@ synonym for a comma, but it also arranges for its left-hand operand to be
 interpreted as a string--if it's a bareword that would be a legal identifier.
 This makes it nice for initializing hashes:
 
-    my %map = (
+    %map = (
 		 red   => 0x00f,
 		 blue  => 0x0f0,
 		 green => 0xf00,
@@ -664,7 +669,7 @@ This makes it nice for initializing hashes:
 
 or for initializing hash references to be used as records:
 
-    my $rec = {
+    $rec = {
 		witch => 'Mable the Merciless',
 		cat   => 'Fluffy the Ferocious',
 		date  => '10/31/1776',
@@ -672,14 +677,12 @@ or for initializing hash references to be used as records:
 
 or for using call-by-named-parameter to complicated functions:
 
-   use CGI;
-   my $query = CGI->new;
-   my $field = $query->radio_group(
+   $field = $query->radio_group(
 	       name      => 'group_name',
                values    => ['eenie','meenie','minie'],
                default   => 'meenie',
                linebreak => 'true',
-               labels    => \%labels,
+               labels    => \%labels
    );
 
 Note that just because a hash is initialized in that order doesn't
@@ -691,36 +694,34 @@ of how to arrange for an output ordering.
 A common way to access an array or a hash is one scalar element at a
 time.  You can also subscript a list to get a single element from it.
 
-    my $whoami = $ENV{"USER"};		  # one element from the hash
-    my $parent = $ISA[0];		  # one element from the array
-    my $dir    = (getpwnam("daemon"))[7]; # likewise, but with list
+    $whoami = $ENV{"USER"};		# one element from the hash
+    $parent = $ISA[0];		        # one element from the array
+    $dir    = (getpwnam("daemon"))[7];	# likewise, but with list
 
 A slice accesses several elements of a list, an array, or a hash
 simultaneously using a list of subscripts.  It's more convenient
 than writing out the individual elements as a list of separate
 scalar values.
 
-    my($him, $her)   = @folks[0,-1];		  # array slice
-    my @them         = @folks[0 .. 3];		  # array slice
-    my($who, $home)  = @ENV{"USER", "HOME"};	  # hash slice
-    my($uid, $dir)   = (getpwnam("daemon"))[2,7]; # list slice
+    ($him, $her)   = @folks[0,-1];		# array slice
+    @them          = @folks[0 .. 3];		# array slice
+    ($who, $home)  = @ENV{"USER", "HOME"};	# hash slice
+    ($uid, $dir)   = (getpwnam("daemon"))[2,7];	# list slice
 
 Since you can assign to a list of variables, you can also assign to
 an array or hash slice.
 
-    my( @days, %colors, @folks );
-    @days[3..5]    = qw(Wed Thu Fri);
+    @days[3..5]    = qw/Wed Thu Fri/;
     @colors{'red','blue','green'} 
 		   = (0xff0000, 0x0000ff, 0x00ff00);
     @folks[0, -1]  = @folks[-1, 0];
 
 The previous assignments are exactly equivalent to
 
-    my( @days, %colors, @folks );
-    ($days[3], $days[4], $days[5]) = qw(Wed Thu Fri);
-    ($colors{red}, $colors{blue}, $colors{green})
+    ($days[3], $days[4], $days[5]) = qw/Wed Thu Fri/;
+    ($colors{'red'}, $colors{'blue'}, $colors{'green'})
 		   = (0xff0000, 0x0000ff, 0x00ff00);
-    ($folks[0], $folks[-1]) = ($folks[-1], $folks[0]);
+    ($folks[0], $folks[-1]) = ($folks[0], $folks[-1]);
 
 Since changing a slice changes the original array or hash that it's
 slicing, a C<foreach> construct will alter some--or even all--of the
@@ -736,19 +737,19 @@ values of the array or hash.
 
 A slice of an empty list is still an empty list.  Thus:
 
-    my @a = ()[1,0];           # @a has no elements
-    my @b = (@a)[0,1];         # @b has no elements
-    my @c = (0,1)[2,3];        # @c has no elements
+    @a = ()[1,0];           # @a has no elements
+    @b = (@a)[0,1];         # @b has no elements
+    @c = (0,1)[2,3];        # @c has no elements
 
 But:
 
-    my @a = (1)[1,0];          # @a has two elements
-    my @b = (1,undef)[1,0,2];  # @b has three elements
+    @a = (1)[1,0];          # @a has two elements
+    @b = (1,undef)[1,0,2];  # @b has three elements
 
 This makes it easy to write loops that terminate when a null list
 is returned:
 
-    while ( my($home, $user) = (getpwent)[7,0] ) {
+    while ( ($home, $user) = (getpwent)[7,0]) {
 	printf "%-8s %s\n", $user, $home;
     }
 
@@ -775,8 +776,6 @@ we have real references, this is seldom needed.
 The main use of typeglobs in modern Perl is create symbol table aliases.
 This assignment:
 
-    {
-     
     *this = *that;
 
 makes $this an alias for $that, @this an alias for @that, %this an alias
@@ -789,18 +788,17 @@ temporarily makes $Here::blue an alias for $There::green, but doesn't
 make @Here::blue an alias for @There::green, or %Here::blue an alias for
 %There::green, etc.  See L<perlmod/"Symbol Tables"> for more examples
 of this.  Strange though this may seem, this is the basis for the whole
-module import/export system.  And none of it works under
-C<use strict 'vars'>.
+module import/export system.
 
 Another use for typeglobs is to pass filehandles into a function or
 to create new filehandles.  If you need to use a typeglob to save away
 a filehandle, do it this way:
 
-    my $fh = *STDOUT;
+    $fh = *STDOUT;
 
 or perhaps as a real reference, like this:
 
-    my $fh = \*STDOUT;
+    $fh = \*STDOUT;
 
 See L<perlsub> for examples of using these as indirect filehandles
 in functions.
@@ -815,7 +813,7 @@ For example:
 	open   (FH, $path) 	    or  return undef;
 	return *FH;
     }
-    my $fh = newopen('/etc/passwd');
+    $fh = newopen('/etc/passwd');
 
 Now that we have the C<*foo{THING}> notation, typeglobs aren't used as much
 for filehandle manipulations, although they're still needed to pass brand
@@ -835,9 +833,8 @@ largely eliminates the need for typeglobs when opening filehandles
 that must be passed around, as in the following example:
 
     sub myopen {
-        my $filename = shift;
-        open my $fh, $filename
-	     or die "Can't open '$filename': $!";
+        open my $fh, "@_"
+	     or die "Can't open '@_': $!";
 	return $fh;
     }
 
diff --git a/pod/perldbmfilter.pod b/pod/perldbmfilter.pod
index f10bdd0..8384999 100644
--- a/pod/perldbmfilter.pod
+++ b/pod/perldbmfilter.pod
@@ -4,13 +4,12 @@ perldbmfilter - Perl DBM Filters
 
 =head1 SYNOPSIS
 
-    my $db = tie my %hash, 'DBM', ...;
+    $db = tie %hash, 'DBM', ...
 
-    my $old_filter;
-    $old_filter = $db->filter_store_key  ( sub { ... } );
-    $old_filter = $db->filter_store_value( sub { ... } );
-    $old_filter = $db->filter_fetch_key  ( sub { ... } );
-    $old_filter = $db->filter_fetch_value( sub { ... } );
+    $old_filter = $db->filter_store_key  ( sub { ... } ) ;
+    $old_filter = $db->filter_store_value( sub { ... } ) ;
+    $old_filter = $db->filter_fetch_key  ( sub { ... } ) ;
+    $old_filter = $db->filter_fetch_value( sub { ... } ) ;
 
 =head1 DESCRIPTION
 
@@ -86,30 +85,30 @@ the database and have them removed when you read from the database. As I'm
 sure you have already guessed, this is a problem that DBM Filters can
 fix very easily.
 
-    use strict;
-    use warnings;
-    use SDBM_File;
-    use Fcntl;
+    use strict ;
+    use warnings ;
+    use SDBM_File ;
+    use Fcntl ;
 
-    my %hash;
-    my $filename = '/tmp/filt';
-    unlink $filename;
+    my %hash ;
+    my $filename = "/tmp/filt" ;
+    unlink $filename ;
 
     my $db = tie(%hash, 'SDBM_File', $filename, O_RDWR|O_CREAT, 0640)
-      or die "Cannot open $filename: $!\n";
+      or die "Cannot open $filename: $!\n" ;
 
     # Install DBM Filters
-    $db->filter_fetch_key  ( sub { s/\0$//    } );
-    $db->filter_store_key  ( sub { $_ .= "\0" } );
+    $db->filter_fetch_key  ( sub { s/\0$//    } ) ;
+    $db->filter_store_key  ( sub { $_ .= "\0" } ) ;
     $db->filter_fetch_value( 
-        sub { no warnings 'uninitialized'; s/\0$// } );
-    $db->filter_store_value( sub { $_ .= "\0" } );
+        sub { no warnings 'uninitialized' ;s/\0$// } ) ;
+    $db->filter_store_value( sub { $_ .= "\0" } ) ;
 
-    $hash{abc} = 'def';
-    my $a = $hash{ABC};
+    $hash{"abc"} = "def" ;
+    my $a = $hash{"ABC"} ;
     # ...
-    undef $db;
-    untie %hash;
+    undef $db ;
+    untie %hash ;
 
 The code above uses SDBM_File, but it will work with any of the DBM
 modules.
@@ -125,7 +124,7 @@ Here is another real-life example. By default, whenever Perl writes to
 a DBM database it always writes the key and value as strings. So when
 you use this:
 
-    $hash{12345} = 'something';
+    $hash{12345} = "something" ;
 
 the key 12345 will get stored in the DBM database as the 5 byte string
 "12345". If you actually want the key to be stored in the DBM database
@@ -134,23 +133,23 @@ when reading.
 
 Here is a DBM Filter that does it:
 
-    use strict;
-    use warnings;
-    use DB_File;
-    my %hash;
-    my $filename = '/tmp/filt';
-    unlink $filename;
+    use strict ;
+    use warnings ;
+    use DB_File ;
+    my %hash ;
+    my $filename = "/tmp/filt" ;
+    unlink $filename ;
 
 
     my $db = tie %hash, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_HASH 
-      or die "Cannot open $filename: $!\n";
+      or die "Cannot open $filename: $!\n" ;
 
-    $db->filter_fetch_key  ( sub { $_ = unpack('i', $_) } );
-    $db->filter_store_key  ( sub { $_ = pack  ('i', $_) } );
-    $hash{123} = 'def';
+    $db->filter_fetch_key  ( sub { $_ = unpack("i", $_) } ) ;
+    $db->filter_store_key  ( sub { $_ = pack ("i", $_) } ) ;
+    $hash{123} = "def" ;
     # ...
-    undef $db;
-    untie %hash;
+    undef $db ;
+    untie %hash ;
 
 The code above uses DB_File, but again it will work with any of the
 DBM modules.
diff --git a/pod/perldsc.pod b/pod/perldsc.pod
index c7c1be2..5ab97e1 100644
--- a/pod/perldsc.pod
+++ b/pod/perldsc.pod
@@ -18,11 +18,11 @@ The 5.0 release of Perl let us have complex data structures.  You
 may now write something like this and all of a sudden, you'd have a array
 with three dimensions!
 
-    my @AoA;
-    for my $x (1 .. 10) {
-	for my $y (1 .. 10) {
-	    for my $z (1 .. 10) {
-		$AoA[$x][$y][$z] = $x ** $y + $z;
+    for $x (1 .. 10) {
+	for $y (1 .. 10) {
+	    for $z (1 .. 10) {
+		$AoA[$x][$y][$z] =
+		    $x ** $y + $z;
 	    }
 	}
     }
@@ -102,11 +102,7 @@ Now, because the top level contains only references, if you try to print
 out your array in with a simple print() function, you'll get something
 that doesn't look very nice, like this:
 
-    my @AoA = (
-               [2, 3,  ],
-               [4, 5, 7],
-               [0,     ],
-              );
+    @AoA = ( [2, 3], [4, 5, 7], [0] );
     print $AoA[1][2];
   7
     print @AoA;
@@ -127,46 +123,79 @@ elements or else taking a reference to the same memory location
 repeatedly.  Here's the case where you just get the count instead
 of a nested array:
 
-    my @AoA;
-    for my $i (1..10) {
-	my @array   = somefunc($i);
-	   $AoA[$i] = @array;       # WRONG!
+    for $i (1..10) {
+	@array = somefunc($i);
+	$AoA[$i] = @array;	# WRONG!
     }
 
 That's just the simple case of assigning an array to a scalar and getting
 its element count.  If that's what you really and truly want, then you
 might do well to consider being a tad more explicit about it, like this:
 
-    my @counts;
-    for my $i (1..10) {
-	my @array      = somefunc($i);
-	   $counts[$i] = scalar @array;
+    for $i (1..10) {
+	@array = somefunc($i);
+	$counts[$i] = scalar @array;
     }
 
-Here's the right way to do the reference C<@array>:
+Here's the case of taking a reference to the same memory location
+again and again:
 
-    my @AoA
-    for my $i (1..10) {
-	my @array   = somefunc($i);
-	   $AoA[$i] = [ @array ];
+    for $i (1..10) {
+	@array = somefunc($i);
+	$AoA[$i] = \@array;	# WRONG!
+    }
+
+So, what's the big problem with that?  It looks right, doesn't it?
+After all, I just told you that you need an array of references, so by
+golly, you've made me one!
+
+Unfortunately, while this is true, it's still broken.  All the references
+in @AoA refer to the I<very same place>, and they will therefore all hold
+whatever was last in @array!  It's similar to the problem demonstrated in
+the following C program:
+
+    #include <pwd.h>
+    main() {
+	struct passwd *getpwnam(), *rp, *dp;
+	rp = getpwnam("root");
+	dp = getpwnam("daemon");
+
+	printf("daemon name is %s\nroot name is %s\n",
+		dp->pw_name, rp->pw_name);
+    }
+
+Which will print
+
+    daemon name is daemon
+    root name is daemon
+
+The problem is that both C<rp> and C<dp> are pointers to the same location
+in memory!  In C, you'd have to remember to malloc() yourself some new
+memory.  In Perl, you'll want to use the array constructor C<[]> or the
+hash constructor C<{}> instead.   Here's the right way to do the preceding
+broken code fragments:
+
+    for $i (1..10) {
+	@array = somefunc($i);
+	$AoA[$i] = [ @array ];
     }
 
 The square brackets make a reference to a new array with a I<copy>
-of what's in C<@array>.
+of what's in @array at the time of the assignment.  This is what
+you want.
 
 Note that this will produce something similar, but it's
 much harder to read:
 
-    my @AoA;
-    for my $i (1..10) {
-	my @array        = somefunc($i);
-	   @{ $AoA[$i] } = @array;
+    for $i (1..10) {
+	@array = 0 .. $i;
+	@{$AoA[$i]} = @array;
     }
 
 Is it the same?  Well, maybe so--and maybe not.  The subtle difference
 is that when you assign something in square brackets, you know for sure
 it's always a brand new reference with a new I<copy> of the data.
-Something else could be going on in this new case with the C<@{ $AoA[$i]} }>
+Something else could be going on in this new case with the C<@{$AoA[$i]}}>
 dereference on the left-hand-side of the assignment.  It all depends on
 whether C<$AoA[$i]> had been undefined to start with, or whether it
 already contained a reference.  If you had already populated @AoA with
@@ -177,7 +206,7 @@ references, as in
 Then the assignment with the indirection on the left-hand-side would
 use the existing reference that was already there:
 
-    @{ $AoA[3] } = @array;
+    @{$AoA[3]} = @array;
 
 Of course, this I<would> have the "interesting" effect of clobbering
 @another_array.  (Have you ever noticed how when a programmer says
@@ -192,10 +221,9 @@ efficient.
 Surprisingly, the following dangerous-looking construct will
 actually work out fine:
 
-    my @AoA;
-    for my $i (1..10) {
-        my @array   = somefunc($i);
-           $AoA[$i] = \@array;
+    for $i (1..10) {
+        my @array = somefunc($i);
+        $AoA[$i] = \@array;
     }
 
 That's because my() is more of a run-time statement than it is a
@@ -214,14 +242,14 @@ do the right thing behind the scenes.
 
 In summary:
 
-    $AoA[$i]      = [ @array ];	# usually best
-    $AoA[$i]      =  \@array;	# perilous; just how my() is that array?
-    @{ $AoA[$i] } =   @array;	# way too tricky for most programmers
+    $AoA[$i] = [ @array ];	# usually best
+    $AoA[$i] = \@array;		# perilous; just how my() was that array?
+    @{ $AoA[$i] } = @array;	# way too tricky for most programmers
 
 
 =head1 CAVEAT ON PRECEDENCE
 
-Speaking of things like C<@{ $AoA[$i] }>, the following are actually the
+Speaking of things like C<@{$AoA[$i]}>, the following are actually the
 same thing:
 
     $aref->[2][2]	# clear
@@ -256,9 +284,9 @@ also disallow accidental "symbolic dereferencing".  Therefore if you'd done
 this:
 
     my $aref = [
-	[ 'fred',   'barney', 'pebbles', 'bambam', 'dino', ],
-	[ 'homer',  'bart',   'marge',   'maggie',         ],
-	[ 'george', 'jane',   'elroy',   'judy',           ],
+	[ "fred", "barney", "pebbles", "bambam", "dino", ],
+	[ "homer", "bart", "marge", "maggie", ],
+	[ "george", "jane", "elroy", "judy", ],
     ];
 
     print $aref[2][2];
@@ -306,60 +334,55 @@ types of data structures.
 
 =head2 Declaration of a ARRAY OF ARRAYS
 
- my @AoA = (
-        [ 'fred',   'barney'         ],
-        [ 'george', 'jane',  'elroy' ],
-        [ 'homer',  'marge', 'bart'  ],
+ @AoA = (
+        [ "fred", "barney" ],
+        [ "george", "jane", "elroy" ],
+        [ "homer", "marge", "bart" ],
       );
 
 =head2 Generation of a ARRAY OF ARRAYS
 
  # reading from file
- my @AoA;
  while ( <> ) {
      push @AoA, [ split ];
  }
 
  # calling a function
- my @AoA;
- foreach my $i ( 1 .. 10 ) {
+ for $i ( 1 .. 10 ) {
      $AoA[$i] = [ somefunc($i) ];
  }
 
  # using temp vars
- my @AoA;
- foreach my $i ( 1 .. 10 ) {
-     my @tmp     = somefunc($i);
-        $AoA[$i] = [ @tmp ];
+ for $i ( 1 .. 10 ) {
+     @tmp = somefunc($i);
+     $AoA[$i] = [ @tmp ];
  }
 
  # add to an existing row
- push @{ $AoA[0] }, 'wilma', 'betty';
+ push @{ $AoA[0] }, "wilma", "betty";
 
 =head2 Access and Printing of a ARRAY OF ARRAYS
 
- my @AoA;
-
  # one element
- $AoA[0][0] = 'Fred';
+ $AoA[0][0] = "Fred";
 
  # another element
  $AoA[1][1] =~ s/(\w)/\u$1/;
 
  # print the whole thing with refs
- foreach my $aref ( @AoA ) {
+ for $aref ( @AoA ) {
      print "\t [ @$aref ],\n";
  }
 
  # print the whole thing with indices
- foreach my $i ( 0 .. $#AoA ) {
-     print "\t [ @{ $AoA[$i] } ],\n";
+ for $i ( 0 .. $#AoA ) {
+     print "\t [ @{$AoA[$i]} ],\n";
  }
 
  # print the whole thing one at a time
- foreach my $i ( 0 .. $#AoA ) {
-     foreach my $j ( 0 .. $#{ $AoA[$i] } ) {
-         print "element $i $j is $AoA[$i][$j]\n";
+ for $i ( 0 .. $#AoA ) {
+     for $j ( 0 .. $#{ $AoA[$i] } ) {
+         print "elt $i $j is $AoA[$i][$j]\n";
      }
  }
 
@@ -367,86 +390,77 @@ types of data structures.
 
 =head2 Declaration of a HASH OF ARRAYS
 
- my %HoA = (
-        flintstones => [ 'fred',   'barney'         ],
-        jetsons     => [ 'george', 'jane',  'elroy' ],
-        simpsons    => [ 'homer',  'marge', 'bart'  ],
+ %HoA = (
+        flintstones        => [ "fred", "barney" ],
+        jetsons            => [ "george", "jane", "elroy" ],
+        simpsons           => [ "homer", "marge", "bart" ],
       );
 
 =head2 Generation of a HASH OF ARRAYS
 
  # reading from file
  # flintstones: fred barney wilma dino
- my %HoA;
  while ( <> ) {
-     next unless s/^([^:]*):\s*//;
+     next unless s/^(.*?):\s*//;
      $HoA{$1} = [ split ];
  }
 
  # reading from file; more temps
  # flintstones: fred barney wilma dino
- my %HoA;
- while ( my $line = <> ) {
-     my ($who, $rest) = split /:\s*/, $line, 2;
-     my @fields       = split ' ', $rest;
-        $HoA{$who}    = [ @fields ];
+ while ( $line = <> ) {
+     ($who, $rest) = split /:\s*/, $line, 2;
+     @fields = split ' ', $rest;
+     $HoA{$who} = [ @fields ];
  }
 
  # calling a function that returns a list
- my %HoA;
- foreach my $group ( 'simpsons', 'jetsons', 'flintstones' ) {
+ for $group ( "simpsons", "jetsons", "flintstones" ) {
      $HoA{$group} = [ get_family($group) ];
  }
 
  # likewise, but using temps
- my %HoA;
- foreach my $group ( 'simpsons', 'jetsons', 'flintstones' ) {
-     my @members     = get_family($group);
-        $HoA{$group} = [ @members ];
+ for $group ( "simpsons", "jetsons", "flintstones" ) {
+     @members = get_family($group);
+     $HoA{$group} = [ @members ];
  }
 
  # append new members to an existing family
- push @{ $HoA{flintstones} }, 'wilma', 'betty';
+ push @{ $HoA{"flintstones"} }, "wilma", "betty";
 
 =head2 Access and Printing of a HASH OF ARRAYS
 
- my %HoA;
-
  # one element
- $HoA{flintstones}[0] = 'Fred';
+ $HoA{flintstones}[0] = "Fred";
 
  # another element
  $HoA{simpsons}[1] =~ s/(\w)/\u$1/;
 
  # print the whole thing
- foreach my $family ( keys %HoA ) {
-     print "$family: @{ $HoA{$family} }\n";
+ foreach $family ( keys %HoA ) {
+     print "$family: @{ $HoA{$family} }\n"
  }
 
  # print the whole thing with indices
- foreach my $family ( keys %HoA ) {
-     print 'family: ';
-     foreach my $i ( 0 .. $#{ $HoA{$family} } ) {
+ foreach $family ( keys %HoA ) {
+     print "family: ";
+     foreach $i ( 0 .. $#{ $HoA{$family} } ) {
          print " $i = $HoA{$family}[$i]";
      }
      print "\n";
  }
 
  # print the whole thing sorted by number of members
- sub num_members {
-   @{ $HoA{$b} } <=> @{ $HoA{$a} }
- }
- foreach my $family ( sort num_members keys %HoA ) {
+ foreach $family ( sort { @{$HoA{$b}} <=> @{$HoA{$a}} } keys %HoA ) {
      print "$family: @{ $HoA{$family} }\n"
  }
 
  # print the whole thing sorted by number of members and name
- sub members_and_name {
-   @{ $HoA{$b} } <=> @{ $HoA{$a} }
-		 ||
-	      $a cmp $b
- }
- foreach my $family ( sort members_and_name keys %HoA ) {
+ foreach $family ( sort {
+			    @{$HoA{$b}} <=> @{$HoA{$a}}
+					||
+				    $a cmp $b
+	    } keys %HoA )
+ {
      print "$family: ", join(", ", sort @{ $HoA{$family} }), "\n";
  }
 
@@ -454,20 +468,20 @@ types of data structures.
 
 =head2 Declaration of a ARRAY OF HASHES
 
- my @AoH = (
+ @AoH = (
         {
-            Lead     => 'fred',
-            Friend   => 'barney',
+            Lead     => "fred",
+            Friend   => "barney",
         },
         {
-            Lead     => 'george',
-            Wife     => 'jane',
-            Son      => 'elroy',
+            Lead     => "george",
+            Wife     => "jane",
+            Son      => "elroy",
         },
         {
-            Lead     => 'homer',
-            Wife     => 'marge',
-            Son      => 'bart',
+            Lead     => "homer",
+            Wife     => "marge",
+            Son      => "bart",
         }
   );
 
@@ -475,12 +489,11 @@ types of data structures.
 
  # reading from file
  # format: LEAD=fred FRIEND=barney
- my @AoH;
  while ( <> ) {
-     my $rec = {};
-     foreach my $field ( split ) {
-         my($key, $value) = split /=/, $field;
-         $rec->{$key}     = $value;
+     $rec = {};
+     for $field ( split ) {
+         ($key, $value) = split /=/, $field;
+         $rec->{$key} = $value;
      }
      push @AoH, $rec;
  }
@@ -489,60 +502,55 @@ types of data structures.
  # reading from file
  # format: LEAD=fred FRIEND=barney
  # no temp
- my @AoH;
  while ( <> ) {
      push @AoH, { split /[\s+=]/ };
  }
 
  # calling a function  that returns a key/value pair list, like
- # lead => 'fred', daughter => 'pebbles'
- my @AoH;
- while ( my %fields = getnextpairset() ) {
+ # "lead","fred","daughter","pebbles"
+ while ( %fields = getnextpairset() ) {
      push @AoH, { %fields };
  }
 
  # likewise, but using no temp vars
- my @AoH;
  while (<>) {
      push @AoH, { parsepairs($_) };
  }
 
  # add key/value to an element
- $AoH[0]{pet} = 'dino';
+ $AoH[0]{pet} = "dino";
  $AoH[2]{pet} = "santa's little helper";
 
 =head2 Access and Printing of a ARRAY OF HASHES
 
- my @AoH;
-
  # one element
- $AoH[0]{lead} = 'fred';
+ $AoH[0]{lead} = "fred";
 
  # another element
  $AoH[1]{lead} =~ s/(\w)/\u$1/;
 
  # print the whole thing with refs
- foreach my $href ( @AoH ) {
-     print '{ ';
-     foreach my $role ( keys %$href ) {
-         print "$role = $href->{$role} ";
+ for $href ( @AoH ) {
+     print "{ ";
+     for $role ( keys %$href ) {
+         print "$role=$href->{$role} ";
      }
      print "}\n";
  }
 
  # print the whole thing with indices
- foreach my $i ( 0 .. $#AoH ) {
+ for $i ( 0 .. $#AoH ) {
      print "$i is { ";
-     foreach my $role ( keys %{ $AoH[$i] } ) {
-         print "$role = $AoH[$i]{$role} ";
+     for $role ( keys %{ $AoH[$i] } ) {
+         print "$role=$AoH[$i]{$role} ";
      }
      print "}\n";
  }
 
  # print the whole thing one at a time
- foreach my $i ( 0 .. $#AoH ) {
-     foreach my $role ( keys %{ $AoH[$i] } ) {
-         print "element $i $role is $AoH[$i]{$role}\n";
+ for $i ( 0 .. $#AoH ) {
+     for $role ( keys %{ $AoH[$i] } ) {
+         print "elt $i $role is $AoH[$i]{$role}\n";
      }
  }
 
@@ -550,20 +558,20 @@ types of data structures.
 
 =head2 Declaration of a HASH OF HASHES
 
- my %HoH = (
+ %HoH = (
         flintstones => {
-		lead      => 'fred',
-		pal       => 'barney',
+		lead      => "fred",
+		pal       => "barney",
         },
         jetsons     => {
-		lead      => 'george',
-		wife      => 'jane',
-		'his boy' => 'elroy',
+		lead      => "george",
+		wife      => "jane",
+		"his boy" => "elroy",
         },
         simpsons    => {
-		lead      => 'homer',
-		wife      => 'marge',
-		kid       => 'bart',
+		lead      => "homer",
+		wife      => "marge",
+		kid       => "bart",
 	},
  );
 
@@ -571,113 +579,94 @@ types of data structures.
 
  # reading from file
  # flintstones: lead=fred pal=barney wife=wilma pet=dino
- my %HoH;
  while ( <> ) {
-     next unless s/^([^:]*):\s*//;
-     my $who = $1;
-     for my $field ( split ) {
-         my($key, $value) = split /=/, $field;
+     next unless s/^(.*?):\s*//;
+     $who = $1;
+     for $field ( split ) {
+         ($key, $value) = split /=/, $field;
          $HoH{$who}{$key} = $value;
      }
 
 
  # reading from file; more temps
- my %HoH;
  while ( <> ) {
-     next unless s/^([^:]*):\s*//;
-     my $who = $1;
-     my $rec = {};
+     next unless s/^(.*?):\s*//;
+     $who = $1;
+     $rec = {};
      $HoH{$who} = $rec;
-     foreach my $field ( split ) {
-         my($key, $value) = split /=/, $field;
-         $rec->{$key}     = $value;
+     for $field ( split ) {
+         ($key, $value) = split /=/, $field;
+         $rec->{$key} = $value;
      }
  }
 
  # calling a function  that returns a key,value hash
- my %HoH;
- foreach my $group ( 'simpsons', 'jetsons', 'flintstones' ) {
+ for $group ( "simpsons", "jetsons", "flintstones" ) {
      $HoH{$group} = { get_family($group) };
  }
 
  # likewise, but using temps
- my %HoH;
- foreach my $group ( 'simpsons', 'jetsons', 'flintstones' ) {
-     my %members  = get_family($group);
+ for $group ( "simpsons", "jetsons", "flintstones" ) {
+     %members = get_family($group);
      $HoH{$group} = { %members };
  }
 
  # append new members to an existing family
- my %HoH;
- my %new_folks = (
-     wife => 'wilma',
-     pet  => 'dino',
+ %new_folks = (
+     wife => "wilma",
+     pet  => "dino",
  );
 
- foreach my $what (keys %new_folks) {
+ for $what (keys %new_folks) {
      $HoH{flintstones}{$what} = $new_folks{$what};
  }
 
 =head2 Access and Printing of a HASH OF HASHES
 
- %HoH;
-
  # one element
- $HoH{flintstones}{wife} = 'wilma';
+ $HoH{flintstones}{wife} = "wilma";
 
  # another element
  $HoH{simpsons}{lead} =~ s/(\w)/\u$1/;
 
  # print the whole thing
- foreach my $family ( keys %HoH ) {
+ foreach $family ( keys %HoH ) {
      print "$family: { ";
-     foreach my $role ( keys %{ $HoH{$family} } ) {
-         print "$role = $HoH{$family}{$role} ";
+     for $role ( keys %{ $HoH{$family} } ) {
+         print "$role=$HoH{$family}{$role} ";
      }
      print "}\n";
  }
 
  # print the whole thing  somewhat sorted
- foreach my $family ( sort keys %HoH ) {
+ foreach $family ( sort keys %HoH ) {
      print "$family: { ";
-     foreach my $role ( sort keys %{ $HoH{$family} } ) {
-         print "$role = $HoH{$family}{$role} ";
+     for $role ( sort keys %{ $HoH{$family} } ) {
+         print "$role=$HoH{$family}{$role} ";
      }
      print "}\n";
  }
 
+
  # print the whole thing sorted by number of members
- sub num_members {
-   keys %{ $HoH{$b} }  <=>  keys %{ $HoH{$a} }
- }
- foreach my $family ( sort num_members keys %HoH ) {
+ foreach $family ( sort { keys %{$HoH{$b}} <=> keys %{$HoH{$a}} } keys %HoH ) {
      print "$family: { ";
-     foreach my $role ( sort keys %{ $HoH{$family} } ) {
-         print "$role = $HoH{$family}{$role} ";
+     for $role ( sort keys %{ $HoH{$family} } ) {
+         print "$role=$HoH{$family}{$role} ";
      }
      print "}\n";
  }
 
  # establish a sort order (rank) for each role
- my %rank;
- my $i = 0;
- foreach ( qw(lead wife son daughter pal pet) ) {
-   $rank{$_} = ++$i;
- }
+ $i = 0;
+ for ( qw(lead wife son daughter pal pet) ) { $rank{$_} = ++$i }
 
  # now print the whole thing sorted by number of members
- sub num_members {
-   keys %{ $HoH{$b} }  <=>  keys %{ $HoH{$a} }
- }
- sub rank {
-   $rank{$a} <=> $rank{$b}
- }
-
- foreach my $family ( sort num_members keys %HoH ) {
+ foreach $family ( sort { keys %{ $HoH{$b} } <=> keys %{ $HoH{$a} } } keys %HoH ) {
      print "$family: { ";
      # and print these according to rank order
-     foreach my $role ( sort rank keys %{ $HoH{$family} } ) {
-         print "$role = $HoH{$family}{$role} ";
+     for $role ( sort { $rank{$a} <=> $rank{$b} }  keys %{ $HoH{$family} } ) {
+         print "$role=$HoH{$family}{$role} ";
      }
      print "}\n";
  }
@@ -690,7 +679,7 @@ types of data structures.
 Here's a sample showing how to create and use a record whose fields are of
 many different sorts:
 
-     my $rec = {
+     $rec = {
 	 TEXT      => $string,
 	 SEQUENCE  => [ @old_values ],
 	 LOOKUP    => { %some_table },
@@ -701,14 +690,14 @@ many different sorts:
 
      print $rec->{TEXT};
 
-     print $rec->{SEQUENCE}->[0];
-     my $last = pop @{ $rec->{SEQUENCE} };
+     print $rec->{SEQUENCE}[0];
+     $last = pop @ { $rec->{SEQUENCE} };
 
-     print $rec->{LOOKUP}->{key};
-     my($first_k, $first_v) = each %{ $rec->{LOOKUP} };
+     print $rec->{LOOKUP}{"key"};
+     ($first_k, $first_v) = each %{ $rec->{LOOKUP} };
 
-     my $answer = $rec->{THATCODE}->($arg);
-     my $result = $rec->{THISCODE}->($arg1, $arg2);
+     $answer = $rec->{THATCODE}->($arg);
+     $answer = $rec->{THISCODE}->($arg1, $arg2);
 
      # careful of extra block braces on fh ref
      print { $rec->{HANDLE} } "a string\n";
@@ -719,52 +708,55 @@ many different sorts:
 
 =head2 Declaration of a HASH OF COMPLEX RECORDS
 
-     my %TV = (
+     %TV = (
         flintstones => {
-            series   => 'flintstones',
+            series   => "flintstones",
             nights   => [ qw(monday thursday friday) ],
             members  => [
-                { name => 'fred',    role => 'lead', age  => 36, },
-                { name => 'wilma',   role => 'wife', age  => 31, },
-                { name => 'pebbles', role => 'kid',  age  =>  4, },
+                { name => "fred",    role => "lead", age  => 36, },
+                { name => "wilma",   role => "wife", age  => 31, },
+                { name => "pebbles", role => "kid",  age  =>  4, },
             ],
         },
 
         jetsons     => {
-            series   => 'jetsons',
+            series   => "jetsons",
             nights   => [ qw(wednesday saturday) ],
             members  => [
-                { name => 'george",  role => 'lead', age  => 41, },
-                { name => 'jane",    role => 'wife', age  => 39, },
-                { name => 'elroy",   role => 'kid',  age  =>  9, },
+                { name => "george",  role => "lead", age  => 41, },
+                { name => "jane",    role => "wife", age  => 39, },
+                { name => "elroy",   role => "kid",  age  =>  9, },
             ],
          },
 
         simpsons    => {
-            series   => 'simpsons',
+            series   => "simpsons",
             nights   => [ qw(monday) ],
             members  => [
-                { name => 'homer', role => 'lead', age => 34, },
-                { name => 'marge', role => 'wife', age => 37, },
-                { name => 'bart',  role => 'kid',  age => 11, },
+                { name => "homer", role => "lead", age  => 34, },
+                { name => "marge", role => "wife", age => 37, },
+                { name => "bart",  role => "kid",  age  =>  11, },
             ],
          },
       );
 
 =head2 Generation of a HASH OF COMPLEX RECORDS
 
-Here's a piece by piece build up of a hash of complex records.  We'll
-read in a file that has our data in it.
+     # reading from file
+     # this is most easily done by having the file itself be
+     # in the raw data format as shown above.  perl is happy
+     # to parse complex data structures if declared as data, so
+     # sometimes it's easiest to do that
 
-     my %TV  = ();
-     my $rec = {};
-     $rec->{series} = 'flintstones';
+     # here's a piece by piece build up
+     $rec = {};
+     $rec->{series} = "flintstones";
      $rec->{nights} = [ find_days() ];
 
-     my @members = ();
+     @members = ();
      # assume this file in field=value syntax
-     while ( <> ) {
-         my %fields = split /[\s=]+/, $_;
+     while (<>) {
+         %fields = split /[\s=]+/;
          push @members, { %fields };
      }
      $rec->{members} = [ @members ];
@@ -772,18 +764,19 @@ read in a file that has our data in it.
      # now remember the whole thing
      $TV{ $rec->{series} } = $rec;
 
-Now, you might want to make interesting extra fields that
-include pointers back into the same data structure so if
-change one piece, it changes everywhere, like for example
-if you wanted a 'kids' field that was a reference
-to an array of the kids' records without having duplicate
-records and thus update problems.
-
-     foreach my $family ( keys %TV ) {
-         my $rec  = $TV{$family}; # $rec points to $TV{$family}
-         my @kids = ();
-         foreach my $person ( @{ $rec->{members} } ) {
-             if ( $person->{role} =~ /kid|son|daughter/ ) {
+     ###########################################################
+     # now, you might want to make interesting extra fields that
+     # include pointers back into the same data structure so if
+     # change one piece, it changes everywhere, like for example
+     # if you wanted a {kids} field that was a reference
+     # to an array of the kids' records without having duplicate
+     # records and thus update problems.
+     ###########################################################
+     foreach $family (keys %TV) {
+         $rec = $TV{$family}; # temp pointer
+         @kids = ();
+         for $person ( @{ $rec->{members} } ) {
+             if ($person->{role} =~ /kid|son|daughter/) {
                  push @kids, $person;
              }
          }
@@ -791,33 +784,30 @@ records and thus update problems.
          $rec->{kids} = [ @kids ];
      }
 
-You copied the array, but the array itself contains pointers
-to uncopied objects. This means that if you make bart get
-older via
+     # you copied the array, but the array itself contains pointers
+     # to uncopied objects. this means that if you make bart get
+     # older via
 
      $TV{simpsons}{kids}[0]{age}++;
 
-Then this would also change in C<$TV{simpsons}{members}[2]{age}>
-because C<$TV{simpsons}{kids}[0]> and C<$TV{simpsons}{members}[2]>
-both point to the same underlying anonymous hash table.
+     # then this would also change in
+     print $TV{simpsons}{members}[2]{age};
 
-     # print the whole thing
-     foreach my $family ( keys %TV ) {
-         print "the $family is on during @{ $TV{$family}{nights} }\n",
-               "its members are:\n";
+     # because $TV{simpsons}{kids}[0] and $TV{simpsons}{members}[2]
+     # both point to the same underlying anonymous hash table
 
-         foraech my $who ( @{ $TV{$family}{members} } ) {
+     # print the whole thing
+     foreach $family ( keys %TV ) {
+         print "the $family";
+         print " is on during @{ $TV{$family}{nights} }\n";
+         print "its members are:\n";
+         for $who ( @{ $TV{$family}{members} } ) {
              print " $who->{name} ($who->{role}), age $who->{age}\n";
          }
-
-         print "it turns out that $TV{$family}{lead} has ",
-               scalar ( @{ $TV{$family}{kids} } ),
-               ' kids named ',
-               join(
-                    ', ',
-                    map { $_->{name} } @{ $TV{$family}{kids} }
-                   ),
-               "\n";
+         print "it turns out that $TV{$family}{lead} has ";
+         print scalar ( @{ $TV{$family}{kids} } ), " kids named ";
+         print join (", ", map { $_->{name} } @{ $TV{$family}{kids} } );
+         print "\n";
      }
 
 =head1 Database Ties
@@ -838,8 +828,5 @@ perlref(1), perllol(1), perldata(1), perlobj(1)
 
 Tom Christiansen <F<tchrist@perl.com>>
 
-Last update (by Tom):
+Last update:
 Wed Oct 23 04:57:50 MET DST 1996
-
-Last update (by Casey West, <F<casey@geeknest.com>>
-Mon Sep 17 13:33:41 EDT 2001
diff --git a/pod/perlebcdic.pod b/pod/perlebcdic.pod
index be2a2e3..c98b46c 100644
--- a/pod/perlebcdic.pod
+++ b/pod/perlebcdic.pod
@@ -130,29 +130,8 @@ work with a pod2_other_format translation) through:
 
 =back
 
-    perldoc -m perlebcdic |                                  \
-    perl -ne 'if(/(.{33})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/)'    \
-          -e '{printf("%s%-9o%-9o%-9o%o\n",$1,$2,$3,$4,$5)}'
-
-Or, as a script, called like C<perldoc -m perlebcdic | extract.pl>:
-
-    my $regex = qr/
-                   (.{33})     # any 33 characters
-
-                   (\d+)\s+    # capture some digits, discard spaces
-                   (\d+)\s+    # ".."
-                   (\d+)\s+    # ".."
-                   (\d+)       # capture some digits
-                  /x;
-
-    while ( <> ) {
-      if ( $_ =~ $regex ) {
-        printf(
-               "%s%-9o%-9o%-9o%o\n",
-               $1, $2, $3, $4, $5,
-              );
-      }
-    }
+    perl -ne 'if(/(.{33})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/)' \
+     -e '{printf("%s%-9o%-9o%-9o%o\n",$1,$2,$3,$4,$5)}' perlebcdic.pod
 
 If you want to retain the UTF-x code points then in script form you
 might want to write:
@@ -163,47 +142,20 @@ might want to write:
 
 =back
 
-    my $regex = qr/
-                   (.{33})       # $1: any 33 characters
-
-                   (\d+)\s+      # $2, $3, $4, $5:
-                   (\d+)\s+      # capture some digits, discard spaces
-                   (\d+)\s+      # 4 times
-                   (\d+)\s+
-
-                   (\d+)         # $6: capture some digits,
-                   \.?           # there may be a period,
-                   (\d*)         # $7: capture some digits if they're there,
-                   \s+           # discard spaces
-
-                   (\d+)         # $8: capture some digits
-                   \.?           # there may be a period,
-                   (\d*)         # $9: capture some digits if they're there,
-                  /x;
-
-    open( FH, 'perldoc -m perlebcdic |' ) ||
-        die "Could not open perlebcdic.pod: $!";
-    while ( <FH> ) {
-        if ( $_ =~ $regex )  {
-            if ( $7 ne '' && $9 ne '' ) {
-                printf(
-                       "%s%-9o%-9o%-9o%-9o%-3o.%-5o%-3o.%o\n",
-                       $1, $2, $3, $4, $5, $6, $7, $8, $9
-                      );
-            } elsif ( $7 ne '' ) {
-                printf(
-                       "%s%-9o%-9o%-9o%-9o%-3o.%-5o%o\n",
-                       $1, $2, $3, $4, $5, $6, $7, $8
-                      );
-            } else {
-                printf(
-                       "%s%-9o%-9o%-9o%-9o%-9o%o\n",
-                       $1, $2, $3, $4, $5, $6, $8
-                      );
+    open(FH,"<perlebcdic.pod") or die "Could not open perlebcdic.pod: $!";
+    while (<FH>) {
+        if (/(.{33})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\.?(\d*)\s+(\d+)\.?(\d*)/)  {
+            if ($7 ne '' && $9 ne '') {
+                printf("%s%-9o%-9o%-9o%-9o%-3o.%-5o%-3o.%o\n",$1,$2,$3,$4,$5,$6,$7,$8,$9);
+            }
+            elsif ($7 ne '') {
+                printf("%s%-9o%-9o%-9o%-9o%-3o.%-5o%o\n",$1,$2,$3,$4,$5,$6,$7,$8);
+            }
+            else {
+                printf("%s%-9o%-9o%-9o%-9o%-9o%o\n",$1,$2,$3,$4,$5,$6,$8);
             }
         }
     }
-    close FH;
 
 If you would rather see this table listing hexadecimal values then
 run the table through:
@@ -214,9 +166,8 @@ run the table through:
 
 =back
 
-    perldoc -m perlebcdic |                                  \
-    perl -ne 'if(/(.{33})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/)'    \
-          -e '{printf("%s%-9X%-9X%-9X%X\n",$1,$2,$3,$4,$5)}'
+    perl -ne 'if(/(.{33})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/)' \
+     -e '{printf("%s%-9X%-9X%-9X%X\n",$1,$2,$3,$4,$5)}' perlebcdic.pod
 
 Or, in order to retain the UTF-x code points in hexadecimal:
 
@@ -226,50 +177,21 @@ Or, in order to retain the UTF-x code points in hexadecimal:
 
 =back
 
-    my $regex = qr/
-                   (.{33})       # $1: any 33 characters
-
-                   (\d+)\s+      # $2, $3, $4, $5:
-                   (\d+)\s+      # capture some digits, discard spaces
-                   (\d+)\s+      # 4 times
-                   (\d+)\s+
-
-                   (\d+)         # $6: capture some digits,
-                   \.?           # there may be a period,
-                   (\d*)         # $7: capture some digits if they're there,
-                   \s+           # discard spaces
-
-                   (\d+)         # $8: capture some digits
-                   \.?           # there may be a period,
-                   (\d*)         # $9: capture some digits if they're there,
-                  /x;
-
-    open( FH, 'perldoc -m perlebcdic |' ) ||
-        die "Could not open perlebcdic.pod: $!";
+    open(FH,"<perlebcdic.pod") or die "Could not open perlebcdic.pod: $!";
     while (<FH>) {
-        if ( $_ =~ $regex )  {
-            if ( $7 ne '' && $9 ne '' ) {
-                printf(
-                       "%s%-9X%-9X%-9X%-9X%-2X.%-6X%-2X.%X\n",
-                       $1, $2, $3, $4, $5, $6, $7, $8, $9
-                      );
+        if (/(.{33})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\.?(\d*)\s+(\d+)\.?(\d*)/)  {
+            if ($7 ne '' && $9 ne '') {
+                printf("%s%-9X%-9X%-9X%-9X%-2X.%-6X%-2X.%X\n",$1,$2,$3,$4,$5,$6,$7,$8,$9);
             }
-            elsif ( $7 ne '' ) {
-                printf(
-                       "%s%-9X%-9X%-9X%-9X%-2X.%-6X%X\n",
-                       $1, $2, $3, $4, $5, $6, $7, $8
-                      );
+            elsif ($7 ne '') {
+                printf("%s%-9X%-9X%-9X%-9X%-2X.%-6X%X\n",$1,$2,$3,$4,$5,$6,$7,$8);
             }
             else {
-                printf(
-                       "%s%-9X%-9X%-9X%-9X%-9X%X\n",
-                       $1, $2, $3, $4, $5, $6, $8
-                      );
+                printf("%s%-9X%-9X%-9X%-9X%-9X%X\n",$1,$2,$3,$4,$5,$6,$8);
             }
         }
     }
 
-=head2 THE SINGLE OCTET TABLE
 
                                                                      incomp-  incomp-
                                  8859-1                              lete     lete
@@ -532,7 +454,6 @@ Or, in order to retain the UTF-x code points in hexadecimal:
     <SMALL LETTER thorn>         254      142      142      142      195.190  139.114
     <y WITH DIAERESIS>           255      223      223      223      195.191  139.115
 
-
 If you would rather see the above table in CCSID 0037 order rather than
 ASCII + Latin-1 order then run the table through:
 
@@ -542,12 +463,11 @@ ASCII + Latin-1 order then run the table through:
 
 =back
 
-    perldoc -m perlebcdic |                                                 \
-    perl -ne 'if(/.{33}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}/)' \
-          -e '{push(@l,$_)}'                                                \
-          -e 'END{print map{$_->[0]}'                                       \
-          -e 'sort{$a->[1] <=> $b->[1]}'                                    \
-          -e 'map{[$_,substr($_,42,3)]}@l;}'
+    perl -ne 'if(/.{33}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}/)'\
+     -e '{push(@l,$_)}' \
+     -e 'END{print map{$_->[0]}' \
+     -e '          sort{$a->[1] <=> $b->[1]}' \
+     -e '          map{[$_,substr($_,42,3)]}@l;}' perlebcdic.pod
 
 If you would rather see it in CCSID 1047 order then change the digit
 42 in the last line to 51, like this:
@@ -558,12 +478,11 @@ If you would rather see it in CCSID 1047 order then change the digit
 
 =back
 
-    perldoc -m perlebcdic |                                                 \
-    perl -ne 'if(/.{33}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}/)' \
-          -e '{push(@l,$_)}'                                                \
-          -e 'END{print map{$_->[0]}'                                       \
-          -e 'sort{$a->[1] <=> $b->[1]}'                                    \
-          -e 'map{[$_,substr($_,51,3)]}@l;}'
+    perl -ne 'if(/.{33}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}/)'\
+     -e '{push(@l,$_)}' \
+     -e 'END{print map{$_->[0]}' \
+     -e '          sort{$a->[1] <=> $b->[1]}' \
+     -e '          map{[$_,substr($_,51,3)]}@l;}' perlebcdic.pod
 
 If you would rather see it in POSIX-BC order then change the digit
 51 in the last line to 60, like this:
@@ -574,12 +493,11 @@ If you would rather see it in POSIX-BC order then change the digit
 
 =back
 
-    perldoc -m  perlebcdic |                                                \
-    perl -ne 'if(/.{33}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}/)' \
-          -e '{push(@l,$_)}'                                                \
-          -e 'END{print map{$_->[0]}'                                       \
-          -e 'sort{$a->[1] <=> $b->[1]}'                                    \
-          -e 'map{[$_,substr($_,60,3)]}@l;}'
+    perl -ne 'if(/.{33}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}/)'\
+     -e '{push(@l,$_)}' \
+     -e 'END{print map{$_->[0]}' \
+     -e '          sort{$a->[1] <=> $b->[1]}' \
+     -e '          map{[$_,substr($_,60,3)]}@l;}' perlebcdic.pod
 
 
 =head1 IDENTIFYING CHARACTER CODE SETS
@@ -588,44 +506,44 @@ To determine the character set you are running under from perl one
 could use the return value of ord() or chr() to test one or more 
 character values.  For example:
 
-    my $is_ascii  = "A" eq chr(65);
-    my $is_ebcdic = "A" eq chr(193);
+    $is_ascii  = "A" eq chr(65);
+    $is_ebcdic = "A" eq chr(193);
 
 Also, "\t" is a C<HORIZONTAL TABULATION> character so that:
 
-    my $is_ascii  = ord("\t") == 9;
-    my $is_ebcdic = ord("\t") == 5;
+    $is_ascii  = ord("\t") == 9;
+    $is_ebcdic = ord("\t") == 5;
 
 To distinguish EBCDIC code pages try looking at one or more of
 the characters that differ between them.  For example:
 
-    my $is_ebcdic_37   = "\n" eq chr(37);
-    my $is_ebcdic_1047 = "\n" eq chr(21);
+    $is_ebcdic_37   = "\n" eq chr(37);
+    $is_ebcdic_1047 = "\n" eq chr(21);
 
 Or better still choose a character that is uniquely encoded in any
 of the code sets, e.g.:
 
-    my $is_ascii           = ord('[') == 91;
-    my $is_ebcdic_37       = ord('[') == 186;
-    my $is_ebcdic_1047     = ord('[') == 173;
-    my $is_ebcdic_POSIX_BC = ord('[') == 187;
+    $is_ascii           = ord('[') == 91;
+    $is_ebcdic_37       = ord('[') == 186;
+    $is_ebcdic_1047     = ord('[') == 173;
+    $is_ebcdic_POSIX_BC = ord('[') == 187;
 
 However, it would be unwise to write tests such as:
 
-    my $is_ascii = "\r" ne chr(13);  #  WRONG
-    my $is_ascii = "\n" ne chr(10);  #  ILL ADVISED
+    $is_ascii = "\r" ne chr(13);  #  WRONG
+    $is_ascii = "\n" ne chr(10);  #  ILL ADVISED
 
 Obviously the first of these will fail to distinguish most ASCII machines
-from either a CCSID 0037, a 1047, or a POSIX-BC EBCDIC machine since "\r" eq
-chr(13) under all of those coded character sets.  But note too that
-because "\n" is chr(13) and "\r" is chr(10) on the MacIntosh (which is an
+from either a CCSID 0037, a 1047, or a POSIX-BC EBCDIC machine since "\r" eq 
+chr(13) under all of those coded character sets.  But note too that 
+because "\n" is chr(13) and "\r" is chr(10) on the MacIntosh (which is an 
 ASCII machine) the second C<$is_ascii> test will lead to trouble there.
 
-To determine whether or not perl was built under an EBCDIC
+To determine whether or not perl was built under an EBCDIC 
 code page you can use the Config module like so:
 
     use Config;
-    my $is_ebcdic = $Config{'ebcdic'} eq 'define';
+    $is_ebcdic = $Config{'ebcdic'} eq 'define';
 
 =head1 CONVERSIONS
 
@@ -638,30 +556,29 @@ The data in the table are in ASCII order hence the EBCDIC columns
 provide easy to use ASCII to EBCDIC operations that are also easily 
 reversed.
 
-For example, to convert ASCII to code page 037 take the output of the second
-column from the output of recipe 0 (modified to add \\ characters) and use
+For example, to convert ASCII to code page 037 take the output of the second 
+column from the output of recipe 0 (modified to add \\ characters) and use 
 it in tr/// like so:
 
-    my $cp_037 = join '',
-     qq[\000\001\002\003\234\011\206\177\227\215\216\013\014\015\016\017],
-     qq[\020\021\022\023\235\205\010\207\030\031\222\217\034\035\036\037],
-     qq[\200\201\202\203\204\012\027\033\210\211\212\213\214\005\006\007],
-     qq[\220\221\026\223\224\225\226\004\230\231\232\233\024\025\236\032],
-     qq[\040\240\342\344\340\341\343\345\347\361\242\056\074\050\053\174],
-     qq[\046\351\352\353\350\355\356\357\354\337\041\044\052\051\073\254],
-     qq[\055\057\302\304\300\301\303\305\307\321\246\054\045\137\076\077],
-     qq[\370\311\312\313\310\315\316\317\314\140\072\043\100\047\075\042],
-     qq[\330\141\142\143\144\145\146\147\150\151\253\273\360\375\376\261],
-     qq[\260\152\153\154\155\156\157\160\161\162\252\272\346\270\306\244],
-     qq[\265\176\163\164\165\166\167\170\171\172\241\277\320\335\336\256],
-     qq[\136\243\245\267\251\247\266\274\275\276\133\135\257\250\264\327],
-     qq[\173\101\102\103\104\105\106\107\110\111\255\364\366\362\363\365],
-     qq[\175\112\113\114\115\116\117\120\121\122\271\373\374\371\372\377],
-     qq[\134\367\123\124\125\126\127\130\131\132\262\324\326\322\323\325],
-     qq[\060\061\062\063\064\065\066\067\070\071\263\333\334\331\332\237];
+    $cp_037 = 
+    '\000\001\002\003\234\011\206\177\227\215\216\013\014\015\016\017' .
+    '\020\021\022\023\235\205\010\207\030\031\222\217\034\035\036\037' .
+    '\200\201\202\203\204\012\027\033\210\211\212\213\214\005\006\007' .
+    '\220\221\026\223\224\225\226\004\230\231\232\233\024\025\236\032' .
+    '\040\240\342\344\340\341\343\345\347\361\242\056\074\050\053\174' .
+    '\046\351\352\353\350\355\356\357\354\337\041\044\052\051\073\254' .
+    '\055\057\302\304\300\301\303\305\307\321\246\054\045\137\076\077' .
+    '\370\311\312\313\310\315\316\317\314\140\072\043\100\047\075\042' .
+    '\330\141\142\143\144\145\146\147\150\151\253\273\360\375\376\261' .
+    '\260\152\153\154\155\156\157\160\161\162\252\272\346\270\306\244' .
+    '\265\176\163\164\165\166\167\170\171\172\241\277\320\335\336\256' .
+    '\136\243\245\267\251\247\266\274\275\276\133\135\257\250\264\327' .
+    '\173\101\102\103\104\105\106\107\110\111\255\364\366\362\363\365' .
+    '\175\112\113\114\115\116\117\120\121\122\271\373\374\371\372\377' .
+    '\134\367\123\124\125\126\127\130\131\132\262\324\326\322\323\325' .
+    '\060\061\062\063\064\065\066\067\070\071\263\333\334\331\332\237' ;
 
     my $ebcdic_string = $ascii_string;
-
     eval '$ebcdic_string =~ tr/\000-\377/' . $cp_037 . '/';
 
 To convert from EBCDIC 037 to ASCII just reverse the order of the tr/// 
@@ -684,12 +601,12 @@ On OS/390 or z/OS see the iconv(1) manpage.  One way to invoke the iconv
 shell utility from within perl would be to:
 
     # OS/390 or z/OS example
-    my $ascii_data = `echo '$ebcdic_data'| iconv -f IBM-1047 -t ISO8859-1`
+    $ascii_data = `echo '$ebcdic_data'| iconv -f IBM-1047 -t ISO8859-1`
 
 or the inverse map:
 
     # OS/390 or z/OS example
-    my $ebcdic_data = `echo '$ascii_data'| iconv -f ISO8859-1 -t IBM-1047`
+    $ebcdic_data = `echo '$ascii_data'| iconv -f ISO8859-1 -t IBM-1047`
 
 For other perl based conversion options see the Convert::* modules on CPAN.
 
@@ -704,7 +621,7 @@ care on EBCDIC machines.  For example the following array
 will have twenty six elements on either an EBCDIC machine
 or an ASCII machine:
 
-    my @alphabet = ( 'A'..'Z' );   #  $#alphabet == 25
+    @alphabet = ('A'..'Z');   #  $#alphabet == 25
 
 The bitwise operators such as & ^ | may return different results
 when operating on string or character data in a perl program running 
@@ -712,10 +629,10 @@ on an EBCDIC machine than when run on an ASCII machine.  Here is
 an example adapted from the one in L<perlop>:
 
     # EBCDIC-based examples
-    print "j p \n"     ^ " a h";                  # prints "JAPH\n"
-    print "JA"         | "  ph\n";                # prints "japh\n"
-    print "JAPH\nJunk" & "\277\277\277\277\277";  # prints "japh\n"
-    print 'p N$'       ^ " E<H\n";                # prints "Perl\n"
+    print "j p \n" ^ " a h";                      # prints "JAPH\n"
+    print "JA" | "  ph\n";                        # prints "japh\n" 
+    print "JAPH\nJunk" & "\277\277\277\277\277";  # prints "japh\n";
+    print 'p N$' ^ " E<H\n";                      # prints "Perl\n";
 
 An interesting property of the 32 C0 control characters
 in the ASCII table is that they can "literally" be constructed
@@ -781,24 +698,23 @@ not one.
 chr() must be given an EBCDIC code number argument to yield a desired 
 character return value on an EBCDIC machine.  For example:
 
-    my $CAPITAL_LETTER_A = chr(193);
+    $CAPITAL_LETTER_A = chr(193);
 
 =item ord()
 
 ord() will return EBCDIC code number values on an EBCDIC machine.
 For example:
 
-    my $the_number_193 = ord("A");
+    $the_number_193 = ord("A");
 
 =item pack()
 
 The c and C templates for pack() are dependent upon character set 
 encoding.  Examples of usage on EBCDIC include:
 
-    my $foo;
     $foo = pack("CCCC",193,194,195,196);
     # $foo eq "ABCD"
-    $foo = pack("C4",  193,194,195,196);
+    $foo = pack("C4",193,194,195,196);
     # same thing
 
     $foo = pack("ccxxcc",193,194,195,196);
@@ -843,7 +759,7 @@ mixed case strings.  This is discussed in more detail below.
 See the discussion of printf() above.  An example of the use
 of sprintf would be:
 
-    my $CAPITAL_LETTER_A = sprintf("%c",193);
+    $CAPITAL_LETTER_A = sprintf("%c",193);
 
 =item unpack()
 
@@ -903,13 +819,13 @@ four coded character sets discussed in this document is as follows:
 
     sub Is_c0 {
         my $char = substr(shift,0,1);
-        if ( ord('^') == 94 )  { # ascii
+        if (ord('^')==94)  { # ascii
             return $char =~ /[\000-\037]/;
-        }
-        if ( ord('^') == 176 ) { # 37
+        } 
+        if (ord('^')==176) { # 37
             return $char =~ /[\000-\003\067\055-\057\026\005\045\013-\023\074\075\062\046\030\031\077\047\034-\037]/;
         }
-        if ( ord('^') == 95 || ord('^') == 106 ) { # 1047 || posix-bc
+        if (ord('^')==95 || ord('^')==106) { # 1047 || posix-bc
             return $char =~ /[\000-\003\067\055-\057\026\005\025\013-\023\074\075\062\046\030\031\077\047\034-\037]/;
         }
     }
@@ -921,45 +837,46 @@ four coded character sets discussed in this document is as follows:
 
     sub Is_delete {
         my $char = substr(shift,0,1);
-        if ( ord('^') == 94 ) {      # ascii
+        if (ord('^')==94)  { # ascii
             return $char eq "\177";
-        } else {                     # ebcdic
+        }
+        else  {              # ebcdic
             return $char eq "\007";
         }
     }
 
     sub Is_c1 {
         my $char = substr(shift,0,1);
-        if ( ord('^') == 94 ) {  # ascii
+        if (ord('^')==94)  { # ascii
             return $char =~ /[\200-\237]/;
         }
-        if ( ord('^') == 176 ) { # 37
+        if (ord('^')==176) { # 37
             return $char =~ /[\040-\044\025\006\027\050-\054\011\012\033\060\061\032\063-\066\010\070-\073\040\024\076\377]/;
         }
-        if ( ord('^') == 95 ) {  # 1047
+        if (ord('^')==95)  { # 1047
             return $char =~ /[\040-\045\006\027\050-\054\011\012\033\060\061\032\063-\066\010\070-\073\040\024\076\377]/;
         }
-        if ( ord('^') == 106 ) { # posix-bc
-            return $char =~
+        if (ord('^')==106) { # posix-bc
+            return $char =~ 
               /[\040-\045\006\027\050-\054\011\012\033\060\061\032\063-\066\010\070-\073\040\024\076\137]/;
         }
     }
 
     sub Is_latin_1 {
         my $char = substr(shift,0,1);
-        if ( ord('^') == 94 )  { # ascii
+        if (ord('^')==94)  { # ascii
             return $char =~ /[\240-\377]/;
         }
-        if ( ord('^') == 176 ) { # 37
-            return $char =~
+        if (ord('^')==176) { # 37
+            return $char =~ 
               /[\101\252\112\261\237\262\152\265\275\264\232\212\137\312\257\274\220\217\352\372\276\240\266\263\235\332\233\213\267\270\271\253\144\145\142\146\143\147\236\150\164\161-\163\170\165-\167\254\151\355\356\353\357\354\277\200\375\376\373\374\255\256\131\104\105\102\106\103\107\234\110\124\121-\123\130\125-\127\214\111\315\316\313\317\314\341\160\335\336\333\334\215\216\337]/;
         }
-        if ( ord('^') == 95 ) {  # 1047
+        if (ord('^')==95)  { # 1047
             return $char =~
               /[\101\252\112\261\237\262\152\265\273\264\232\212\260\312\257\274\220\217\352\372\276\240\266\263\235\332\233\213\267\270\271\253\144\145\142\146\143\147\236\150\164\161-\163\170\165-\167\254\151\355\356\353\357\354\277\200\375\376\373\374\272\256\131\104\105\102\106\103\107\234\110\124\121-\123\130\125-\127\214\111\315\316\313\317\314\341\160\335\336\333\334\215\216\337]/; 
         }
-        if ( ord('^') == 106 ) { # posix-bc
-            return $char =~
+        if (ord('^')==106) { # posix-bc
+            return $char =~ 
               /[\101\252\260\261\237\262\320\265\171\264\232\212\272\312\257\241\220\217\352\372\276\240\266\263\235\332\233\213\267\270\271\253\144\145\142\146\143\147\236\150\164\161-\163\170\165-\167\254\151\355\356\353\357\354\277\200\340\376\335\374\255\256\131\104\105\102\106\103\107\234\110\124\121-\123\130\125-\127\214\111\315\316\313\317\314\341\160\300\336\333\334\215\216\337]/;
         }
     }
@@ -992,8 +909,8 @@ letters compared to the digits.  If sorted on an ASCII based machine the
 two letter abbreviation for a physician comes before the two letter
 for drive, that is:
 
-    my @sorted = sort(qw(Dr. dr.));  # @sorted holds ('Dr.','dr.') on ASCII,
-                                     # but ('dr.','Dr.') on EBCDIC
+    @sorted = sort(qw(Dr. dr.));  # @sorted holds ('Dr.','dr.') on ASCII,
+                                  # but ('dr.','Dr.') on EBCDIC
 
 The property of lower case before uppercase letters in EBCDIC is
 even carried to the Latin 1 EBCDIC pages such as 0037 and 1047.
@@ -1023,9 +940,9 @@ then sort().  If the data are primarily lowercase non Latin 1 then
 apply tr/[A-Z]/[a-z]/ before sorting.  If the data are primarily UPPERCASE
 and include Latin-1 characters then apply:  
 
-    tr/[a-z]/[A-Z]/;
+    tr/[a-z]/[A-Z]/; 
     tr/[àáâãäåæçèéêëìíîïðñòóôõöøùúûüýþ]/[ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ]/;
-    s/ß/SS/g;
+    s/ß/SS/g; 
 
 then sort().  Do note however that such Latin-1 manipulation does not 
 address the E<yuml> C<y WITH DIAERESIS> character that will remain at 
@@ -1072,7 +989,7 @@ may also be expressed as either of:
 where 7E is the hexadecimal ASCII code point for '~'.  Here is an example
 of decoding such a URL under CCSID 1047:
 
-    my $url      = 'http://www.pvhp.com/%7Epvhp/';
+    $url = 'http://www.pvhp.com/%7Epvhp/';
     # this array assumes code page 1047
     my @a2e_1047 = (
           0,  1,  2,  3, 55, 45, 46, 47, 22,  5, 21, 11, 12, 13, 14, 15,
@@ -1097,7 +1014,7 @@ of decoding such a URL under CCSID 1047:
 Conversely, here is a partial solution for the task of encoding such 
 a URL under the 1047 code page:
 
-    my $url      = 'http://www.pvhp.com/~pvhp/';
+    $url = 'http://www.pvhp.com/~pvhp/';
     # this array assumes code page 1047
     my @e2a_1047 = (
           0,  1,  2,  3,156,  9,134,127,151,141,142, 11, 12, 13, 14, 15,
@@ -1117,7 +1034,7 @@ a URL under the 1047 code page:
          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
     );
-    # The following regular expression does not address the
+    # The following regular expression does not address the 
     # mappings for: ('.' => '%2E', '/' => '%2F', ':' => '%3A') 
     $url =~ s/([\t "#%&\(\),;<=>\?\@\[\\\]^`{|}~])/sprintf("%%%02X",$e2a_1047[ord($1)])/ge;
 
@@ -1134,13 +1051,10 @@ The C<u> template to pack() or unpack() will render EBCDIC data in EBCDIC
 characters equivalent to their ASCII counterparts.  For example, the 
 following will print "Yes indeed\n" on either an ASCII or EBCDIC computer:
 
-    my $all_byte_chrs = '';
-
-    $all_byte_chrs .= chr($_) foreach 0 .. 255;
-
-    my $uuencode_byte_chrs = pack('u', $all_byte_chrs);
-
-    (my $uu = <<'    ENDOFHEREDOC') =~ s/^\s*//gm;
+    $all_byte_chrs = '';
+    for (0..255) { $all_byte_chrs .= chr($_); }
+    $uuencode_byte_chrs = pack('u', $all_byte_chrs);
+    ($uu = <<'    ENDOFHEREDOC') =~ s/^\s*//gm;
     M``$"`P0%!@<("0H+#`T.#Q`1$A,4%187&!D:&QP='A\@(2(C)"4F)R@I*BLL
     M+2XO,#$R,S0U-C<X.3H[/#T^/T!!0D-$149'2$E*2TQ-3D]045)35%565UA9
     M6EM<75Y?8&%B8V1E9F=H:6IK;&UN;W!Q<G-T=79W>'EZ>WQ]?G^`@8*#A(6&
@@ -1148,22 +1062,21 @@ following will print "Yes indeed\n" on either an ASCII or EBCDIC computer:
     MM+6VM[BYNKN\O;Z_P,'"P\3%QL?(R<K+S,W.S]#1TM/4U=;7V-G:V]S=WM_@
     ?X>+CY.7FY^CIZNOL[>[O\/'R\_3U]O?X^?K[_/W^_P``
     ENDOFHEREDOC
-    if ( $uuencode_byte_chrs eq $uu ) {
+    if ($uuencode_byte_chrs eq $uu) {
         print "Yes ";
     }
     $uudecode_byte_chrs = unpack('u', $uuencode_byte_chrs);
-    if ( $uudecode_byte_chrs eq $all_byte_chrs ) {
+    if ($uudecode_byte_chrs eq $all_byte_chrs) {
         print "indeed\n";
     }
 
 Here is a very spartan uudecoder that will work on EBCDIC provided
 that the @e2a array is filled in appropriately:
 
-    #!/usr/bin/perl
-    my @e2a = (
-               # this must be filled in
-              );
-    $_ = <> until my($mode,$file) = /^begin\s*(\d*)\s*(\S*)/;
+    #!/usr/local/bin/perl
+    @e2a = ( # this must be filled in
+           );
+    $_ = <> until ($mode,$file) = /^begin\s*(\d*)\s*(\S*)/;
     open(OUT, "> $file") if $file ne "";
     while(<>) {
         last if /^end/;
@@ -1182,7 +1095,7 @@ On ASCII encoded machines it is possible to strip characters outside of
 the printable set using:
 
     # This QP encoder works on ASCII only
-    my $qp_string =~ s/([=\x00-\x1F\x80-\xFF])/sprintf("=%02X",ord($1))/ge;
+    $qp_string =~ s/([=\x00-\x1F\x80-\xFF])/sprintf("=%02X",ord($1))/ge;
 
 Whereas a QP encoder that works on both ASCII and EBCDIC machines 
 would look somewhat like the following (where the EBCDIC branch @e2a 
@@ -1191,14 +1104,12 @@ array is omitted for brevity):
     if (ord('A') == 65) {    # ASCII
         $delete = "\x7F";    # ASCII
         @e2a = (0 .. 255)    # ASCII to ASCII identity map
-
-    } else {                 # EBCDIC
+    }
+    else {                   # EBCDIC
         $delete = "\x07";    # EBCDIC
-        @e2a = (
-                # EBCDIC to ASCII map (as shown above)
-               );
+        @e2a =               # EBCDIC to ASCII map (as shown above)
     }
-    my $qp_string =~
+    $qp_string =~
       s/([^ !"\#\$%&'()*+,\-.\/0-9:;<>?\@A-Z[\\\]^_`a-z{|}~$delete])/sprintf("=%02X",$e2a[ord($1)])/ge;
 
 (although in production code the substitutions might be done
@@ -1233,14 +1144,14 @@ work on ASCII and EBCDIC machines:
 
     #!/usr/local/bin/perl
 
-    while ( <> ) {
+    while(<>){
         tr/n-za-mN-ZA-M/a-zA-Z/;
         print;
     }
 
 In one-liner form:
 
-    perl -pe 'tr/n-za-mN-ZA-M/a-zA-Z/'
+    perl -ne 'tr/n-za-mN-ZA-M/a-zA-Z/;print'
 
 
 =head1 Hashing order and checksums
@@ -1386,3 +1297,5 @@ Thanks also to Vickie Cooper, Philip Newton, William Raffloer, and
 Joe Smith.  Trademarks, registered trademarks, service marks and 
 registered service marks used in this document are the property of 
 their respective owners.
+
+
-- 
2.7.4